Error connecting with ssl delphi

Проверка серверного сертификата SSL в Delphi

Понадобилось мне осуществить проверку серверного сертификата в моей программе на Delphi. Эта программа была написана довольно давно, на Delphi 7 с использованием Indy 9.

Вот как выглядит проверка сертификата:

Если попробовать выполнить выше приведенный код, то результат будет всегда такой: Error connecting with SSL.

Проблема тут в том, что в Indy используется OpenSSL, который не умеет работать с хранилищем сертификатов Windows и не может проверить подписан ли сертификат, полученный от сервера, одним из доверенных корневых сертификатов из этого хранилища.

Посмотрим в исходник модуля IdSSLOpenSSL. В нем есть такая функция:

Эта callback-функция вызывается при проверке сертификата библиотекой OpenSSL, и для того, чтобы не случилось ошибки “Error connecting with SSL” она должна возвращать значение Result = 1. Видно, что VerifyCallback возвращает Result = 1 только в том случае, когда Ok > 0. А параметр Ok для последнего сертификата в цепочке проверяемых всегда будет = 0, т.к. корневой сертификат, с помощью которого его можно проверить, не определен.

Таким образом, задача в следующем: проверить — подписан ли последний в цепочке сертификат одним из доверенных корневых (ROOT) сертификатов в хранилище Windows, и если подписан, то присвоить Ok = 1.

К сожалению, при проектировании Indy 9 было допущено много ошибок, и для того, чтобы решить поставленную задачу, придется вносить изменения в код модуля IdSSLOpenSSL, а затем перекомпилировать пакет
Indy70.dpk.

Внесем следующие изменения:

1. Изменим определение события TVerifyPeerEvent на следующее:

2. Изменим определение метода DoVerifyPeer в классах TIdSSLIOHandlerSocket и TIdServerIOHandlerSSL на следующее:

3. Изменим реализации метода DoVerifyPeer в классах TIdSSLIOHandlerSocket и TIdServerIOHandlerSSL на следующие:

4. Добавим public-свойство X509 классу TIdX509:

5. Изменим функцию VerifyCallback на следующую:

Теперь нужно перекомпилировать Indy70.dpk.

В результате наших изменений обработчик события OnVerifyPeer получает два дополнительных параметра: Error — код ошибки проверки сертификата (это может быть, например, OPENSSL_X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY) и параметр Ok, который можно изменить. Ниже приведена реализация обработчика:

В этом обработчике использованы функции OpenSSL и СryptoAPI, объявления которых можно найти в libeay32.pas и wcrypt2.pas. Собственно, из-за необходимости подключения этих модулей я и вынес проверку в обработчик события OnVerifyPeer, вместо того, чтобы сделать все в функции VerifyCallback.

Подключаем обработчик SSLIOHandlerVerifyPeer к IdSSLIOHandlerSocket и окончательно получаем загрузку страницы по протоколу https: с проверкой серверного сертификата:

Источник

Delphi error connection with ssl

Воть.
procedure TForm1.Button1Click(Sender: TObject);
var
data: TIdMultiPartFormDataStream;
red: TIdMultiPartFormDataStream;

begin
data := TIdMultiPartFormDataStream.Create;
red := TIdMultiPartFormDataStream.Create;

data.AddFormField(‘request’, req_type);
data.AddFormField(‘id=’, req_id );
data.AddFormField(‘checkid=’,req_ch eckid);
data.AddFormField(‘product=’,req_pr oduct );
data.AddFormField(‘value=’, req_value);
data.AddFormField(‘account’, req_account );
data.AddFormField(‘timeout=’, req_timeout);
data.AddFormField(‘cnfmode=’, req_cnfmode );
red.AddFormField(‘X-Eport-Auth’,’point=’+point+’;’+’card=’+ca rd+’;’+’pin=’+pin);
red.AddFormField(‘X-Eport-Mode’, ‘1’ );
red.AddFormField(‘Content-Type’,’text/plain; charset=koi8-r’);
IdHTTP1.IOHandler:=IdSSLIOHandlerSo cket1;
IdSSLIOHandlerSocket1.SocksInfo:=Id http1.Socket.SocksInfo;

Выдаёт Error connecting with SSL
================

Короче вот код на Перле —>
Мне надо его перевести в Delphi
помогите срочно надо.
use strict;
use Net::SSLeay qw(post_https make_headers);

# номер точки e-port
my $point = 123;
# номер карты e-port
my $card = «249000-00000»;
# пин-код карты e-port
my $pin = «1234567890»;

