Gmail TLS hanshake failure in haskell - haskell

Question

I am trying to write a little script to send an email via gmail.
I can connect to gmail but when I try to hanshake it fails.
Any pointers to get the handshake a go?
Here is the code:
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
And here's the error:
HandshakeFailed (Error_Packet_Parsing "Failed reading: invalid header
type: 50\nFrom:\theader\n\n")

Answer 1

This error is partially to do with handling the SMTP protocol. Looking at the RFC for Secure SMTP over TLS RFC 2487 there is an example client-server dialogue.
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>
. . .
In your code you are sending EHLO and STARTTLS, and then immediately beginning the handshake negotiation. I believe what is happening is that the server is still sending some of the 250 and 220 codes above and the TLS library is trying to interpret these as TLS messages which is causing the problem.
Indeed if I open another terminal and listen to port 587 with netcat and change the program to connect to localhost I get the same error if I reply with "250 STARTTLS"
Changing this got the program to work for me:
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
Also note that I needed to add some ciphers from Network.TLS.Extras as otherwise I got an Illegal Parameter error. I found the code for this and to add logging from Vincent's tests on the Github page.
Another note: In case you run into more issues I should point out that I used the command line programs gnutls-cli and ssldump to debug the issue with ciphers mentioned above.