การใช้ HsOpenSSL API อย่างเหมาะสมเพื่อติดตั้งเซิร์ฟเวอร์ TLS

ฉันกำลังพยายามหาวิธีการใช้OpenSSL.Session API อย่างถูกต้องในบริบทที่เกิดขึ้นพร้อมกัน

เช่นสมมติว่าฉันต้องการใช้ a 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

ฉันจะเปลี่ยนโครงกระดูกข้างต้นเป็น a ได้full-duplex ssl-wrapping tcp-forwarding proxyอย่างไร WRT อันตรายที่จะดำเนินการพร้อมกัน / ขนานอยู่ที่ไหน (ในบริบทของกรณีการใช้งานด้านบน) ของการเรียกใช้ฟังก์ชันที่ HsOpenSSL API ให้มา

PS: ฉันยังคงดิ้นรนอย่างเต็มที่ที่จะเข้าใจวิธีการทำให้รหัส wrt ที่แข็งแกร่งเพื่อข้อยกเว้นและการรั่วไหลของทรัพยากร ดังนั้นแม้ว่าจะไม่ได้เป็นจุดสนใจหลักของคำถามนี้หากคุณสังเกตเห็นสิ่งที่ไม่ดีในรหัสข้างต้นโปรดแสดงความคิดเห็น

ในการทำเช่นนี้คุณต้องแทนที่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