##### исходные данные запроса операции #####

# тип запроса (OPERATION/CONFIRM/CANCEL)
my $req_type = «OPERATION»;
# идентификатор операции
my $req_id = «12345»;
# номер чека
my $req_checkid = «12345»;
# артикул товара из справочника(в данном случае — МТС ESPP)
my $req_product = 4420;
# объем сделки (в данном случае — 100 рублей)
my $req_value = «100.00RUR»;
# реквизиты л/с клиента, объединенные точкой с запятой
# в данном случае ракуизит один — номер телефона
my $req_account = «9161234567»;
# тайм-аут запроса в синхронном режиме
my $req_timeout = 15;
# режим транзакции (0 — однофазный, 1 — двухфазный)
my $req_cnfmode = 1;

##### Формирование запроса text/plain#####
my $CRLF = «rn»;
my $request = $req_type . $CRLF .
«id=» . $req_id . $CRLF .
«checkid=» . $req_checkid . $CRLF .
«product=» . $req_product . $CRLF .
«value=» . $req_value . $CRLF .
«account=» . $req_account . $CRLF .
«timeout=» . $req_timeout . $CRLF .
«cnfmode=» . $req_cnfmode . $CRLF;

print «=== Operation Request ===n»;
print $request;

##### формируем http-заголовки запроса #####
my $reqHeaders;
# добавляем заголовок аутентификации
$reqHeaders .= make_headers(«X-Eport-Auth»=>»point=$point; card=$card; pin=$pin»);
# добавляем признак синхронного режима
$reqHeaders .= make_headers(«X-Eport-Mode»=>»1»);
# указываем кодировку сообщения и формат данных
$reqHeaders .= make_headers(«Content-Type»=>»text/plain; charset=koi8-r»);

##### обмениваемся данными с сервером #####
my $host = «dealer.e-port.ru»;
my $port = «443»;
my $uri = «/cp/fe»;
my ($body, $status, %resHeaders) = post_https($host,$port,$uri,$reqHea ders,$request);

# http-код ответа указывает на ошибку
if($status ne ‘HTTP/1.1 200 OK’) <
print «HTTP ERROR: $statusn»;
print «$bodyn»;

# http-код ответа 200 (успешно)
>else <
# разбираем построчно
my @lines = split(/rn/, $body);
my $i = 0;

# ответ по операции должен начинаться с ключевого слова «RESULT»
die «Response: Bad format, RESULT requiredn» unless $lines[$i++] eq ‘RESULT’;

# затем следуют обязательные параметры ответа в определенном порядке

# идентификатор операции
die «Response: Bad format, id requiredn» unless $lines[$i++] =

# код ответа
die «Response: Bad format, code requiredn» unless $lines[$i++] =

# сообщение для разработчика/оператора системы
die «Response: Bad format, omsg requiredn» unless $lines[$i++] =

# сообщение для клиента
die «Response: Bad format, cmsg requiredn» unless $lines[$i++] =

# далее следуют необязательные параметры операции
my ($res_time, $res_pmsg, $res_card, $res_pin);

while( my $line = $lines[$i++]) <
# дата/время операции на сервере
if($line=

/^time=(.*)$/) <
$res_time = $1
# сообщение для печати
>elsif($line=

/^pmsg=(.*)$/) <
$res_pmsg = $1
# номер карты e-port клиента
>elsif($line=

/^card=(.*)$/) <
$res_card = $1
# пин-код карты e-port клиента
>elsif($line=

# обрабатываем полученные данные
print «=== Operation result ===n»;
print «id :» . $res_id . «n»;
print «code :» . $res_code . «n»;
print «omsg :» . $res_omsg . «n»;
print «cmsg :» . $res_cmsg . «n»;
print «time :» . $res_time . «n»;
print «pmsg :» . $res_pmsg . «n»;
print «card :» . $res_card . «n»;
print «pin :» . $res_pin . «n»;
>

Источник

8 hours ago, david_navigator said:

If you mean the version numbers of libeay32.dll & ssleay32.dll, then they’re 1.0.1.3 (1.0.1c) — dated 27/01/2014 !!!

Yes, I do, and that is a VERY old version of OpenSSL, you need to upgrade.  Indy currently supports up to 1.0.2u dated 21/12/2019, which you can find at https://github.com/IndySockets/OpenSSL-Binaries/  Work on supporting 1.1.x is in progress: https://github.com/IndySockets/Indy/pull/299

8 hours ago, david_navigator said:

SSLOptions.Method := sslvTLSv1;

The Method property is deprecated, you should be using the SSLVersions property instead.

TLS 1.0 has been (almost) completely phased out of modern servers.  Most modern servers support, if not require, TLS 1.2, so that really should be your minimum going forward nowadays.  You should also have TLS 1.1 enabled as a fallback, just in case, but even that is being phased out as well.

To enable multiple TLS versions with the Method property, you would have to set it to sslvSSLv23, which will set the SSLVersions property to all SSL/TLS versions supported by Indy (including SSL 2.0, SSL 3.0, and TLS 1.x), but it is better to use the SSLVersions property directly (ie, don’t enable SSL 2.0 and 3.0 anymore), eg:

SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];

