| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

IdHTTP + SSL [WinXP]

pvr ©   (2010-04-13 16:55:00) 

Пытаюсь сделать соединение посредством 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   (2010-04-13 16:58:00) [1]

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

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

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

---

pvr   (2010-04-13 16:56:00) [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   (2010-04-13 16:55:00) [3]

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

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.


---

Наверх