Gmail TLS hackshake haskell失败

Question

我正在尝试写一个脚本通过gmail发送邮件。
我可以连接到Gmail，但是当我尝试去遮盖它时会失败。
任何指针握手握手？

下面是代码：

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 "Failed reading: invalid header type: 50\nFrom:\theader\n\n")

Answer 1

此错误是部分与处理SMTP协议的事情。通过TLS RFC 2487查看Secure SMTP的RFC，有一个示例客户端 - 服务器对话。

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消息。

事实上，如果我打开另一个终端和侦听端口587，使用的netcat，改变程序连接到本地主机，我得到了同样的错误，如果我有“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添加一些密码否则我得到了一个非法参数错误。我找到了这个代码，并在Github page上添加了来自文森特测试的日志记录。

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