Sử dụng tls-extra cho smtp đơn giản

Question

Tôi đang cố viết một kịch bản đơn giản để gửi thư qua tài khoản gmail của tôi. Nhưng tôi là người mới bắt đầu nên nó không đơn giản như vậy. Tôi cố gắng google nhưng exept cho hackage, không có sự giúp đỡ hoặc ví dụ ở tất cả.

Vấn đề là tôi không tìm cách sử dụng tls-extra (hoặc tls) để bắt đầu trao đổi STARTTLS.

Ok, đây là mã:

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 

Một điều nữa là tôi sử dụng nghe chức năng để biết những gì đang xảy ra. Nhưng tôi không thể tìm ra cách sử dụng nó cùng với việc viết. Đó là để nói, tôi muốn để có thể xem những gì đang xảy ra phía máy chủ trong khi gửi một số dữ liệu.

tôi thấy hai chức năng mà có thể giải quyết vấn đề của tôi:

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

Đầu tiên cho tls và lần thứ hai để gửi và nhận cùng một lúc. Nhưng dường như không thể làm cho chúng hoạt động.

Tôi hy vọng tôi không được lộn xộn ở đây, mọi trợ giúp sẽ được đánh giá cao.

PS: tiếng Anh không phải là ngôn ngữ gốc của tôi.

EDIT: Vì vậy, tôi đã thực hiện một số tiến bộ.

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 

Tuy nhiên, tôi không thể tìm ra cách thương lượng bắt tay tls đó.

Tôi phải nói, tôi khá ngạc nhiên vì thiếu câu trả lời. Những người khác vài lần tôi đã có một vấn đề, cộng đồng đã được khá nhanh chóng để giúp đỡ. Nhưng điều này dường như không xen kẽ (chỉ là một constatation). Ở đây tại SO hoặc thậm chí tại #haskell hoặc developpez.com.

Anyways một số gợi ý về google và tls sẽ được chào đón. Tôi đã xem xét mã máy khách msmtp nhưng thẳng thắn tôi không có cấp độ yêu cầu.

Answer 1

Bạn có thể sử dụng gói kết nối giúp đơn giản hóa kết nối máy khách và cung cấp tất cả các bit cần thiết cho việc này. Mã sau sẽ hoạt động để kết nối với 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 

Answer 2

Tôi không biết chính xác nguyên nhân gây ra sự cố bạn gặp phải (SMTP của tôi hơi bị gỉ), nhưng tôi tin rằng một phần của sự cố là bạn đang kết nối sai cổng. Tôi nghĩ đây là những thông số chính xác để sử dụng SMTP với 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: Tôi đã làm một tìm kiếm nhanh của Hackage để xem nếu có một gói SMTP mà sẽ cho phép bạn đăng nhập bằng tên người dùng và mật khẩu, sử dụng TLS/SSL, nhưng tôi không thấy bất cứ điều gì. (Tôi có thể đã bỏ qua một cái gì đó, mặc dù!) Gần nhất tôi thấy là simplesmtpclient. Tôi không nghĩ rằng nó hỗ trợ SSL, nhưng có lẽ bạn có thể mở rộng nó, hoặc sử dụng nó như một hướng dẫn để viết của riêng bạn.