From 5c2c5e4b1a23e5255ac3f9b73406ee73988b7600 Mon Sep 17 00:00:00 2001
From: mbays <mbays@sdf.org>
Date: Sun, 21 Apr 2024 00:00:00 +0000
Subject: [PATCH] allow connecting to TLS1.2 servers without EMS

But warn if client cert may be used.
---
 GeminiProtocol.hs | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/GeminiProtocol.hs b/GeminiProtocol.hs
index 3e4f592..4705488 100644
--- a/GeminiProtocol.hs
+++ b/GeminiProtocol.hs
@@ -189,7 +189,10 @@ makeRequest (RequestContext (InteractionCallbacks displayInfo displayWarning _ p
         let serverId = if port == defaultGeminiPort then BS.empty else TS.encodeUtf8 . TS.pack . (':':) $ show port
             sessionManager = clientSessionManager 3600 clientSessions ccfp
             params = (TLS.defaultParamsClient hostname serverId)
-                { clientSupported = def { supportedCiphers = gemini_ciphersuite }
+                { clientSupported = def
+                    { supportedCiphers = gemini_ciphersuite
+                    , supportedExtendedMainSecret = AllowEMS
+                    }
                 -- |RFC6066 disallows SNI with literal IP addresses
                 , clientUseServerNameIndication = not $ isIPv4address hostname || isIPv6address hostname
                 , clientHooks = def
@@ -229,13 +232,16 @@ makeRequest (RequestContext (InteractionCallbacks displayInfo displayWarning _ p
             sock <- openSocket
             c <- TLS.contextNew sock params
             handle retryNoResume $ handshake c >> return (sock,c)
-        sendData context $ BL.fromStrict requestBytes
-        when verboseConnection . void . runMaybeT $ do
+        void . runMaybeT $ do
             info <- MaybeT $ contextGetInformation context
-            lift . displayInfo $ [ "TLS version " ++ show (infoVersion info) ++
-                ", cipher " ++ cipherName (infoCipher info) ]
-            mode <- MaybeT . return $ infoTLS13HandshakeMode info
-            lift . displayInfo $ [ "Handshake mode " ++ show mode ]
+            when (infoVersion info == TLS12 && not (infoExtendedMainSecret info) && isJust mIdent) $ do
+                lift $ displayWarning [ "TLS1.2 server without EMS support is vulnerable to triple-handshake attack." ]
+            when verboseConnection $ do
+                lift . displayInfo $ [ "TLS version " ++ show (infoVersion info) ++
+                    ", cipher " ++ cipherName (infoCipher info) ]
+                mode <- MaybeT . return $ infoTLS13HandshakeMode info
+                lift . displayInfo $ [ "Handshake mode " ++ show mode ]
+        sendData context $ BL.fromStrict requestBytes
         chan <- newBSChan bound
         let recvAllLazily = do
                 r <- recvData context
-- 
2.11.4.GIT