From 620dfe2fe8e3c9426b16f347368cbfdefb21474e Mon Sep 17 00:00:00 2001
From: Viktor Dukhovni <postfix-users@dukhovni.org>
Date: Wed, 30 Nov 2016 19:02:54 -0500
Subject: [PATCH] Handle no shared ciphers more gracefully

---
 core/Network/TLS/Handshake/Server.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs
index 90b247e9a..c28a060f4 100644
--- a/core/Network/TLS/Handshake/Server.hs
+++ b/core/Network/TLS/Handshake/Server.hs
@@ -117,13 +117,16 @@ handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientS
 
     extraCreds <- (onServerNameIndication $ serverHooks sparams) serverName
 
+    -- The shared cipherlist can become empty after filtering for compatible
+    -- creds, check now before calling onCipherChoosing, which does not handle
+    -- empty lists.
     let ciphersFilteredVersion = filter (cipherAllowedForVersion chosenVersion) (commonCiphers extraCreds)
-        usedCipher = (onCipherChoosing $ serverHooks sparams) chosenVersion ciphersFilteredVersion
-        creds = extraCreds `mappend` (sharedCredentials $ ctxShared ctx)
-
-    when (commonCipherIDs extraCreds == []) $ throwCore $
+    when (null ciphersFilteredVersion) $ throwCore $
         Error_Protocol ("no cipher in common with the client", True, HandshakeFailure)
 
+    let usedCipher = (onCipherChoosing $ serverHooks sparams) chosenVersion ciphersFilteredVersion
+        creds = extraCreds `mappend` (sharedCredentials $ ctxShared ctx)
+
     cred <- case cipherKeyExchange usedCipher of
                 CipherKeyExchange_RSA     -> return $ credentialsFindForDecrypting creds
                 CipherKeyExchange_DH_Anon -> return $ Nothing