我正在试图找出如何在并发上下文中正确使用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 ？ 在HsOpenSSL API提供的函数调用中WRT到并发/并行执行（在上述用例的上下文中）的危险在哪里？
PS：我仍然在努力地充分理解如何使代码对异常和资源泄露的强大威胁。 所以，虽然不是这个问题的主要焦点，如果你在上面的代码中注意到一些不好的话，请发表评论。
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 sServerHow 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.
最满意答案
要做到这一点，您需要用两个不同的功能来替换copySocket ，一个用于处理从普通套接字到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 ，以建立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并更改finalize以关闭SSL会话
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) addrTo 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 goThen 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 sslServerand 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 sClientFinally, 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更多推荐
发布评论