Having multiple TLS versions enabled at a time will allow OpenSSL to negotiate the highest version that both client and server support.

That being said, on a side note, you do not need to assign ANY of the following SSLIOHandler properties, as Indy handles them internally for you:

8 hours ago, david_navigator said:

      with IdSSLIOHandlerSocketOpenSSL1 do
      begin
        ...
        Destination := format('%s:%s', [EditServerHost.text, EditPort.text]); // 'imap.gmail.com:993';
        Host := EditServerHost.text;
        ...
        Port := strtoint(EditPort.text);
        DefaultPort := 0;
        ...
      end;

Setup the necessary Host/Port only in the client component, ie TIdIMAP4.  The Connect() method will then copy them into the IOHandler as needed.

Edited October 22, 2021 by Remy Lebeau

Понадобилось мне осуществить проверку серверного сертификата в моей программе на Delphi. Эта программа была написана довольно давно, на Delphi 7 с использованием Indy 9.

Вот как выглядит проверка сертификата:

var
  IdHTTP: TIdHTTP;
  IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket;
begin
  IdHTTP := TIdHTTP.Create(nil);
  IdSSLIOHandlerSocket := TIdSSLIOHandlerSocket.Create(nil);
  IdHTTP.IOHandler := IdSSLIOHandlerSocket;
  with IdSSLIOHandlerSocket do
  begin
    SSLOptions.Method := sslvSSLv23;
    SSLOptions.Mode := sslmClient;
    SSLOptions.VerifyMode := [sslvrfPeer];
    SSLOptions.VerifyDepth := 10;
  end;
  IdHTTP.Get('https://www.google.com');
  FreeAndNil(IdHTTP); 
  FreeAndNil(IdSSLIOHandlerSocket);
end;

Если попробовать выполнить выше приведенный код, то результат будет всегда такой: Error connecting with SSL.

Проблема тут в том, что в Indy используется OpenSSL, который не умеет работать с хранилищем сертификатов Windows и не может проверить подписан ли сертификат, полученный от сервера, одним из доверенных корневых сертификатов из этого хранилища.

Посмотрим в исходник модуля IdSSLOpenSSL. В нем есть такая функция:

function VerifyCallback(Ok: Integer; ctx: PX509_STORE_CTX): Integer; cdecl;
var
  hcert: PX509;
  Certificate: TIdX509;
  hSSL: PSSL;
  IdSSLSocket: TIdSSLSocket;
 // str: String;
  VerifiedOK: Boolean;
  Depth: Integer;
 // Error: Integer;
begin
  LockVerifyCB.Enter;
  try
    VerifiedOK := True;
    try
      hcert := IdSslX509StoreCtxGetCurrentCert(ctx);
      hSSL := IdSslX509StoreCtxGetAppData(ctx);
      Certificate := TIdX509.Create(hcert);
      if hSSL <> nil then begin
        IdSSLSocket := TIdSSLSocket(IdSslGetAppData(hSSL));
      end
      else begin
        Result := Ok;
        exit;
      end;
      //Error :=
      IdSslX509StoreCtxGetError(ctx);
      //
      Depth := IdSslX509StoreCtxGetErrorDepth(ctx);
     // str := Format('Certificate: %s', [Certificate.Subject.OneLine]);    {Do not Localize}
     // str := IdSSLSocket.GetSessionIDAsString;
     // ShowMessage(str);
      if (IdSSLSocket.fParent is TIdSSLIOHandlerSocket) then begin
        VerifiedOK := TIdSSLIOHandlerSocket(IdSSLSocket.fParent).DoVerifyPeer(Certificate);
      end;
      if (IdSSLSocket.fParent is TIdServerIOHandlerSSL) then begin
        VerifiedOK := TIdServerIOHandlerSSL(IdSSLSocket.fParent).DoVerifyPeer(Certificate);
      end;
      if not ((Ok>0) and (IdSSLSocket.fSSLContext.VerifyDepth>=Depth)) then begin
        Ok := 0;
        {if Error = OPENSSL_X509_V_OK then begin
          Error := OPENSSL_X509_V_ERR_CERT_CHAIN_TOO_LONG;
        end;}
      end;
      FreeAndNil(Certificate);
    except
    end;
    if VerifiedOK and (Ok > 0) then begin
      Result := 1;
    end
    else begin
      Result := 0;
    end;
  //  Result := Ok; // testing
  finally
    LockVerifyCB.Leave;
  end;
