среда, 9 ноября 2011 г.

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

Понадобилось мне осуществить проверку серверного сертификата в моей программе на 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

Комментариев нет:

Отправить комментарий