Ordnungsgemäße Verwendung der HsOpenSSL-API zur Implementierung eines TLS-Servers

Ich versuche herauszufinden, wie die OpenSSL.Session- API in einem gleichzeitigen Kontext richtig verwendet wird

Angenommen, ich möchte eine implementieren stunnel-style ssl-wrapper, würde ich die folgende grundlegende Skelettstruktur erwarten, die eine naive implementiertfull-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

Wie verwandle ich das obige Skelett in ein full-duplex ssl-wrapping tcp-forwarding proxy? Wo liegen die Gefahren von WRT für die gleichzeitige / parallele Ausführung (im Kontext des obigen Anwendungsfalls) der von der HsOpenSSL-API bereitgestellten Funktionsaufrufe?

PS: Ich habe immer noch Schwierigkeiten zu verstehen, wie der Code gegenüber Ausnahmen und Ressourcenlecks robust gemacht werden kann. Obwohl dies nicht der Hauptfokus dieser Frage ist, hinterlassen Sie bitte einen Kommentar, wenn Sie im obigen Code etwas Schlechtes bemerken.

Dazu müssen Sie copySocketzwei verschiedene Funktionen ersetzen , eine zum Verarbeiten von Daten vom einfachen Socket zu SSL und die andere von SSL zum einfachen Socket:

  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

Dann müssen Sie Änderungen connectToServervornehmen, damit eine SSL-Verbindung hergestellt wird

  -- |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

und ändern Sie finalizediese Option, um die SSL-Sitzung zu beenden

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

Vergessen Sie nicht, Ihre Hauptaufgaben withOpenSSLwie in auszuführen

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