haskell - Uso adecuado de la API HsOpenSSL para implementar un servidor TLS

Question

Estoy intentando descubrir cómo usar correctamente la API OpenSSL.Session en un contexto concurrente

Por ejemplo, supongamos que quiero implementar un stunnel-style ssl-wrapper , espero tener la siguiente estructura de esqueleto básico, que implementa un full-duplex tcp-port-forwarder: ingenuo de 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

¿Cómo transformo el esqueleto anterior en un full-duplex ssl-wrapping tcp-forwarding proxy ? ¿Dónde están los peligros WRT para la ejecución concurrente / paralela (en el contexto del caso de uso anterior) de las llamadas a funciones proporcionadas por la API HsOpenSSL?

PD: Todavía estoy luchando por comprender completamente cómo hacer que el código sea robusto para excepciones y pérdidas de recursos. Entonces, aunque no sea el foco principal de esta pregunta, si nota algo malo en el código anterior, por favor deje un comentario.

Answer 1

Para hacer esto, debe reemplazar copySocket con dos funciones diferentes, una para manejar los datos del socket simple a SSL y la otra de SSL al socket simple:

 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

Luego debe modificar connectToServer para que establezca una conexión 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

y cambiar finalize para cerrar la sesió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

Finalmente, no te olvides de ejecutar tus cosas principales dentro de withOpenSSL como en

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