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