* Merging revisions r46540 from trunk:

    ------------------------------------------------------------------------
    r46540 | michael | 2020-08-22 00:24:50 +0200 (Sat, 22 Aug 2020) | 1 line
    
    * Patch from BaldZhang to fix checking peer certificate
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46562 -

packages/fcl-net/src/sslsockets.pp

@@ -27,7 +27,7 @@ Const
 Type
   ESSLSocketError = Class(ESocketError);
   TSSLSocketHandler = class;
-  TVerifyCertificateEvent = Procedure(Sender : TObject; Allow : Boolean) of object;
+  TVerifyCertificateEvent = Procedure(Sender : TObject; var Allow : Boolean) of object;
   TSSLSocketHandlerClass = class of TSSLSocketHandler;
 
   { TSSLSocketHandler }
@@ -50,7 +50,7 @@ Type
     Class Var FDefaultHandlerClass : TSSLSocketHandlerClass;
   protected
     Procedure SetSSLActive(aValue : Boolean);
-    function DoVerifyCert: boolean;
+    function DoVerifyCert: boolean; virtual;  // if event define's change not accceptable, suggest to set virtual
   public
     constructor Create; override;
     Destructor Destroy; override;

packages/openssl/src/fpopenssl.pp

@@ -102,7 +102,7 @@ Type
     function PeerSubject : String;
     Function PeerIssuer : String;
     Function PeerSerialNo : Integer;
-    Function PeerFingerprint : String;
+    Function PeerFingerprint(const name: string = 'MD5') : String;
     Function CertInfo : String;
     function CipherName: string;
     function CipherBits: integer;
@@ -737,7 +737,7 @@ begin
   end;
 end;
 
-Function TSSL.PeerFingerprint: String;
+Function TSSL.PeerFingerprint(const name: string): String;
 var
   C : PX509;
   L : integer;
@@ -750,7 +750,7 @@ begin
   try
     Result:=StringOfChar(#0,EVP_MAX_MD_SIZE);
     L:=0;
-    X509Digest(C,EvpGetDigestByName('MD5'),Result,L);
+    X509Digest(C,EvpGetDigestByName(name),Result,L);
     SetLength(Result,L);
   finally
     X509Free(C);

packages/openssl/src/opensslsockets.pp

@@ -39,6 +39,7 @@ Type
     // Result of last CheckSSL call.
     Function SSLLastError: integer;
     property SSLLastErrorString: string read FSSLLastErrorString write SetSSLLastErrorString;
+    property SSL: TSSL read FSSL; // allow more lower level info and control
   end;
 
 implementation
@@ -78,8 +79,10 @@ begin
      if SendHostAsSNI  and (Socket is TInetSocket) then
        FSSL.Ctrl(SSL_CTRL_SET_TLSEXT_HOSTNAME,TLSEXT_NAMETYPE_host_name,PAnsiChar(AnsiString((Socket as TInetSocket).Host)));
      Result:=CheckSSL(FSSL.Connect);
-     if Result and VerifyPeerCert then
-       Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
+     //if Result and VerifyPeerCert then
+     //  Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
+     if Result then
+       Result:= DoVerifyCert;
      if Result then
        SetSSLActive(True);
      end;