PHP DM Gate v0.9 » IdHTTP + SSL <span class="vd">[WinXP]</span>

pvr (13.04.10 16:55) [0]

Пытаюсь сделать соединение посредством IdHTTP с прикрученным SSL. Delphi 2006, Indy10.

На стороне сервера

HTTPServer: TIdHTTPServer;

HTTPServer.Active := True;
HTTPServer.DefaultPort := 12345;
HTTPServer.IOHandler := ServerIOHandler;
HTTPServer.KeepAlive := True;
HTTPServer.SessionTimeout := 10000;
HTTPServer.TErminateWaitTime := 10000;

ServerIOHandler: TIdServerIOHandlerSSLOpenSSL;

ServerIOHandler.SSLOptions.SertFile := 'CA\ca.crt';
ServerIOHandler.SSLOptions.KeyFile := 'CA\ca.key';
ServerIOHandler.SSLOptions.Method := sslvSSLv23;
ServerIOHandler.SSLOptions.Mode := sslmServer;
ServerIOHandler.SSLOptions.RootCertFile := 'CA\ca.crt';
ServerIOHandler.SSLOptions.VerifyDepth := 1;
ServerIOHandler.SSLOptions.VwerifyMode := [sslvrfPeer,sslvrfFailIfNoPeerCert,sslvrfClientOnce];

На стороне клиента:

IdHTTP: TIdHTTP;

IdHTTP.IOHandler := IOHandlerSocketOpenSSL;

IOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;

DefaultPort := 12345;
Destination := 'localhost';
Host := 'localhost';
Port := 12345;
ReadTimeout := 10000;
IOHandlerSocketOpenSSL.SSLOptions.SertFile := IOHandlerSocketOpenSSL.SSLOptions.'CLIENT\a1234.crt';
IOHandlerSocketOpenSSL.SSLOptions.KeyFile := IOHandlerSocketOpenSSL.SSLOptions.'CLIENT\a1234.key';
IOHandlerSocketOpenSSL.SSLOptions.Method := sslvSSLv23;
IOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;

Все эти параметры задаю в компонентах.

Тексты сервера и клиента в следующих постах.

<Цитата>
pvr (13.04.10 16:55) [1]

Это текст сервера:

unit uServer;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer,
IdHTTPServer, IdContext, IdServerIOHandler, IdSSL, IdSSLOpenSSL, ADODB,
IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack;

type
TfmServer = class(TForm)
HTTPServer: TIdHTTPServer;
ServerIOHandler: TIdServerIOHandlerSSLOpenSSL;
function ServerIOHandlerVerifyPeer(Certificate: TIdX509;
AOk: Boolean): Boolean;
procedure HTTPServerConnect(AContext: TIdContext);
procedure HTTPServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmServer: TfmServer;

implementation

{$R *.dfm}

procedure TfmServer.HTTPServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := 'Ответ';
end;

procedure TfmServer.HTTPServerConnect(AContext: TIdContext);
begin
if (AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase) then
TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
end;

function TfmServer.ServerIOHandlerVerifyPeer(Certificate: TIdX509;
AOk: Boolean): Boolean;
var
InStrSubject, InStrIssuer, NameSubject, NameIssuer: string;
begin
InStrSubject := Certificate.Subject.OneLine;
InStrIssuer := Certificate.Issuer.OneLine;
NameSubject := Func1(InStrSubject);
NameIssuer := Func2(InStrIssuer);
if NameSubject = NameIssuer then
begin
Result := True;
Exit;
end;
Result := MyAdditionalCheckout;
end;

end.

<Цитата>
pvr (13.04.10 16:56) [2]

Это текст клиента:

unit uClient;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdHTTP, StdCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdServerIOHandler;

type
TfmClient = class(TForm)
btSend: TButton;
IdHTTP: TIdHTTP;
IOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
procedure IOHandlerSocketOpenSSLGetPassword(var Password: string);
procedure btSendClick(Sender: TObject);
private
FHTTP: TIdHTTP;
FSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
public
procedure SendCommand;
end;

var
fmClient: TfmClient;

implementation

{$R *.dfm}

procedure TfmClient.btSendClick(Sender: TObject);
begin
IOHandlerSocketOpenSSL.ConnectTimeout := 10000;
SendCommand;
end;

procedure TfmClient.IOHandlerSocketOpenSSLGetPassword(
var Password: string);
begin
Password := SomePassword;
end;

procedure TfmClient.SendCommand;
var
Sen: TStringList;
Res: string;
begin
Sen := TStringList.Create;
Sen.Add('Строка 1');
Sen.Add('Строка 2');
try
try
Res := IdHTTP.Post('https://localhost:12345', Sen);
except
on E: Exception do
E.Message := E.Message;
end;
finally
Sen.Free;
end;
end;

end.

<Цитата>
pvr (13.04.10 16:58) [3]

Запускаю сервер, потом клиент. Жму кнопку и в методе TfmClient.SendCommand в исключении получаю сообщение "Connection closed gracefully" (элегантно т.е.).
Замечу, на стороне сервера проверка сертификата проходит нормально.

Если я отбрасываю IOHandlers, то функция IdHTTP.Post('http://localhost:12345', Sen) благополучно возвращает слово 'Ответ' без всяких исключений.

Помогите, пожалуйста, заставить этот тестик заработать.

<Цитата>