Fix XP support for non-system certificates in native backend

wqweto · Nov 6, 2023 · 77b2412 · 77b2412
1 parent 146b1f4
commit 77b2412
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 18 deletions.
diff --git a/src/cTlsSocket.cls b/src/cTlsSocket.cls
@@ -2317,7 +2317,7 @@ Private Function pvPkiPkcs12ImportCertificates(sPfxFile As String, sPassword As
     End If
     uBlob.cbData = UBound(baPfx) + 1
     uBlob.pbData = VarPtr(baPfx(0))
-    dwFlags = CRYPT_EXPORTABLE Or IIf(OsVersion < ucsOsvXp, 0, PKCS12_NO_PERSIST_KEY)
+    dwFlags = CRYPT_EXPORTABLE Or IIf(OsVersion <= ucsOsvXp, 0, PKCS12_NO_PERSIST_KEY)
     hPfxStore = PFXImportCertStore(uBlob, StrPtr(sPassword), dwFlags)
     If hPfxStore = 0 And Err.LastDllError <> NTE_BAD_ALGID Then
         hPfxStore = PFXImportCertStore(baPfx(0), 0, dwFlags)

diff --git a/src/mdTlsNative.bas b/src/mdTlsNative.bas
@@ -91,6 +91,7 @@ Private Const CERT_STORE_CREATE_NEW_FLAG                As Long = &H2000
 Private Const CERT_STORE_ADD_USE_EXISTING               As Long = 2
 '--- for CryptAcquireContext
 Private Const PROV_RSA_FULL                             As Long = 1
+Private Const PROV_RSA_SCHANNEL                         As Long = 12
 Private Const CRYPT_NEWKEYSET                           As Long = &H8
 Private Const CRYPT_DELETEKEYSET                        As Long = &H10
 Private Const AT_KEYEXCHANGE                            As Long = 1
@@ -571,6 +572,7 @@ Public Function TlsHandshake(uCtx As UcsTlsContext, baInput() As Byte, ByVal lSi
     Dim uCipherInfo     As SecPkgContext_CipherInfo
     Dim baAlpnBuffer()  As Byte
     Dim uAppProtocol    As SecPkgContext_ApplicationProtocol
+    Dim eVersion        As UcsOsVersionEnum
 
     On Error GoTo EH
     With uCtx
@@ -616,19 +618,21 @@ RetryCredentials:
                     .ContextReq = .ContextReq Or ISC_REQ_USE_SUPPLIED_CREDS     ' Schannel must not attempt to supply credentials for the client automatically.
                 End If
             End If
-            If RealOsVersion(BuildNo:=lIdx) = ucsOsvWin10 And lIdx >= 20348 Then   '--- 20348 = Windows Server 2022
-                '--- use new credentials struct for TLS 1.3 support
-                uNewCred.dwVersion = SCH_CREDENTIALS_VERSION
-                uNewCred.cCreds = uCred.cCreds
-                uNewCred.paCred = uCred.paCred
-                uNewCred.dwFlags = uCred.dwFlags Or SCH_USE_STRONG_CRYPTO
-                uNewCred.cTlsParameters = 1
-                uNewCred.pTlsParameters = VarPtr(uNewParams)
-                uNewParams.grbitDisabledProtocols = Not (uCred.grbitEnabledProtocols Or _
-                    IIf((.LocalFeatures And ucsTlsSupportTls13) <> 0, SP_PROT_TLS1_3, 0))
-                hResult = AcquireCredentialsHandle(0, StrPtr(UNISP_NAME), IIf(.IsServer, SECPKG_CRED_INBOUND, SECPKG_CRED_OUTBOUND), 0, uNewCred, 0, 0, .hTlsCredentials, 0)
-            Else
-                hResult = -1
+            hResult = -1
+            If (.LocalFeatures And ucsTlsSupportTls13) <> 0 Then
+                eVersion = RealOsVersion(BuildNo:=lIdx)
+                If eVersion > ucsOsvWin10 Or (eVersion = ucsOsvWin10 And lIdx >= 20348) Then   '--- 20348 = Windows Server 2022
+                    '--- use new credentials struct for TLS 1.3 support
+                    uNewCred.dwVersion = SCH_CREDENTIALS_VERSION
+                    uNewCred.cCreds = uCred.cCreds
+                    uNewCred.paCred = uCred.paCred
+                    uNewCred.dwFlags = uCred.dwFlags Or SCH_USE_STRONG_CRYPTO
+                    uNewCred.cTlsParameters = 1
+                    uNewCred.pTlsParameters = VarPtr(uNewParams)
+                    uNewParams.grbitDisabledProtocols = Not (uCred.grbitEnabledProtocols Or _
+                        IIf((.LocalFeatures And ucsTlsSupportTls13) <> 0, SP_PROT_TLS1_3, 0))
+                    hResult = AcquireCredentialsHandle(0, StrPtr(UNISP_NAME), IIf(.IsServer, SECPKG_CRED_INBOUND, SECPKG_CRED_OUTBOUND), 0, uNewCred, 0, 0, .hTlsCredentials, 0)
+                End If
             End If
             If hResult < 0 Then
                 hResult = AcquireCredentialsHandle(0, StrPtr(UNISP_NAME), IIf(.IsServer, SECPKG_CRED_INBOUND, SECPKG_CRED_OUTBOUND), 0, uCred, 0, 0, .hTlsCredentials, 0)
@@ -1378,7 +1382,7 @@ Private Function pvTlsImportToCertStore(cCerts As Collection, cPrivKey As Collec
             Select Case pvToStringA(uPublicKeyInfo.Algorithm.pszObjId)
             Case szOID_RSA_RSA
                 uProvInfo.pwszContainerName = StrPtr(sKeyName)
-                uProvInfo.dwProvType = PROV_RSA_FULL
+                uProvInfo.dwProvType = PROV_RSA_SCHANNEL '--- note: PROV_RSA_FULL fails on WinXP
                 uProvInfo.dwKeySpec = AT_KEYEXCHANGE
                 If CryptAcquireContext(hProv, uProvInfo.pwszContainerName, uProvInfo.pwszProvName, uProvInfo.dwProvType, uProvInfo.dwFlags) = 0 Then
                     If CryptAcquireContext(hProv, uProvInfo.pwszContainerName, uProvInfo.pwszProvName, uProvInfo.dwProvType, uProvInfo.dwFlags Or CRYPT_NEWKEYSET) = 0 Then

diff --git a/test/Secure/Form2.frm b/test/Secure/Form2.frm
@@ -144,7 +144,7 @@ Private Sub Form_Load()
     If txtResult.Font.Name = "Arial" Then
         txtResult.Font.Name = "Courier New"
     End If
-    For Each vElem In Split("www.howsmyssl.com/a/check|clienttest.ssllabs.com:8443/ssltest/viewMyClient.html|client.tlsfingerprint.io:8443|tls13.1d.pw|localhost:44330/renegcert|websocket.org|www.mikestoolbox.org|swifttls.org|rsa8192.badssl.com|rsa4096.badssl.com|rsa2048.badssl.com|ecc384.badssl.com|ecc256.badssl.com|dir.bg|host.bg|bgdev.org|cnn.com|gmail.com|google.com|saas.bg|saas.bg:465|www.cloudflare.com|devblogs.microsoft.com|www.brentozar.com|ayende.com/blog|www.nerds2nerds.com|robert.ocallahan.org|distrowatch.com|server.cryptomix.com|www.integralblue.com/testhandshake/|tlshello.agwa.name|client.badssl.com", "|")
+    For Each vElem In Split("www.howsmyssl.com/a/check|tls.peet.ws/api/all|clienttest.ssllabs.com:8443/ssltest/viewMyClient.html|client.tlsfingerprint.io:8443|tls13.1d.pw|localhost:44330/renegcert|websocket.org|www.mikestoolbox.org|swifttls.org|rsa8192.badssl.com|rsa4096.badssl.com|rsa2048.badssl.com|ecc384.badssl.com|ecc256.badssl.com|dir.bg|host.bg|bgdev.org|cnn.com|gmail.com|google.com|saas.bg|saas.bg:465|www.cloudflare.com|devblogs.microsoft.com|www.brentozar.com|ayende.com/blog|www.nerds2nerds.com|robert.ocallahan.org|distrowatch.com|server.cryptomix.com|www.integralblue.com/testhandshake/|tlshello.agwa.name|client.badssl.com", "|")
         cobUrl.AddItem vElem
     Next
     sAddr = GetSetting(App.Title, "Form1", "Url", cobUrl.Text)
@@ -158,10 +158,10 @@ Private Sub Form_Load()
         Set m_oServerSocket = New cTlsSocket
         ChDir App.Path
         If Not m_oServerSocket.InitServerTls(STR_CERTFILE, STR_PASSWORD) Then
-            MsgBox "Error starting TLS server on localhost:10443" & vbCrLf & vbCrLf & "No private key found!", vbExclamation
+            MsgBox "Error starting TLS server on localhost:10443" & vbCrLf & vbCrLf & m_oServerSocket.LastError.Description, vbExclamation
             GoTo QH
         End If
-        If Not m_oServerSocket.Create(SocketPort:=10443, SocketAddress:="localhost") Then
+        If Not m_oServerSocket.Create(SocketPort:=10443, SocketAddress:="0.0.0.0") Then
             GoTo QH
         End If
         If Not m_oServerSocket.Listen() Then