Using tls-extra for simple smtp

问题

I am trying to write a simple script to send a mail via my gmail account. But I am a beginner so it is not that simple. I tryed google but exept for hackage, there is no help or examples at all.

The problem is that I did not find the way to use tls-extra(or tls) to initiate the STARTTLS exchange.

Ok, here is the code:

import Network
import Network.TLS.Extra
import System.IO
import Text.Printf

server = "smtp.gmail.com"
port   = 25 --that has to chage, I think

forever a = a >> forever a

main = test1

write :: Handle -> String -> IO ()
write h s  = do
    hPrintf h "%s\r\n" s
    printf    "> %s\n" s

listen :: Handle -> IO () 
listen h = forever $ hGetLine h >>= putStrLn

test1 = do h <- connectTo server (PortNumber (fromIntegral port))
           hSetBuffering h NoBuffering
           write h "EHLO"
           write h "STARTTLS"
           listen h

Another thing is that I use the listen function to know what is going on. But I cannot figure out how to use it along with write. That is to say, I would like to be able to see what is going on server-side while sending some data.

I found two functions that may resolve my problems:

connectionClient :: CryptoRandomGen g => String -> String -> TLSParams -> g -> IO (TLSCtx Handle)
forkIO :: IO () -> IO ThreadId

The first for tls and the second to send and receive at the same time. But can't seem to make them work.

I hope I am not to messy here, any help would be appreciated.

PS: English is not my native.

EDIT: So, I have made some progress.

import Network
import Network.TLS
import Network.TLS.Extra
import System.IO
import Text.Printf
import Control.Monad (forever)
import Control.Concurrent (threadDelay)
import qualified Data.ByteString.Char8 as B
import Crypto.Random

serv :: String
serv = "smtp.gmail.com"
port :: Int
port   = 25 --that has to chage, I think

main :: IO ()
main = test1

write :: Handle -> String -> IO ()
write h s  = do
    hPrintf h "%s\r\n" s
    printf    "> %s\n" s

listen :: Handle -> IO ()
listen h = forever $ hGetLine h >>= putStrLn

printSock :: Handle -> String -> IO ()
printSock h s = do write h s
                   hGetLine h >>= putStrLn
                   threadDelay 25

params :: TLSParams
params=defaultParams {pConnectVersion=TLS12
                     ,pAllowedVersions=[TLS10, TLS11, TLS12]
                     ,pCiphers=ciphersuite_all}

test1 = do h <- connectTo serv (PortNumber (fromIntegral port))
           hSetBuffering h NoBuffering
           printSock h "EHLO"
           printSock h "STARTTLS"
           --google waits for tls handshake
           --the problem is from here
           g <- newGenIO :: IO SystemRandom
           tlsH <- client params g h
           handshake tlsH --the handshake is failling

Still, I cannot figure out how to negotiate that tls handshake.

I have to say, I am quite surprised by the lack of answer. The others few times I had a problem, the community was quite quick to help. But this doesn't seem to interess (just a constatation). Here at SO or even at #haskell or developpez.com.

Anyways some pointers about google and tls would be welcome. I have taken a look at the msmtp client code but frankly I don't have the required level.

回答1:

You could use the connection package which simplify client connection and provide all the necessary bits for this. The following code will works to connect to smtp.gmail.com:

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString as B
import Data.ByteString.Char8 ()
import Network.Connection
import Data.Default

readHeader con = do
    l <- connectionGetLine 1024 con
    putStrLn $ show l
    if B.isPrefixOf "250 " l
        then return ()
        else readHeader con

main = do
    ctx <- initConnectionContext
    con <- connectTo ctx $ ConnectionParams
                            { connectionHostname  = "smtp.gmail.com"
                            , connectionPort      = 25
                            , connectionUseSecure = Nothing
                            , connectionUseSocks  = Nothing
                            }

    -- read the server banner
    connectionGetLine 1024 con >>= putStrLn . show
    -- say ehlo to the smtp server
    connectionPut con "EHLO\n"
    -- wait for a reply and print
    readHeader con
    -- Tell the server to start a TLS context.
    connectionPut con "STARTTLS\n"
    -- wait for a reply and print
    connectionGetLine 1024 con >>= putStrLn . show

    -- negociate the TLS context
    connectionSetSecure ctx con def

    ------- connection is secure now
    -- send credential, passwords, ask question, etc.

    -- then quit politely.
    connectionPut con "QUIT\n"
    connectionClose con

回答2:

I don't know exactly what's causing the problem you're having (My SMTP is a little rusty), but I believe part of the problem is that you're connecting on the wrong port. I think these are the correct parameters for using SMTP with Google.

Gmail SMTP server address: smtp.gmail.com
Gmail SMTP user name: Your full Gmail address (e.g. example@gmail.com)
Gmail SMTP password: Your Gmail password
Gmail SMTP port: 465
Gmail SMTP TLS/SSL required: yes

Edit: I did a quick search of Hackage to see if there was an SMTP package that would allow you to login with a username and password, using TLS/SSL, but I didn't see anything. (I could have overlooked something, though!) The closest I found was simplesmtpclient. I don't think it supports SSL, but perhaps you could extend that, or use it as a guide for writing your own.

来源：https://stackoverflow.com/questions/11311036/using-tls-extra-for-simple-smtp

标签

haskell

smtp

starttls