Proper use of the HsOpenSSL API to implement a TLS Server

Question

I'm trying to figure out how to properly use the OpenSSL.Session API in a concurrent context

E.g. assume I want to implement a stunnel-style ssl-wrapper, I'd expect to have the following basic skeleton structure, which implements a naive full-duplex tcp-port-forwarder:

runProxy :: PortID -> AddrInfo -> IO ()
runProxy localPort@(PortNumber lpn) serverAddrInfo = do
  listener <- listenOn localPort

  forever $ do
    (sClient, clientAddr) <- accept listener

    let finalize sServer = do
            sClose sServer
            sClose sClient

    forkIO $ do
        tidToServer <- myThreadId
        bracket (connectToServer serverAddrInfo) finalize $ \sServer -> do
            -- execute one 'copySocket' thread for each data direction
            -- and make sure that if one direction dies, the other gets
            -- pulled down as well
            bracket (forkIO (copySocket sServer sClient
                             `finally` killThread tidToServer))
                    (killThread) $ \_ -> do
                copySocket sClient sServer -- "controlling" thread

 where
  -- |Copy data from source to dest until EOF occurs on source
  -- Copying may also be aborted due to exceptions
  copySocket :: Socket -> Socket -> IO ()
  copySocket src dst = go
   where
    go = do
        buf <- B.recv src 4096
        unless (B.null buf) $ do
            B.sendAll dst buf
            go

  -- |Create connection to given AddrInfo target and return socket
  connectToServer saddr = do
    sServer <- socket (addrFamily saddr) Stream defaultProtocol
    connect sServer (addrAddress saddr)
    return sServer

How do I transform the above skeleton into a full-duplex ssl-wrapping tcp-forwarding proxy? Where are the dangers W.R.T to concurrent/parallel execution (in the context of the above use-case) of the function calls provided by the HsOpenSSL API?

PS: I'm still struggling to fully comprehend how to make the code robust w.r.t. to exceptions and resource-leaks. So, albeit not being the primary focus of this question, if you notice something bad in the code above, please leave a comment.

Answer 1

To do this you need to replace copySocket with two different functions, one to handle data from the plain socket to SSL and the other from SSL to the plain socket:

  copyIn :: SSL.SSL -> Socket -> IO ()
  copyIn src dst = go
   where
    go = do
        buf <- SSL.read src 4096
        unless (B.null buf) $ do
            SB.sendAll dst buf
            go

  copyOut :: Socket -> SSL.SSL -> IO ()
  copyOut src dst = go
   where
    go = do
        buf <- SB.recv src 4096
        unless (B.null buf) $ do
            SSL.write dst buf
            go

Then you need to modify connectToServer so that it establishes an SSL connection

  -- |Create connection to given AddrInfo target and return socket
  connectToServer saddr = do
    sServer <- socket (addrFamily saddr) Stream defaultProtocol
    putStrLn "connecting"
    connect sServer (addrAddress saddr)
    putStrLn "establishing ssl context"
    ctx <- SSL.context
    putStrLn "setting ciphers"
    SSL.contextSetCiphers ctx "DEFAULT"
    putStrLn "setting verfication mode"
    SSL.contextSetVerificationMode ctx SSL.VerifyNone
    putStrLn "making ssl connection"
    sslServer <- SSL.connection ctx sServer
    putStrLn "doing handshake"
    SSL.connect sslServer
    putStrLn "connected"
    return sslServer

and change finalize to shut down the SSL session

let finalize sServer = do
        putStrLn "shutting down ssl"
        SSL.shutdown sServer SSL.Unidirectional
        putStrLn "closing server socket"
        maybe (return ()) sClose (SSL.sslSocket sServer)
        putStrLn "closing client socket"
        sClose sClient

Finally, don't forget to run your main stuff within withOpenSSL as in

main = withOpenSSL $ do
    let hints = defaultHints { addrSocketType = Stream, addrFamily = AF_INET }
    addrs <- getAddrInfo (Just hints) (Just "localhost") (Just "22222")
    let addr = head addrs
    print addr
    runProxy (PortNumber 11111) addr