Sử dụng đúng API HsOpenSSL để triển khai Máy chủ TLS

Tôi đang cố gắng tìm ra cách sử dụng API OpenSSL.Session đúng cách trong ngữ cảnh đồng thời

Ví dụ, giả sử tôi muốn thực hiện một stunnel-style ssl-wrapper, tôi hy vọng sẽ có cấu trúc bộ xương cơ bản sau, thực hiện một sự ngây thơ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

Làm thế nào để tôi biến đổi bộ xương trên thành một full-duplex ssl-wrapping tcp-forwarding proxy? Đâu là mối nguy hiểm WRT đối với việc thực thi đồng thời / song song (trong bối cảnh của trường hợp sử dụng ở trên) của các lệnh gọi hàm được cung cấp bởi API HsOpenSSL?

Tái bút: Tôi vẫn đang cố gắng để hiểu đầy đủ về cách làm cho mã mạnh mẽ trở thành ngoại lệ và rò rỉ tài nguyên. Vì vậy, mặc dù không phải là trọng tâm chính của câu hỏi này, nếu bạn nhận thấy điều gì đó không tốt trong đoạn mã trên, vui lòng để lại nhận xét.

Để thực hiện việc này, bạn cần thay thế copySocketbằng hai chức năng khác nhau, một để xử lý dữ liệu từ ổ cắm đơn giản sang SSL và chức năng khác từ SSL sang ổ cắm đơn giản:

  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

Sau đó, bạn cần sửa đổi connectToServerđể thiết lập kết nối 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

và thay đổi finalizeđể tắt phiên 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

Cuối cùng, đừng quên chạy nội dung chính của bạn trong withOpenSSLnhư trong

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