Add local features optional param to TlsInitServer in all backends

wqweto · Jun 29, 2021 · bfb095b · bfb095b
1 parent aebec3e
commit bfb095b
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 12 deletions.
diff --git a/src/cTlsSocket.cls b/src/cTlsSocket.cls
@@ -533,7 +533,8 @@ Public Function InitServerTls( _
             Optional Password As String, _
             Optional Certificates As Collection, _
             Optional PrivateKey As Collection, _
-            Optional AlpnProtocols As String) As Boolean
+            Optional AlpnProtocols As String, _
+            Optional ByVal LocalFeatures As UcsTlsLocalFeaturesEnum) As Boolean
     Dim cCerts          As Collection
     Dim cPrivKey        As Collection
 
@@ -562,9 +563,13 @@ StartTls:
     m_bUseTls = True
     m_bIsServer = True
     m_oSocket.GetPeerName m_sRemoteHostName, 0
-    m_eLocalFeatures = ucsTlsSupportTls13
     m_sAlpnProtocols = AlpnProtocols
-    If Not TlsInitServer(m_uCtx, m_sRemoteHostName, cCerts, cPrivKey, m_sAlpnProtocols) Then
+    If (LocalFeatures And ucsTlsSupportAll) = 0 Then
+        m_eLocalFeatures = LocalFeatures Or ucsTlsSupportAll
+    Else
+        m_eLocalFeatures = LocalFeatures
+    End If
+    If Not TlsInitServer(m_uCtx, m_sRemoteHostName, cCerts, cPrivKey, m_sAlpnProtocols, m_eLocalFeatures) Then
         GoTo QH
     End If
     '--- success
@@ -576,8 +581,7 @@ Public Function Accept( _
             ConnectedSocket As cTlsSocket, _
             Optional SocketAddress As String, _
             Optional SocketPort As Long, _
-            Optional ByVal UseTls As Boolean = True, _
-            Optional AlpnProtocols As String) As Boolean
+            Optional ByVal UseTls As Boolean = True) As Boolean
     Const FUNC_NAME     As String = "Accept"
 
     On Error GoTo EH
@@ -588,7 +592,7 @@ Public Function Accept( _
         GoTo QH
     End If
     If UseTls Then
-        If Not ConnectedSocket.InitServerTls(Certificates:=LocalCertificates, PrivateKey:=LocalPrivateKey, AlpnProtocols:=AlpnProtocols) Then
+        If Not ConnectedSocket.InitServerTls(Certificates:=LocalCertificates, PrivateKey:=LocalPrivateKey, AlpnProtocols:=m_sAlpnProtocols, LocalFeatures:=m_eLocalFeatures) Then
             GoTo QH
         End If
     End If

diff --git a/src/mdTlsNative.bas b/src/mdTlsNative.bas
@@ -458,7 +458,8 @@ Public Function TlsInitServer( _
             Optional RemoteHostName As String, _
             Optional Certificates As Collection, _
             Optional PrivateKey As Collection, _
-            Optional AlpnProtocols As String) As Boolean
+            Optional AlpnProtocols As String, _
+            Optional ByVal LocalFeatures As Long = ucsTlsSupportAll) As Boolean
     Dim uEmpty          As UcsTlsContext
 
     On Error GoTo EH
@@ -467,7 +468,7 @@ Public Function TlsInitServer( _
         .IsServer = True
         .State = ucsTlsStateHandshakeStart
         .RemoteHostName = RemoteHostName
-        .LocalFeatures = ucsTlsSupportAll
+        .LocalFeatures = LocalFeatures
         Set .LocalCertificates = Certificates
         Set .LocalPrivateKey = PrivateKey
         If RealOsVersion >= [ucsOsvWin8.1] Then

diff --git a/src/mdTlsSodium.bas b/src/mdTlsSodium.bas
@@ -595,7 +595,8 @@ Public Function TlsInitServer( _
             Optional RemoteHostName As String, _
             Optional Certificates As Collection, _
             Optional PrivateKey As Collection, _
-            Optional AlpnProtocols As String) As Boolean
+            Optional AlpnProtocols As String, _
+            Optional ByVal LocalFeatures As Long = ucsTlsSupportAll) As Boolean
 #If Not ImplTlsServer Then
     Err.Raise vbObjectError, , ERR_NO_SERVER_COMPILED
 #Else
@@ -610,7 +611,7 @@ Public Function TlsInitServer( _
         .IsServer = True
         .State = ucsTlsStateExpectClientHello
         .RemoteHostName = RemoteHostName
-        .LocalFeatures = ucsTlsSupportTls13
+        .LocalFeatures = LocalFeatures
         Set .LocalCertificates = Certificates
         Set .LocalPrivateKey = PrivateKey
         .AlpnProtocols = AlpnProtocols

diff --git a/test/BareboneTls/Module2.bas b/test/BareboneTls/Module2.bas
@@ -39,7 +39,8 @@ Public Function TlsInitServer( _
             Optional RemoteHostName As String, _
             Optional Certificates As Collection, _
             Optional PrivateKey As Collection, _
-            Optional AlpnProtocols As String) As Boolean
+            Optional AlpnProtocols As String, _
+            Optional ByVal LocalFeatures As Long) As Boolean
 
 End Function
 

diff --git a/test/Secure/Form2.frm b/test/Secure/Form2.frm
@@ -406,7 +406,7 @@ Private Sub m_oServerSocket_OnAccept()
     Dim sKey            As String
 
     On Error GoTo EH
-    If Not m_oServerSocket.Accept(oSocket, AlpnProtocols:="http/1.1") Then
+    If Not m_oServerSocket.Accept(oSocket) Then
         GoTo QH
     End If
     Set oHandler = New cRequestHandler