正确使用 HsOpenSSLAPI 实现 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？W.R.T 对 HsOpenSSL API 提供的函数调用的并发/并行执行(在上述用例的上下文中)的危险在哪里？

PS: 我仍然在努力完全理解如何使代码对异常和资源泄漏变得健壮。因此，尽管不是这个问题的主要焦点，如果您注意到上面的代码中有不好的地方，请留下注释。

3705 次浏览
小开
最佳答案

为此，您需要用两个不同的函数替换 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) addr

提交答案