haskell中的Gmail TLS握手失败

时间:2012-11-17 12:56:26

标签: haskell gmail ssl handshake

我正在尝试编写一个小脚本来通过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 "%s\r\n" s
    printf    "> %s\n" 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 \ nFrom:\ theader \ n \ n“)

1 个答案:

答案 0 :(得分:7)

此错误部分与处理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 "%s\r\n" s
    printf    "> %s\n" 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添加一些密码,否则会出现Illegal Parameter错误。我找到了这个代码,并在Github page上添加了Vincent测试的记录。

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