smtps-gmail (empty) → 1.0.0

raw patch · 4 files changed

+213/−0 lines, 4 filesdep +basedep +base64-stringdep +bytestring

Dependencies added: base, base64-string, bytestring, cprng-aes, network, tls, tls-extra, utf8-string

Files

LICENSE +25/−0
Network/SMTPS/Gmail.hs +102/−0
smtps-gmail.cabal +39/−0
src/Main.hs +47/−0

+ LICENSE view

@@ -0,0 +1,25 @@+Copyright (c) 2013, Enzo Haussecker. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+- Neither the names of the copyright owners nor the names of the
+  contributors may be used to endorse or promote products derived
+  from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Network/SMTPS/Gmail.hs view

@@ -0,0 +1,102 @@+---------------------------------------------------------------+-- Copyright (c) 2013, Enzo Haussecker. All rights reserved. --+---------------------------------------------------------------++{-# LANGUAGE OverloadedStrings       #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# OPTIONS -Wall                    #-}+{-# OPTIONS -fno-warn-name-shadowing #-}++module Network.SMTPS.Gmail (sendGmail) where++import Codec.Binary.Base64.String (encode)+import Control.Exception+import Control.Monad+import Crypto.Random.AESCtr (makeSystem)+import Data.ByteString.Char8 as Strict+import Data.ByteString.Lazy.Char8 as Lazy+import Data.ByteString.Lazy.UTF8 (fromString)+import Data.List as List+import Data.Monoid ((<>))+import Network+import Network.TLS+import Network.TLS.Extra+import System.IO as IO+import Text.Printf++-- | Send an email from your Gmail account using the simple +--   message transfer protocol with transport layer security.+sendGmail+  :: Handle   -- ^ log+  -> String   -- ^ username+  -> String   -- ^ password+  -> [String] -- ^ to+  -> [String] -- ^ cc+  -> [String] -- ^ bcc+  -> String   -- ^ subject+  -> String   -- ^ body+  -> IO ()+sendGmail log user pass to cc bcc sub body = ( do+  let params = defaultParamsClient { pCiphers  = ciphers }+      recips = nub $ bcc <> cc <> to+      from   = user <> "@gmail.com"+  gen <- makeSystem+  hdl <- connectTo "smtp.gmail.com" $ PortNumber 587+  ctx <- contextNewOnHandle hdl params gen+  hSetBuffering hdl LineBuffering+  let f str = send hdl log str >> recv hdl log+  mapM_ f ["EHLO","STARTTLS"]+  handshake ctx+  let g lbs = sendTLS ctx log lbs >> recvTLS ctx log+  mapM_ g [+    "EHLO",+    "AUTH LOGIN",+    fromString $ encode user,+    fromString $ encode pass,+    fromString $ "MAIL FROM:<" <>                        from   <> ">",+    fromString $ "RCPT TO:<"   <> List.intercalate ">,<" recips <> ">",+    "DATA",+    fromString $ "To:<"        <> List.intercalate ">,<" to     <> ">"+          <> "\r\nCC:<"        <> List.intercalate ">,<" cc     <> ">"+          <> "\r\nBCC:<"       <> List.intercalate ">,<" bcc    <> ">"+          <> "\r\nFrom:<"      <>                        from   <> ">"+          <> "\r\nSubject:"    <>                        sub+          <> "\r\n"            <>                        body+          <> "\r\n.",+    "QUIT"]+  bye ctx+  contextClose ctx+  hClose hdl )+   `catch` \ (err :: SomeException) ->+    IO.hPutStrLn log $ show err++send :: Handle -> Handle -> String -> IO ()+send socket log message = do+  void $ hPrintf socket "%s\r\n" message+  IO.hPutStrLn log $ "> " <> message++recv :: Handle -> Handle -> IO ()+recv socket log = do+  imput <- hWaitForInput socket 300+  when imput $ do+    line <- IO.hGetLine socket+    IO.hPutStrLn log line+    recv socket log++sendTLS :: Context -> Handle -> Lazy.ByteString -> IO ()+sendTLS ctx log message = do+  sendData ctx $ message <> "\r\n"+  Lazy.hPutStrLn log $ "> " <> message++recvTLS :: Context -> Handle -> IO ()+recvTLS ctx log = do+  messages <- recvData ctx+  mapM_ (Strict.hPutStrLn log) $ Strict.lines messages++ciphers :: [Cipher]+ciphers =+  [ cipher_AES128_SHA1+  , cipher_AES256_SHA1+  , cipher_RC4_128_MD5+  , cipher_RC4_128_SHA1+  ]

+ smtps-gmail.cabal view

@@ -0,0 +1,39 @@+Name:               smtps-gmail+Version:            1.0.0+License:            BSD3+License-File:       LICENSE+Copyright:          Copyright (c) 2013, Enzo Haussecker. All rights reserved.+Author:             Enzo Haussecker <enzo@ucsd.edu>+Maintainer:         Enzo Haussecker <enzo@ucsd.edu>+Stability:          Stable+Category:           Network+Synopsis:           Gmail API+Homepage:           https://github.com/enzoh/smtps-gmail+Bug-Reports:        https://github.com/enzoh/smtps-gmail/issues+Build-Type:         Simple+Cabal-Version:      >= 1.16.0+Description:        Send email from your Gmail account using the simple message transfer protocol with transport layer security.++Library+  Default-Language: Haskell2010+  Exposed-Modules:  Network.SMTPS.Gmail+  Build-Depends:    base >= 4 && < 5,+                    base64-string,+                    bytestring,+                    cprng-aes,+                    network,+                    tls,+                    tls-extra,+                    utf8-string++Executable gmail+  Default-Language: Haskell2010+  Main-Is:          src/Main.hs+  Build-Depends:    base >= 4 && < 5,+                    base64-string,+                    bytestring,+                    cprng-aes,+                    network,+                    tls,+                    tls-extra,+                    utf8-string

+ src/Main.hs view

@@ -0,0 +1,47 @@+---------------------------------------------------------------+-- Copyright (c) 2013, Enzo Haussecker. All rights reserved. --+---------------------------------------------------------------++{-# OPTIONS -Wall #-}++module Main where++import Control.Exception+import Network.SMTPS.Gmail+import System.IO++main :: IO ()+main = do+  putStr "Username: "+  hFlush stdout+  user <- withEcho True  getLine+  putStr "Password: "+  hFlush stdout+  pass <- withEcho False getLine+  putChar '\n'+  putStr "To: "+  hFlush stdout+  to   <- withEcho True  getLine >>= return . split+  putStr "CC: "+  hFlush stdout+  cc   <- withEcho True  getLine >>= return . split+  putStr "BCC: "+  hFlush stdout+  bcc  <- withEcho True  getLine >>= return . split+  putStr "Subject: "+  hFlush stdout  +  sub  <- withEcho True  getLine+  putStr "Body: "+  hFlush stdout  +  body <- withEcho True  getLine+  sendGmail stdout user pass to cc bcc sub body++withEcho :: Bool -> IO a -> IO a+withEcho echo action = do+  old <- hGetEcho stdin+  bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action++split :: String -> [String]+split "" = []+split xs = a : split (drop 1 b)+  where (,) a b = break (==',') xs