haskell中的Gmail TLS hanshake失败

Question

我正在尝试编写一个小脚本，通过gmail发送电子邮件
我可以连接到gmail，但当我尝试hanshake时，它失败了
有什么可以尝试握手的建议吗？

这是代码：

import Network.Socket
import Network
import Network.TLS
import Network.TLS.Extra
import Crypto.Random
import Data.CertificateStore -- to remove
import System.Certificate.X509 --to use I think
import System.IO
import Text.Printf
import Control.Monad (forever)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = emailGmail2
tListen :: Context -> IO ()
tListen ctx =
forever $ recvData ctx >>= B.putStrLn
cWrite :: Handle -> String -> IO ()
cWrite h s  = do
hPrintf h "%srn" s
printf    "> %sn" s
cListen :: Handle -> IO () 
cListen h =
forever $ hGetLine h >>= putStrLn
emailGmail2 = do
let
host = "smtp.gmail.com"
port = 587
params = defaultParamsClient
g <- newGenIO :: IO SystemRandom
h <- connectTo host (PortNumber (fromIntegral port))
hSetBuffering h LineBuffering
cWrite h "EHLO"
cWrite h "STARTTLS"
--cListen h
con <- contextNewOnHandle h params g
handshake con
tListen con

这是一个错误：

HandshakeFailed(Error_Packet_Parsing)读取失败：无效标头type:50\n From:\theader\n\n")

Answer 1

此错误部分与处理SMTP协议有关。查看RFC for Secure SMTP over TLS RFC 2487，这里有一个客户端-服务器对话的示例。

S: <waits for connection on TCP port 25>
C: <opens connection>
S: 220 mail.imc.org SMTP service ready
C: EHLO mail.ietf.org
S: 250-mail.imc.org offers a warm hug of welcome
S: 250 STARTTLS
C: STARTTLS
S: 220 Go ahead
C: <starts TLS negotiation>
C & S: <negotiate a TLS session>
C & S: <check result of negotiation>
C: <continues by sending an SMTP command>
. . .

在您的代码中，您发送EHLO和STARTTLS，然后立即开始握手协商。我相信发生的情况是，服务器仍在发送上面的250和220个代码中的一些，TLS库正试图将这些代码解释为TLS消息，这导致了问题。

事实上，如果我打开另一个终端并用netcat监听端口587并将程序更改为连接到localhost；250 STARTTLS"；

改变这一点让程序为我工作：

import Network.Socket
import Network
import Network.TLS
import Network.TLS.Extra
import Crypto.Random
import qualified Crypto.Random.AESCtr as RNG
import System.IO
import Text.Printf
import Control.Monad (when)
import Data.List (isPrefixOf)
ciphers :: [Cipher]
ciphers =
[ cipher_AES128_SHA1
, cipher_AES256_SHA1
, cipher_RC4_128_MD5
, cipher_RC4_128_SHA1
]
main :: IO ()
main = emailGmail2
cWrite :: Handle -> String -> IO ()
cWrite h s  = do
hPrintf h "%srn" s
printf    "> %sn" s
cWaitFor :: Handle -> String -> IO ()
cWaitFor h str = do
ln <- hGetLine h
putStrLn ln
when (not $ str `isPrefixOf` ln) (cWaitFor h str)
emailGmail2 = do
let
host = "smtp.gmail.com"
port = 587
params = defaultParamsClient{pCiphers = ciphers}
g <- RNG.makeSystem
h <- connectTo host (PortNumber (fromIntegral port))
hSetBuffering h LineBuffering
cWrite h "EHLO"
cWaitFor h "250-STARTTLS"
cWrite h "STARTTLS"
cWaitFor h "220"
con <- contextNewOnHandle h params g
handshake con
bye con

还要注意，我需要从Network.TLS.Extras添加一些密码，否则我会出现非法参数错误。我找到了这方面的代码，并在Github页面上添加了Vincent测试的日志记录。

另一个注意事项：如果遇到更多问题，我应该指出，我使用了命令行程序gnutls-cli和ssldump来调试上面提到的密码问题。