huge refactoring of TLS support

- on server side, new connections will use pre-computed certificates on all platforms
- also preparing support by Asynch servers

src/lib/mormot.lib.openssl11.pas

@@ -2149,16 +2149,16 @@ function LoadPkcs12(const Der: RawByteString): PPKCS12;
 { ************** TLS / HTTPS Encryption Layer using OpenSSL for TCrtSocket }
 
 type
-  /// exception class raised by OpenSslNewNetTls implementation class
-  EOpenSslClient = class(EOpenSsl);
+  /// exception class raised by NewOpenSslNetTls implementation class
+  EOpenSslNetTls = class(EOpenSsl);
 
 
 /// OpenSSL TLS layer communication factory - as expected by mormot.net.sock.pas
 // - on non-Windows systems, this unit initialization will register OpenSSL for TLS
 // - on Windows systems, SChannel will be kept as default so you would need to
 // set the FORCE_OPENSSL conditional, or register OpenSSL for TLS mannually:
-// ! @NewNetTls := @OpenSslNewNetTls;
-function OpenSslNewNetTls: INetTls;
+// ! @NewNetTls := @NewOpenSslNetTls;
+function NewOpenSslNetTls: INetTls;
 
 /// retrieve the peer certificates chain from a given HTTPS server URI
 // - caller should call procedure PX509DynArrayFree(result) once done
@@ -7878,14 +7878,15 @@ function EOpenSsl.GetOpenSsl: string;
 
 { ************** TLS / HTTPS Encryption Layer using OpenSSL for TCrtSocket }
 
-{ TOpenSslClient }
+{ TOpenSslNetTls }
 
 type
   /// OpenSSL TLS layer communication
-  TOpenSslClient = class(TInterfacedObject, INetTls)
+  TOpenSslNetTls = class(TInterfacedObject, INetTls)
   private
     fSocket: TNetSocket;
     fContext: PNetTlsContext;
+    fLastError: PRawUtf8;
     fCtx: PSSL_CTX;
     fSsl: PSSL;
     fPeer: PX509;
@@ -7895,20 +7896,21 @@   TOpenSslClient = class(TInterfacedObject, INetTls)
     // INetTls methods
     procedure AfterConnection(Socket: TNetSocket; var Context: TNetTlsContext;
       const ServerAddress: RawUtf8);
-    procedure AfterAccept(Socket: TNetSocket; const RemoteIP: RawUtf8;
-      var Context: TNetTlsContext);
+    procedure AfterBind(var Context: TNetTlsContext);
+    procedure AfterAccept(Socket: TNetSocket; const BoundContext: TNetTlsContext;
+      LastError, CipherName: PRawUtf8);
     function Receive(Buffer: pointer; var Length: integer): TNetResult;
     function Send(Buffer: pointer; var Length: integer): TNetResult;
   end;
 
 threadvar
-  _PeerVerify: TOpenSslClient; // OpenSSL is a dumb library for sure
+  _PeerVerify: TOpenSslNetTls; // OpenSSL is a dumb library for sure
 
 function AfterConnectionPeerVerify(
   wasok: integer; store: PX509_STORE_CTX): integer; cdecl;
 var
   peer: PX509;
-  c: TOpenSslClient;
+  c: TOpenSslNetTls;
 begin
   peer := X509_STORE_CTX_get_current_cert(store);
   c := _PeerVerify;
