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來調試上面提到的密碼問題。