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

时间：2015-01-09 00:32:36

标签： sockets haskell ssl encryption tcp

我为项目构建了一个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电话。现在我无法从客户端连接。如果我干净利落，我会再次更新。

EDIT2：顺便说一句，新错误是：

HandshakeFailed (Error_Packet_Parsing "Failed reading: invalid header type: 34\nFrom:\theader\n\n")

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

1 个答案:

答案 0 :(得分：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
    ]

Python客户端：

# 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, world\r\n')

    data = recv_all(ss)

    s.close()
    print("Received %s" % data)


if __name__ == "__main__":
    main()

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

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（或任何倍数）的数据包，这将永远旋转！

相关问题
最新问题