Форум: "Сети";
Текущий архив: 2014.03.09;
Скачать: [xml.tar.bz2];

Вниз

IdHTTP + SSL   Найти похожие ветки 

← →
pvr   (2010-04-13 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   (2010-04-13 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   (2010-04-13 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   (2010-04-13 16:58) [3]

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

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

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

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2014.03.09;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.002 c