正确使用HsOpenSSL API来实现TLS服务器
我想弄清楚如何在并发上下文中正确使用OpenSSL.Session API
例如假设我想实现一个stunnel-style ssl-wrapper ，我期望有以下基本的骨架结构，它实现了一个天真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
如何将上述骨架转换为full-duplex ssl-wrapping tcp-forwarding proxy ？ WRT对于由HsOpenSSL API提供的函数调用的并行/并行执行（在上述用例的上下文中）危险在哪里？
PS：我仍然在努力完全理解如何使代码对于exception和资源泄漏具有鲁棒性。 所以，尽pipe不是这个问题的主要焦点，但是如果您在上面的代码中发现了一些问题，请留下评论。
要做到这一点，你需要用两个不同的函数replacecopySocket ，一个处理从纯套接字到SSL的数据，另一个从SSL到纯套接字：
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
那么你需要修改connectToServer以便它build立一个SSL连接
-- |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
并改变finalizeclosuresSSL会话
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
最后，不要忘记用withOpenSSL来运行你的主要内容
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
