【发布时间】：2015-01-09 00:32:35
【问题描述】：
我已经为一个项目构建了一个 TCP 服务器，它工作正常，但是是时候添加 TLS 了。我试过Network.Simple.TCP.TLS，但是当我把它集成到我更大的项目中时，我遇到了一些我无法解决的依赖冲突。
这里的代码是简化的测试服务器，我稍后将集成到更大的项目中。我希望这不会隐藏任何重要的细节。
这是一个没有 TLS 的工作 echo 服务器：
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")
我在网络上的几个地方发现了这个错误，但我还没有看到附加的答案。
【问题讨论】：
-
@ThomasM.DuBuisson 谢谢，但链接给了我一个 404。回购是私有的还是移动的？
-
哦，呵呵。估计他还没发没关系！
标签： sockets haskell ssl encryption tcp