X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FSocketLike.hs;h=580ee529fdd139d2726a5a5d79435e713b252a3f;hb=b495d6b8b7647b719eceef2f3e50d5bf87c430cf;hp=b9668e067d47a281516c9fc1cc0c6835a693a20a;hpb=cc074d0ce3f7df2544bc2baddca4e7730ecdf0a0;p=Lucu.git

diff --git a/Network/HTTP/Lucu/SocketLike.hs b/Network/HTTP/Lucu/SocketLike.hs
index b9668e0..580ee52 100644
--- a/Network/HTTP/Lucu/SocketLike.hs
+++ b/Network/HTTP/Lucu/SocketLike.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
-    FlexibleContexts
+    CPP
+  , FlexibleContexts
   , FlexibleInstances
   , TypeFamilies
   , UnicodeSyntax
@@ -9,10 +10,16 @@ module Network.HTTP.Lucu.SocketLike
     ( SocketLike(..)
     )
     where
+#if defined(HAVE_SSL)
+import Control.Exception
+#endif
 import qualified Network.Socket as So
 import Network.HTTP.Lucu.HandleLike
+#if defined(HAVE_SSL)
 import qualified OpenSSL.Session as SSL
+import Prelude hiding (catch)
 import Prelude.Unicode
+#endif
 import qualified System.IO as I
 
 class (HandleLike (Handle s)) ⇒ SocketLike s where
@@ -30,13 +37,33 @@ instance SocketLike So.Socket where
 
     socketPort = So.socketPort
 
+#if defined(HAVE_SSL)
 instance SocketLike (SSL.SSLContext, So.Socket) where
     type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
 
     accept (ctx, soSelf)
         = do (soPeer, addr) ← So.accept soSelf
              ssl            ← SSL.connection ctx soPeer
-             SSL.accept ssl
-             return (ssl, addr)
+             handshake ssl addr `catch` next ssl addr
+        where
+          handshake ∷ SSL.SSL → So.SockAddr → IO (SSL.SSL, So.SockAddr)
+          handshake ssl addr
+              = do SSL.accept ssl
+                   return (ssl, addr)
+
+          next ∷ SSL.SSL
+               → So.SockAddr
+               → SSL.SomeSSLException
+               → IO (SSL.SSL, So.SockAddr)
+          next ssl addr e
+              = do I.hPutStrLn I.stderr
+                       $ "Lucu: failed to accept an SSL connection from "
+                       ⧺ show addr
+                       ⧺ ":"
+                   I.hPutStrLn I.stderr
+                       $ show e
+                   SSL.shutdown ssl SSL.Bidirectional
+                   accept (ctx, soSelf)
 
     socketPort = So.socketPort ∘ snd
+#endif