@@ -7925,7 +7927,7 @@ function AfterConnectionPeerVerify(
 function AfterConnectionAskPassword(buf: PUtf8Char; size, rwflag: integer;
   userdata: pointer): integer; cdecl;
 var
-  c: TOpenSslClient;
+  c: TOpenSslNetTls;
   pwd: RawUtf8;
 begin
   c := _PeerVerify;
@@ -8001,7 +8003,7 @@ function HasHWAes: boolean; {$ifdef HASINLINE} inline; {$endif}
 
 // see https://www.ibm.com/support/knowledgecenter/SSB23S_1.1.0.2020/gtps7/s5sple2.html
 
-procedure TOpenSslClient.AfterConnection(Socket: TNetSocket;
+procedure TOpenSslNetTls.AfterConnection(Socket: TNetSocket;
   var Context: TNetTlsContext; const ServerAddress: RawUtf8);
 var
   v: integer;
@@ -8014,6 +8016,7 @@ procedure TOpenSslClient.AfterConnection(Socket: TNetSocket;
   fContext := @Context;
   _PeerVerify := self; // safe and simple context for the callbacks
   // reset output information
+  fLastError := @Context.LastError;
   Context.CipherName := '';
   Context.PeerIssuer := '';
   Context.PeerSubject := '';
@@ -8047,12 +8050,12 @@ procedure TOpenSslClient.AfterConnection(Socket: TNetSocket;
         fCtx, pointer(Context.PrivatePassword));
     SSL_CTX_use_PrivateKey_file(
       fCtx, pointer(Context.PrivateKeyFile), SSL_FILETYPE_PEM);
-    EOpenSslClient.Check(self, 'AfterConnection check_private_key',
+    EOpenSslNetTls.Check(self, 'AfterConnection check_private_key',
       SSL_CTX_check_private_key(fCtx), @Context.LastError);
   end;
   if Context.CipherList = '' then
     Context.CipherList := SAFE_CIPHERLIST[HasHWAes];
-  EOpenSslClient.Check(self, 'AfterConnection setcipherlist',
+  EOpenSslNetTls.Check(self, 'AfterConnection setcipherlist',
     SSL_CTX_set_cipher_list(fCtx, pointer(Context.CipherList)),
     @Context.LastError);
   v := TLS1_2_VERSION; // no SSL3 TLS1.0 TLS1.1
@@ -8067,18 +8070,18 @@ procedure TOpenSslClient.AfterConnection(Socket: TNetSocket;
     if GetNextCsv(P, h) then
     begin
       SSL_set_hostflags(fSsl, X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS);
-      EOpenSslClient.Check(self, 'AfterConnection set1host',
+      EOpenSslNetTls.Check(self, 'AfterConnection set1host',
         SSL_set1_host(fSsl, pointer(h)), @Context.LastError);
       while GetNextCsv(P, h) do
-        EOpenSslClient.Check(self, 'AfterConnection add1host',
+        EOpenSslNetTls.Check(self, 'AfterConnection add1host',
           SSL_add1_host(fSsl, pointer(h)), @Context.LastError);
     end;
   end;
-  EOpenSslClient.Check(self, 'AfterConnection setfd',
+  EOpenSslNetTls.Check(self, 'AfterConnection setfd',
     SSL_set_fd(fSsl, Socket.Socket), @Context.LastError);
   // client TLS negotiation with server
-  EOpenSslClient.Check(self, 'AfterConnection connect', SSL_connect(fSsl),
-    @Context.LastError, fSsl);
+  EOpenSslNetTls.Check(self, 'AfterConnection connect',
+    SSL_connect(fSsl), @Context.LastError, fSsl);
   fDoSslShutdown := true; // need explicit SSL_shutdown() at closing
   Context.CipherName := fSsl.CurrentCipher.Description;
   // writeln(Context.CipherName);
@@ -8097,7 +8100,7 @@ procedure TOpenSslClient.AfterConnection(Socket: TNetSocket;
     //PX509DynArrayFree(x);
     if (fPeer = nil) and
        not Context.IgnoreCertificateErrors then
-      EOpenSslClient.Check(self, 'AfterConnection getpeercertificate',
+      EOpenSslNetTls.Check(self, 'AfterConnection getpeercertificate',
         0, @Context.LastError);
     try
       if fPeer <> nil then
@@ -8146,58 +8149,71 @@ procedure TOpenSslClient.AfterConnection(Socket: TNetSocket;
   end;
 end;
 
-procedure TOpenSslClient.AfterAccept(Socket: TNetSocket; const RemoteIP: RawUtf8;
-  var Context: TNetTlsContext);
+procedure TOpenSslNetTls.AfterBind(var Context: TNetTlsContext);
 var
   v: Integer;
 begin
-  fSocket := Socket;
-  fContext := @Context;
-  // reset output information
+  // we don't store fSocket/fContext bound socket
   Context.LastError := '';
-  // prepare TLS connection properties
+  // prepare global TLS connection properties, as reused by AfterAccept()
   fCtx := SSL_CTX_new(TLS_server_method);
   if Context.CertificateFile = '' then
-    raise EOpenSslClient.Create('CertificateFile required');
+    raise EOpenSslNetTls.Create('CertificateFile required');
   SSL_CTX_use_certificate_file(
     fCtx, pointer(Context.CertificateFile), SSL_FILETYPE_PEM);
   if Context.PrivatePassword <> '' then
     SSL_CTX_set_default_passwd_cb_userdata(
       fCtx, pointer(Context.PrivatePassword));
   if Context.PrivateKeyFile = '' then
-    raise EOpenSslClient.Create('PrivateKeyFile required');
+    raise EOpenSslNetTls.Create('PrivateKeyFile required');
   SSL_CTX_use_PrivateKey_file(
     fCtx, pointer(Context.PrivateKeyFile), SSL_FILETYPE_PEM);
-  EOpenSslClient.Check(self, 'AfterAccept check_private_key',
+  EOpenSslNetTls.Check(self, 'AfterAccept check_private_key',
     SSL_CTX_check_private_key(fCtx), @Context.LastError);
   v := TLS1_2_VERSION; // no SSL3 TLS1.0 TLS1.1
   if Context.AllowDeprecatedTls then
     v := TLS1_VERSION; // allow TLS1.0 TLS1.1
   SSL_CTX_set_min_proto_version(fCtx, v);
-  fSsl := SSL_new(fCtx);
-  EOpenSslClient.Check(self, 'AfterAccept setfd',
-    SSL_set_fd(fSsl, Socket.Socket), @Context.LastError);
+  // this global context fCtx will be reused by AfterAccept()
+  Context.AcceptCert := fCtx;
+end;
+
+procedure TOpenSslNetTls.AfterAccept(Socket: TNetSocket;
+  const BoundContext: TNetTlsContext; LastError, CipherName: PRawUtf8);
+begin
+  // we don't handle any fContext here on server-side connections
+  fSocket := Socket;
+  // reset output information
+  fLastError := LastError;
+  // prepare TLS connection properties from AfterBind() global context
+  if BoundContext.AcceptCert = nil then
+    raise EOpenSslNetTls.Create('AfterAccept: missing AfterBind');
+  fSsl := SSL_new(BoundContext.AcceptCert);
+  EOpenSslNetTls.Check(self, 'AfterAccept setfd',
+    SSL_set_fd(fSsl, Socket.Socket), LastError);
   // server TLS negotiation with server
-  EOpenSslClient.Check(self, 'AfterAccept connect', SSL_accept(fSsl),
-    @Context.LastError, fSsl);
+  EOpenSslNetTls.Check(self, 'AfterAccept accept',
+    SSL_accept(fSsl), LastError, fSsl);
   fDoSslShutdown := true; // need explicit SSL_shutdown() at closing
-  Context.CipherName := fSsl.CurrentCipher.Description;
-  // writeln(Context.CipherName);
+  if CipherName <> nil then
+    CipherName^ := fSsl.CurrentCipher.Description;
+  // if CipherName <> nil then writeln(CipherName^);
 end;
 
-destructor TOpenSslClient.Destroy;
+destructor TOpenSslNetTls.Destroy;
 begin
-  if fCtx <> nil then
+  if fSsl <> nil then // client or AfterAccept server connection
   begin
     if fDoSslShutdown then
       SSL_shutdown(fSsl);
     fSsl.Free;
-    SSL_CTX_free(fCtx);
   end;
+  if fCtx <> nil then
+    SSL_CTX_free(fCtx); // client or AfterBind server context
   inherited Destroy;
 end;
 
-function TOpenSslClient.Receive(Buffer: pointer; var Length: integer): TNetResult;
+function TOpenSslNetTls.Receive(Buffer: pointer; var Length: integer): TNetResult;
 var
   read, err: integer;
 begin
@@ -8217,8 +8233,9 @@ function TOpenSslClient.Receive(Buffer: pointer; var Length: integer): TNetResul
           fDoSslShutdown := false;
         end;
     end;
-    if result <> nrRetry then
-      SSL_error(err, fContext^.LastError);
+    if (result <> nrRetry) and
+       (fLastError <> nil) then
+      SSL_error(err, fLastError^);
   end
   else
   begin
@@ -8227,7 +8244,7 @@ function TOpenSslClient.Receive(Buffer: pointer; var Length: integer): TNetResul
   end;
 end;
 
-function TOpenSslClient.Send(Buffer: pointer; var Length: integer): TNetResult;
+function TOpenSslNetTls.Send(Buffer: pointer; var Length: integer): TNetResult;
 var
   sent, err: integer;
 begin
@@ -8247,8 +8264,9 @@ function TOpenSslClient.Send(Buffer: pointer; var Length: integer): TNetResult;
           fDoSslShutdown := false;
         end;
     end;
-    if result <> nrRetry then
-      SSL_error(err, fContext^.LastError);
+    if (result <> nrRetry) and
+       (fLastError <> nil) then
+      SSL_error(err, fLastError^);
   end
   else
   begin
@@ -8257,10 +8275,10 @@ function TOpenSslClient.Send(Buffer: pointer; var Length: integer): TNetResult;
   end;
 end;
 
-function OpenSslNewNetTls: INetTls;
+function NewOpenSslNetTls: INetTls;
 begin
   if OpenSslIsAvailable then
-    result := TOpenSslClient.Create
+    result := TOpenSslNetTls.Create
   else
     result := nil;
 end;
@@ -8278,7 +8296,7 @@ function GetPeerCertFromUrl(const url: RawUtf8): PX509DynArray;
      u.From(url) and
      (NewSocket(u.Server, u.Port, nlTcp, false, 1000, 1000, 1000, 2, ns) = nrOk) then
   try
-    // cut-down version of TOpenSslClient.AfterConnection
+    // cut-down version of TOpenSslNetTls.AfterConnection
     c := SSL_CTX_new(TLS_client_method);
     SSL_CTX_set_verify(c, SSL_VERIFY_NONE, nil);
     s := SSL_new(c);
@@ -8321,7 +8339,7 @@ initialization
   {$ifndef FORCE_OPENSSL}
   if not Assigned(NewNetTls) then
   {$endif FORCE_OPENSSL}
-    @NewNetTls := @OpenSslNewNetTls;
+    @NewNetTls := @NewOpenSslNetTls;
 
 finalization
   {$ifndef OPENSSLSTATIC}

src/lib/mormot.lib.sspi.pas

@@ -168,6 +168,7 @@   TSecPkgConnectionInfo = record
     dwHashStrength: cardinal;
     aiExch: ALG_ID;
     dwExchStrength: cardinal;
+    /// retrieve some decoded text representation of this raw information
     function ToText: RawUtf8;
   end;
   PSecPkgConnectionInfo = ^TSecPkgConnectionInfo;
@@ -622,6 +623,7 @@ procedure TSecBufferDesc.Init(aVersion: cardinal; aBuffers: PSecBuffer;
 
 function TSecPkgConnectionInfo.ToText: RawUtf8;
 var
+  h: byte;
   alg, hsh, xch: string[5];
 begin
   if dwProtocol and SP_PROT_TLS1 <> 0 then
@@ -636,14 +638,15 @@ function TSecPkgConnectionInfo.ToText: RawUtf8;
     alg := 'AES'
   else
     str(aiCipher and $1f, alg);
-  case aiHash and $1f of
+  h := aiHash and $1f;
+  case h of
     1..3:
       hsh := 'MD';
     4, 12..14:
       begin
         hsh := 'SHA';
         if dwHashStrength = 0 then
-          case aiHash and $1f of
+          case h of
             4:
               dwHashStrength := 1;
             12:
@@ -657,7 +660,7 @@ function TSecPkgConnectionInfo.ToText: RawUtf8;
     9:
       hsh := 'HMAC';
   else
-    str(aiHash and $1f, hsh);
+    str(h, hsh);
   end;
   if aiExch = $a400 then
     xch := 'RSA'

src/mormot.commit.inc

@@ -1 +1 @@
-'2.0.3400'
+'2.0.3401'

src/net/mormot.net.server.pas

@@ -621,7 +621,7 @@   THttpServerSocketGenericClass = class of THttpServerSocketGeneric;
   // $ fHttpServer := THttpServer.Create('443', nil, nil, '', 32, 30000, [hsoEnableTls]);
   // $ fHttpServer.WaitStarted; // raise exception e.g. on binding issue
   // $ fHttpServer.Sock.TLS.CertificateFile := 'cert.pem'; // cert.pfx for SSPI
-  // $ fHttpServer.Sock.TLS.PrivateKeyFile := 'privkey.pem';
+  // $ fHttpServer.Sock.TLS.PrivateKeyFile := 'privkey.pem'; // for OpenSSL only
   THttpServer = class(THttpServerSocketGeneric)
   protected
     /// used to protect Process() call, e.g. fInternalHttpServerRespList
@@ -1807,10 +1807,10 @@ procedure THttpServer.Execute;
         cltservsock := fSocketClass.Create(self);
         try
           if hsoEnableTls in fOptions then
-            cltservsock.TLS := fSock.TLS;
+            cltservsock.TLS := fSock.TLS; // needed by cstaAccept below
           cltservsock.AcceptRequest(cltsock, @cltaddr);
           if hsoEnableTls in fOptions then
-            cltservsock.DoTlsHandshake({accept=}true);
+            cltservsock.DoTlsAfter(cstaAccept);
           endtix := fHeaderRetrieveAbortDelay;
           if endtix > 0 then
             inc(endtix, mormot.core.os.GetTickCount64);
@@ -1832,7 +1832,7 @@ procedure THttpServer.Execute;
         // use thread pool to process the request header, and probably its body
         cltservsock := fSocketClass.Create(self);
         if hsoEnableTls in fOptions then
-          cltservsock.TLS := fSock.TLS;
+          cltservsock.TLS := fSock.TLS; // for cstaAccept in TaskProcess
         // we tried to reuse the fSocketClass instance -> no performance change
         cltservsock.AcceptRequest(cltsock, @cltaddr);
         if not fThreadPool.Push(pointer(PtrUInt(cltservsock)),
@@ -2062,7 +2062,7 @@ procedure THttpServerSocket.TaskProcess(aCaller: TSynThreadPoolWorkThread);
   freeme := true;
   try
     if hsoEnableTls in fServer.Options then
-      DoTlsHandshake({accept=}true);
+      DoTlsAfter(cstaAccept);
     headertix := fServer.HeaderRetrieveAbortDelay;
     if headertix > 0 then
       headertix := headertix + GetTickCount64;