[haskell] HsOpenSSL API를 올바르게 사용하여 TLS 서버 구현

Program / 글쓴이

동시 컨텍스트에서 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가 제공하는 함수 호출의 동시 / 병렬 실행 (위의 사용 사례와 관련하여)에 대한 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

그런 다음 connectToServerSSL 연결을 설정 하도록 수정해야 합니다

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

finalizeSSL 세션을 종료하도록 변경 하십시오.

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

답변