如何将 TLS 加密添加到此 TCP 服务器

Question

我已经为一个项目构建了一个TCP服务器，它工作正常，但是是时候添加TLS了。我尝试了Network.Simple.TCP.TLS，但是当我把它集成到我的大项目中时，我遇到了一些我无法解决的依赖冲突。

这里的代码是简化的测试服务器，稍后我将将其集成到更大的项目中。我希望这不会隐藏任何重要细节。

这是一个没有 TLS 的工作回显服务器：

import Control.Concurrent
import Network.Socket
import System.IO
main :: IO ()
main = do
  let port = 4653
  sock <- socket AF_INET Stream 0
  setSocketOption sock ReuseAddr 1
  bindSocket sock (SockAddrInet (fromInteger port) iNADDR_ANY)
  putStrLn $ "Listening on port " ++ show port
  listen sock 2
  mainLoop sock

mainLoop :: Socket -> IO ()
mainLoop sock = do
  conn <- accept sock
  _ <- forkIO $ runConn conn
  mainLoop sock

runConn :: (Socket, SockAddr) -> IO ()
runConn (sock, _) = do
  hdl <- socketToHandle sock ReadWriteMode
  hSetBuffering hdl NoBuffering
  request <- hGetLine hdl 
  hPrint hdl request
  hClose hdl

这是我对TLS集成的尝试：

