From 1605c4bd00f5b3fad3452550b0a4d5bc4cd1e98e Mon Sep 17 00:00:00 2001
From: notogawa <n.ohkawa@gmail.com>
Date: Sat, 17 Nov 2012 01:01:41 +0900
Subject: [PATCH] add flag to reject SSLv2 compatible handshake.

---
 core/Network/TLS/IO.hs | 5 +++++
 core/tls.cabal         | 5 +++++
 2 files changed, 10 insertions(+)

diff --git a/core/Network/TLS/IO.hs b/core/Network/TLS/IO.hs
index a9aff37..efaa087 100644
--- a/core/Network/TLS/IO.hs
+++ b/core/Network/TLS/IO.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
 -- |
 -- Module      : Network.TLS.IO
 -- License     : BSD-style
@@ -52,10 +53,14 @@ readExact ctx sz = do
 
 recvRecord :: MonadIO m => Context -> m (Either TLSError (Record Plaintext))
 recvRecord ctx = do
+#ifdef SSLV2_COMPATIBLE
         header <- readExact ctx 2
         if B.head header < 0x80
                 then readExact ctx 3 >>= either (return . Left) recvLength . decodeHeader . B.append header
                 else either (return . Left) recvDeprecatedLength $ decodeDeprecatedHeaderLength header
+#else
+        readExact ctx 5 >>= either (return . Left) recvLength . decodeHeader
+#endif
         where recvLength header@(Header _ _ readlen)
                 | readlen > 16384 + 2048 = return $ Left maximumSizeExceeded
                 | otherwise              = readExact ctx (fromIntegral readlen) >>= makeRecord ctx header
diff --git a/core/tls.cabal b/core/tls.cabal
index d4b8b3f..599b187 100644
--- a/core/tls.cabal
+++ b/core/tls.cabal
@@ -34,6 +34,9 @@ Flag executable
   Description:       Build the executable
   Default:           False
 
+Flag compat
+  Description:       Accept SSLv2 compatible handshake
+
 Library
   Build-Depends:     base >= 3 && < 5
                    , mtl
@@ -78,6 +81,8 @@ Library
   ghc-options:       -Wall
   if impl(ghc == 7.6.1)
     ghc-options:     -O0
+  if flag(compat)
+    cpp-options:     -DSSLV2_COMPATIBLE
 
 executable           Tests
   Main-is:           Tests.hs