Haskell 正确使用HsOpenSSL API实现TLS服务器

Haskell 正确使用HsOpenSSL API实现TLS服务器,haskell,openssl,ssl,Haskell,Openssl,Ssl,我试图弄清楚如何在并发上下文中正确使用API 例如,假设我想要实现一个stunnel风格的ssl包装器,我希望有以下基本框架结构,它实现了一个简单的全双工tcp端口转发器: runProxy :: PortID -> AddrInfo -> IO () runProxy localPort@(PortNumber lpn) serverAddrInfo = do listener <- listenOn localPort forever $ do (sCli

我试图弄清楚如何在并发上下文中正确使用API

例如,假设我想要实现一个
stunnel风格的ssl包装器
,我希望有以下基本框架结构,它实现了一个简单的
全双工tcp端口转发器:

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
runProxy::PortID->AddrInfo->IO()
runProxy localPort@(端口号lpn)serverAddrInfo=do
侦听器套接字->IO()
copySocket src dst=go
哪里
去做

buf为此,您需要用两个不同的函数替换
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
并更改
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
最后,不要忘记使用OpenSSL在
中运行您的主要内容,如中所示

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
main=withOpenSSL$do
让hints=defaultHints{addrSocketType=Stream,addrFamily=AF_INET}

地址我想这个问题可能太宽泛了。我会就此回复你:-)到文档的链接断开了,这是正在工作的人:我做了类似的事情(
全双工ssl重写tcp转发
),但它使用了
网络.TLS
(package
TLS
)。而且很难看。如果你有兴趣的话,你可以找到它;这提供了一个与
stunnels
客户端模式对应的本地非ssl到远程ssl代理,您是否可以提供一个示例,说明如何侦听本地ssl套接字(例如,提供本地ssl到远程非ssl代理)?
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