正確使用HsOpenSSL API的實現TLS服務器

Question

我試圖找出如何正確使用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提供的函數調用的並行/並行執行（在上述用例的情況下），危險W.R.T在哪裏？ PS：我仍然在努力完全理解如何使代碼健壯w.r.t.異常和資源泄漏。因此，儘管不是這個問題的主要焦點，但如果您發現上述代碼中有什麼不妥，請留下評論。

Answer 1

要做到這一點，你需要具備兩種不同功能，以取代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