end;

Эта callback-функция вызывается при проверке сертификата библиотекой OpenSSL, и для того, чтобы не случилось ошибки “Error connecting with SSL” она должна возвращать значение Result = 1. Видно, что VerifyCallback возвращает Result = 1 только в том случае, когда Ok > 0. А параметр Ok для последнего сертификата в цепочке проверяемых всегда будет = 0, т.к. корневой сертификат, с помощью которого его можно проверить, не определен.

Таким образом, задача в следующем: проверить — подписан ли последний в цепочке сертификат одним из доверенных корневых (ROOT) сертификатов в хранилище Windows, и если подписан, то присвоить Ok = 1.

К сожалению, при проектировании Indy 9 было допущено много ошибок, и для того, чтобы решить поставленную задачу, придется вносить изменения в код модуля IdSSLOpenSSL, а затем перекомпилировать пакет
Indy70.dpk.

Внесем следующие изменения:

1. Изменим определение события TVerifyPeerEvent на следующее:

TVerifyPeerEvent = function(Certificate: TIdX509; Error: Integer; var Ok: Integer): Boolean of object;

2. Изменим определение метода DoVerifyPeer в классах TIdSSLIOHandlerSocket и TIdServerIOHandlerSSL на следующее:

function DoVerifyPeer(Certificate: TIdX509; Error: Integer; var Ok: Integer): Boolean; virtual;

3. Изменим реализации метода DoVerifyPeer в классах TIdSSLIOHandlerSocket и TIdServerIOHandlerSSL на следующие:

function TIdServerIOHandlerSSL.DoVerifyPeer(Certificate: TIdX509;
  Error: Integer; var Ok: Integer): Boolean;
begin
  Result := True;
  if Assigned(fOnVerifyPeer) then
    Result := fOnVerifyPeer(Certificate, Error, Ok);
end;
function TIdSSLIOHandlerSocket.DoVerifyPeer(Certificate: TIdX509;
  Error: Integer; var Ok: Integer): Boolean;
begin
  Result := True;
  if Assigned(fOnVerifyPeer) then
    Result := fOnVerifyPeer(Certificate, Error, Ok);
end;

4. Добавим public-свойство X509 классу TIdX509:

property X509: PX509 read FX509;

5. Изменим функцию VerifyCallback на следующую:

function VerifyCallback(Ok: Integer; ctx: PX509_STORE_CTX): Integer; cdecl;
var
  hcert: PX509;
  Certificate: TIdX509;
  hSSL: PSSL;
  IdSSLSocket: TIdSSLSocket;
 // str: String;
  VerifiedOK: Boolean;
  Depth: Integer;
  Error: Integer;
begin
  LockVerifyCB.Enter;
  try
    VerifiedOK := True;
    try
      hcert := IdSslX509StoreCtxGetCurrentCert(ctx);
      hSSL := IdSslX509StoreCtxGetAppData(ctx);
      Certificate := TIdX509.Create(hcert);
      if hSSL <> nil then begin
        IdSSLSocket := TIdSSLSocket(IdSslGetAppData(hSSL));
      end
      else begin
        Result := Ok;
        exit;
      end;
      Error :=
      IdSslX509StoreCtxGetError(ctx);
      //
      Depth := IdSslX509StoreCtxGetErrorDepth(ctx);
     // str := Format('Certificate: %s', [Certificate.Subject.OneLine]);    {Do not Localize}
     // str := IdSSLSocket.GetSessionIDAsString;
     // ShowMessage(str);
      if (IdSSLSocket.fParent is TIdSSLIOHandlerSocket) then begin
        VerifiedOK := TIdSSLIOHandlerSocket(IdSSLSocket.fParent).DoVerifyPeer(Certificate, Error, Ok);
      end;
      if (IdSSLSocket.fParent is TIdServerIOHandlerSSL) then begin
        VerifiedOK := TIdServerIOHandlerSSL(IdSSLSocket.fParent).DoVerifyPeer(Certificate, Error, Ok);
      end;
      if not ((Ok>0) and (IdSSLSocket.fSSLContext.VerifyDepth>=Depth)) then begin
        Ok := 0;
        {if Error = OPENSSL_X509_V_OK then begin
          Error := OPENSSL_X509_V_ERR_CERT_CHAIN_TOO_LONG;
        end;}
      end;
      FreeAndNil(Certificate);
    except
    end;
    if VerifiedOK and (Ok > 0) then begin
      Result := 1;
    end
    else begin
      Result := 0;
    end;
  //  Result := Ok; // testing
  finally
    LockVerifyCB.Leave;
  end;