{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent
import qualified Crypto.Random.AESCtr       as AESCtr
import qualified Data.ByteString.Char8      as BSC
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Default.Class (def)
import Network.Socket
import qualified Network.TLS                as T
import qualified Network.TLS.Extra          as TE
import System.IO
main :: IO ()
main = do
  let port = 4653
  cred <- credentials
  let creds = case cred of
                Right c -> T.Credentials [c]
                Left e -> error e
  sock <- socket AF_INET Stream 0
  setSocketOption sock ReuseAddr 1
  bindSocket sock (SockAddrInet (fromInteger port) iNADDR_ANY)
  putStrLn $ "Listening on port " ++ show port
  listen sock 2
  mainLoop sock creds

mainLoop :: Socket -> T.Credentials -> IO ()
mainLoop sock creds = do
  conn <- accept sock
  _ <- forkIO $ runConn creds conn
  mainLoop sock creds

runConn :: T.Credentials -> (Socket, SockAddr) -> IO ()
runConn creds (sock, _) = do
  hdl <- socketToHandle sock ReadWriteMode
  hSetBuffering hdl NoBuffering
  ctx <- context creds hdl
  T.handshake ctx
  request <- T.recvData ctx
  T.sendData ctx (LBS.fromChunks [request])
  hClose hdl

context :: T.Credentials -> Handle -> IO T.Context
context creds hdl = T.contextNew (sockBackend hdl) (sockParams creds) =<< AESCtr.makeSystem

credentials :: IO (Either String T.Credential)
credentials = T.credentialLoadX509 "cert/server.crt" "cert/server.key"
sockBackend :: Handle -> T.Backend
sockBackend hdl = T.Backend { T.backendFlush = hFlush hdl
                            , T.backendClose = hClose hdl
                            , T.backendSend  = hPrint hdl
                            , T.backendRecv  = hRecv hdl BSC.empty
                            }

hRecv :: Handle -> BSC.ByteString -> Int -> IO BSC.ByteString
hRecv _ ack 0 = return ack
hRecv hdl ack n = do
  c <- hGetChar hdl
  hRecv hdl (ack `BSC.append` BSC.pack [c]) (n - 1)

sockParams :: T.Credentials -> T.ServerParams
sockParams creds = def { T.serverWantClientCert = False
                       , T.serverShared         = shared creds
                       , T.serverSupported      = supported
                       }
shared :: T.Credentials -> T.Shared
shared creds = def { T.sharedCredentials    = creds
                   }

supported :: T.Supported
supported = def { T.supportedVersions = [T.TLS10, T.TLS11, T.TLS12]
                , T.supportedCiphers  = ciphers
                }
ciphers :: [T.Cipher]
ciphers =
    [ TE.cipher_AES128_SHA1
    , TE.cipher_AES256_SHA1
    , TE.cipher_RC4_128_MD5
    , TE.cipher_RC4_128_SHA1
    ]

它可以编译并运行，但是每当我尝试点击它时，它都会打印此错误：

Main.hs: ConnectionNotEstablished

我在这里感觉很不合时宜。任何人都可以指出我的问题或将TLS加密添加到此服务器的更好方法吗？

编辑：我发现了我的部分问题。我错过了T.handshake电话。现在我在从客户端连接时遇到问题。如果我让它干净地运行，我会再次更新。

编辑2：顺便说一下，新错误是：

HandshakeFailed (Error_Packet_Parsing "Failed reading: invalid header type: 34nFrom:theadernn")

我在网络上的几个地方发现了这个错误，但我还没有看到附在上面的答案。

Answer 1

正如我在问题的第一个编辑中提到的，我最初错过了handshake电话。这还不足以解决这个问题。最终，我发现我可以将sock作为backend传递，而无需手动创建Backend实例。当我切换到该方法时，它开始使用下面包含的 Python 客户端。

Haskell服务器：

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Concurrent
import Control.Monad (void)
import qualified Crypto.Random.AESCtr       as AESCtr
import qualified Data.ByteString.Char8      as BSC 
import qualified Data.ByteString.Lazy.Char8 as LBS 
import Data.Default.Class (def)
import Network.Socket
import qualified Network.TLS                as T
import qualified Network.TLS.Extra          as TE
main :: IO ()
main = do
  let port = 4653
  cred <- credentials
  let creds = case cred of
                Right c -> T.Credentials [c] 
                Left e -> error e
  sock <- socket AF_INET Stream 0
  setSocketOption sock ReuseAddr 1
  bindSocket sock (SockAddrInet (fromInteger port) iNADDR_ANY)
  putStrLn $ "Listening on port " ++ show port
  listen sock 2
  mainLoop sock creds

mainLoop :: Socket -> T.Credentials -> IO ()
mainLoop sock creds = do
  conn <- accept sock
  _ <- forkIO $ runConn creds conn
  mainLoop sock creds

runConn :: T.Credentials -> (Socket, SockAddr) -> IO ()
runConn creds (sock, _) = do
  ctx <- T.contextNew sock (sockParams creds) =<< AESCtr.makeSystem
  T.handshake ctx 
  request <- T.recvData ctx
  print request
  T.sendData ctx (LBS.fromChunks [request])
  T.contextClose ctx

credentials :: IO (Either String T.Credential)
credentials = T.credentialLoadX509 "cert/server.crt" "cert/server.key"
sockParams :: T.Credentials -> T.ServerParams
sockParams creds = def { T.serverWantClientCert = False
                       , T.serverShared         = shared creds
                       , T.serverSupported      = supported
                       }
shared :: T.Credentials -> T.Shared
shared creds = def { T.sharedCredentials    = creds
                   }

supported :: T.Supported
supported = def { T.supportedVersions = [T.TLS10]
                , T.supportedCiphers = ciphers
                }

ciphers :: [T.Cipher]
ciphers =
    [ TE.cipher_AES128_SHA1
    , TE.cipher_AES256_SHA1
    , TE.cipher_RC4_128_MD5
    , TE.cipher_RC4_128_SHA1
    ]

蟒蛇客户端：

# Echo client program
import socket
import json
import ssl 
def recv_all(s):
    buf = 4096
    data = ''
    chunk = s.recv(buf)
    while len(chunk) > 0:
        data = data + chunk
        chunk = s.recv(buf)
    return data
def main():
    HOST = '127.0.0.1'    # The remote host
    PORT = 4653              # The same port as used by the server
    s = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
    ss = ssl.wrap_socket(s, ssl_version=ssl.PROTOCOL_TLSv1, do_handshake_on_connect=False)
    ss.connect((HOST, PORT))
    ss.do_handshake()
    ss.sendall('Hello, worldrn')
    data = recv_all(ss)
    s.close()
    print("Received %s" % data)

if __name__ == "__main__":
    main()

编辑：根据我在下面的评论，上面的服务器切断了大于16k的输入。我目前的解决方案是使用以下recvAll方法替换上述T.recvData：

recvAll :: T.Context -> IO BSC.ByteString 
recvAll ctx = go BSC.empty
  where go acc = do
          pkt <- T.recvData ctx 
          print $ BSC.length pkt 
          if BSC.length pkt == 16384
            then go $ acc <> pkt 
              else return $ acc <> pkt

这个功能有一些真正的缺点！最值得注意的是，如果您实际上有一个正好是 16k（或其任何倍数）的数据包，这将永远旋转！