end;

Теперь нужно перекомпилировать Indy70.dpk.

В результате наших изменений обработчик события OnVerifyPeer получает два дополнительных параметра: Error — код ошибки проверки сертификата (это может быть, например, OPENSSL_X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY) и параметр Ok, который можно изменить. Ниже приведена реализация обработчика:

function TForm1.SSLIOHandlerVerifyPeer(ThePeerCert: TIdX509; Error: Integer; var Ok: Integer): Boolean;
var
  LBIO: PBIO;
  LLen: Integer;
  LStr: String;
  hStore: HCERTSTORE;
  pCert, pIssuer: PCCERT_CONTEXT;
  dwFlags: DWORD;
begin
  //Result := False;
  //
  if (Ok = 0)
  then begin
    hStore := nil;
    pCert := nil;
    pIssuer := nil;
    LBIO := BIO_new(BIO_s_mem());
    try
      i2d_X509_bio(LBIO, ThePeerCert.X509);
      LLen := BIO_ctrl_pending(LBIO);
      SetLength(LStr, LLen);
      BIO_read(LBIO, @LStr[1], LLen);
      BIO_free(LBIO);
      LBIO := nil;
      hStore := CertOpenSystemStore(0, 'ROOT');
      if hStore <> nil then
      begin
        pCert := CertCreateCertificateContext(
          PKCS_7_ASN_ENCODING or X509_ASN_ENCODING, @LStr[1], LLen);
        if pCert <> nil then
        begin
          dwFlags := CERT_STORE_REVOCATION_FLAG or
                     CERT_STORE_SIGNATURE_FLAG or
                     CERT_STORE_TIME_VALIDITY_FLAG;
          pIssuer := CertGetIssuerCertificateFromStore(
                       hStore, pCert, nil, @dwFlags);
          if pIssuer <> nil then
          begin
            Ok := 1;
            CertFreeCertificateContext(pIssuer);
            pIssuer := nil;
          end;
          CertFreeCertificateContext(pCert);
          pCert := nil;
        end;
        CertCloseStore(hStore, 0);
        hStore := nil;
      end;
    finally
      if LBIO <> nil then
        BIO_free(LBIO);
      if pIssuer <> nil then
        CertFreeCertificateContext(pIssuer);
      if pCert <> nil then
        CertFreeCertificateContext(pCert);
      if hStore <> nil then
        CertCloseStore(hStore, 0);
    end;
  end;
  //
  Result := (Ok > 0);
end;

В этом обработчике использованы функции OpenSSL и СryptoAPI, объявления которых можно найти в libeay32.pas и wcrypt2.pas. Собственно, из-за необходимости подключения этих модулей я и вынес проверку в обработчик события OnVerifyPeer, вместо того, чтобы сделать все в функции VerifyCallback.

Подключаем обработчик SSLIOHandlerVerifyPeer к IdSSLIOHandlerSocket и окончательно получаем загрузку страницы по протоколу https: с проверкой серверного сертификата:

var
  IdHTTP: TIdHTTP;
  IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket;
begin
  IdHTTP := TIdHTTP.Create(nil);
  IdSSLIOHandlerSocket := TIdSSLIOHandlerSocket.Create(nil);
  IdHTTP.IOHandler := IdSSLIOHandlerSocket;
  with IdSSLIOHandlerSocket do
  begin
    SSLOptions.Method := sslvSSLv23;
    SSLOptions.Mode := sslmClient;
    SSLOptions.VerifyMode := [sslvrfPeer];
    SSLOptions.VerifyDepth := 10;
    OnVerifyPeer := SSLIOHandlerVerifyPeer;
  end;
  IdHTTP.Get('https://www.google.com');
  FreeAndNil(IdHTTP); 
  FreeAndNil(IdSSLIOHandlerSocket);
end;

PS. Проверка серверного сертификата и Enhanced Security

===
Перепечатка материалов блога разрешается с обязательной ссылкой на blog.coolsoftware.ru