imapget (empty) → 0.0.1
raw patch · 5 files changed
+284/−0 lines, 5 filesdep +HaskellNetdep +HsOpenSSLdep +basesetup-changed
Dependencies added: HaskellNet, HsOpenSSL, base, bytestring, directory, network, text
Files
- COPYING +29/−0
- SSLWrap.hs +74/−0
- Setup.hs +3/−0
- imapget.cabal +52/−0
- imapget.hs +126/−0
+ COPYING view
@@ -0,0 +1,29 @@+Copyright (c) 2011, MarketPsych Advisor LLC+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 name of the HAppS.org; nor the names of its 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.
+ SSLWrap.hs view
@@ -0,0 +1,74 @@+module SSLWrap(mapSSL,myForkIO) where++import qualified OpenSSL.Session as SSL ( context, contextSetVerificationMode, contextSetDefaultCiphers+ , VerificationMode(VerifyPeer), contextSetCAFile, connection, shutdown+ , ShutdownType(Bidirectional), connect, write, read+ )+import OpenSSL ( withOpenSSL )+import Network as N ( listenOn, PortID(PortNumber), accept, PortNumber )+import Network.Socket as S ( withSocketsDo, sClose, socket, Family(AF_INET), SocketType(Stream)+ , connect, SockAddr(SockAddrInet) )+import Network.BSD ( getHostByName, defaultProtocol, hostAddress )+import qualified Data.ByteString as B ( hGetSome, hPut, null )+import Control.Exception ( bracket, finally, bracketOnError )+import Control.Concurrent ( killThread, takeMVar, MVar, ThreadId, newEmptyMVar, forkIOUnmasked+ , putMVar+ )+import Control.Monad ( liftM2 )+import qualified System.IO as I ( hClose, hSetBuffering, BufferMode(NoBuffering) )+++mapSSL :: FilePath -> PortNumber -> String -> PortNumber -> IO ()+mapSSL cafile in_port out_host out_port = withSocketsDo$ withOpenSSL$ do+ bracket+ (N.listenOn (PortNumber in_port))+ sClose+ $ \sockin -> do+ (h,_,_) <- N.accept sockin+ I.hSetBuffering h I.NoBuffering+ bracketOnError+ (socket AF_INET Stream defaultProtocol)+ sClose+ $ \sout -> do+ he <- getHostByName out_host+ S.connect sout (SockAddrInet (fromIntegral out_port) (hostAddress he))++ ctx <- SSL.context+ SSL.contextSetDefaultCiphers ctx+ SSL.contextSetVerificationMode ctx (SSL.VerifyPeer True False Nothing)+ SSL.contextSetCAFile ctx cafile+ bracket+ (SSL.connection ctx sout)+ (flip SSL.shutdown SSL.Bidirectional)+ $ \ssl -> do+ SSL.connect ssl+ + bracket+ (liftM2 (,) (myForkIO (readWriteLoop h ssl)) (myForkIO (readWriteLoop0 h ssl)))+ (\((_,t0),(_,t1)) -> killThread t0 >> killThread t1)+ $ \((m0,_),(m1,_)) -> do++ takeMVar m0+ takeMVar m1+ + where+ readWriteLoop h ssl = do+ b <- B.hGetSome h 1024 + SSL.write ssl b+ if B.null b then SSL.shutdown ssl SSL.Bidirectional+ else readWriteLoop h ssl+ readWriteLoop0 h ssl = do+ b <- SSL.read ssl 1024 + B.hPut h b+ if B.null b then I.hClose h+ else readWriteLoop0 h ssl++myForkIO :: IO () -> IO (MVar (),ThreadId)+myForkIO io = do+ m <- newEmptyMVar+ t <- forkIOUnmasked (io `finally` putMVar m ())+ return (m,t)++++
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ imapget.cabal view
@@ -0,0 +1,52 @@+Name: imapget+Version: 0.0.1+Synopsis: Downloads email from imap SSL servers.+Description: This programs shows how to use HaskellNet to download email from imap SSL servers.+ The IMAP implementation is provided by HaskellNet, and the SSL implementation is+ provided by HsOpenSSL. The program uses HsOpenSSL to forward a tcp connection on+ a local port to a remote imap server and wraps the connection over SSL. HaskellNet+ simply connects to the local port.+ .+ Currently imapget is able to list imap folders and print downloaded messages+ in the standard output.+ .+ When run the first time, it will create a configuration file which you can edit+ to specify username, password, imap server and ports.+ .+ > hostname=imap.gmail.com+ > port=993+ > username=<your imap username>+ > passwd=<your imap password>+ > ssl_wrap_port=3004+ .+ ssl_wrap_port is the local port used to wrap IMAP traffic over SSL. +++License: BSD3+License-file: COPYING+Author: Facundo Domínguez, MarketPsych Advisor LLC +Maintainer: Facundo Domínguez <facundo.dominguez@gmail.com>+Category: Network+Build-Type: Simple+Cabal-Version: >= 1.8++source-repository head+ type: darcs+ location: http://patch-tag.com/r/facundo/imapget++Executable imapget+ main-is: imapget.hs+ other-modules: + SSLWrap++ build-depends: base < 5+ , bytestring+ , directory+ , HaskellNet<0.4+ , HsOpenSSL+ , network+ , text++ + ghc-options: -threaded -Wall+
+ imapget.hs view
@@ -0,0 +1,126 @@++import Control.Arrow ( second )+import Control.Concurrent ( forkIO, threadDelay )+import Control.Exception ( mask_ )+import Control.Monad ( when )+import qualified Data.ByteString as B ( ByteString, putStrLn )+import Data.Char ( isDigit )+import Network.HaskellNet.IMAP.Connection as I ( IMAPConnection )+import Network.HaskellNet.IMAP as I ( list, select, search, SearchQuery(..), fetch+ , connectIMAPPort, login + )+import Network.Socket as S ( HostName, PortNumber )+import System.Directory ( canonicalizePath )+import System.Environment ( getArgs )+import System.Exit ( exitFailure )+import System.IO ( Handle )+import System.IO.Error ( isDoesNotExistError )++import SSLWrap ( mapSSL )+++main :: IO ()+main = do+ let config_file = "config.txt"+ parseConfig = map (second (drop 1) . break (=='=')) . lines+ defaultConfig = unlines + [ "hostname=imap.gmail.com"+ , "port=993"+ , "username=facundominguez@gmail.com"+ , "passwd=haskellisnice"+ , "ssl_wrap_port=3004"+ ]+ opts <- catch (fmap parseConfig$ readFile config_file)$ \e -> do+ when (isDoesNotExistError e)$ do+ writeFile config_file defaultConfig+ putStrLn$ unlines + [ ""+ , "Thanks for using imapget!"+ , ""+ , "You need to edit a configuration file to specify where to connect"+ , "and which username and password to use."+ , ""+ , "I just created a default ./"++config_file++" file."+ , "Please edit it to set your options."+ ]+ exitFailure++ let readConfig name action = maybe (putStrLn$ "error: missing "++name++" option from "++config_file) action$ lookup name opts++ readConfig "hostname"$ \hostname ->+ readConfig "port"$ \port ->+ readConfig "username"$ \username ->+ readConfig "passwd"$ \passwd ->+ readConfig "ssl_wrap_port"$ \ssl_wrap_port -> do++ args <- getArgs++ case args of+ ["list"] | all isDigit port ->+ main' IMAPConf + { icHostname = hostname+ , icPort = fromIntegral (read port :: Int)+ , icUsername = username + , icPasswd = passwd + , icSSLWrapPort = fromIntegral (read ssl_wrap_port :: Int)+ } + Nothing+ ["fetch",label] | all isDigit port ->+ main' IMAPConf + { icHostname =hostname+ , icPort = fromIntegral (read port :: Int)+ , icUsername = username + , icPasswd = passwd + , icSSLWrapPort = fromIntegral (read ssl_wrap_port :: Int)+ }+ (Just label)+ _ -> putStrLn "USAGE: imapget [list|fetch label]"+++type UserName = String+type Password = String+type Label = String++data IMAPConf = IMAPConf + { icHostname :: S.HostName+ , icPort :: S.PortNumber+ , icUsername :: UserName+ , icPasswd :: Password+ , icSSLWrapPort :: S.PortNumber+ }++main' :: IMAPConf -> Maybe Label -> IO ()+main' conf mlabel = do + case mlabel of+ Nothing -> do+ withIMAP conf$ \ic -> do+ putStrLn$ "Fetching mailbox ..."+ I.list ic >>= mapM_ (putStrLn . snd)+ Just label -> getEmails conf label B.putStrLn +++getEmails :: IMAPConf -> Label -> (B.ByteString -> IO a) -> IO ()+getEmails c label f = withIMAP c$ \ic -> do+ putStrLn$ "Selecting "++label++" ..."+ I.select ic label+ putStrLn$ "Retrieving "++label++" ..."+ I.search ic [ALLs]+ >>= mapM_ (\uid -> I.fetch ic uid >>= f)+ +++withIMAP :: IMAPConf -> (I.IMAPConnection Handle -> IO a) -> IO a+withIMAP c action = do+ -- launch thread for wrapping tcp with SSL+ cafile <- canonicalizePath "cacert.pem"+ _ <- mask_$ forkIO$ mapSSL cafile (icSSLWrapPort c) (icHostname c) (icPort c)+ + -- start imap communication+ threadDelay$ 500*1000+ putStrLn$ "Connecting to "++icHostname c++":"++show (icPort c)++" (wrapping with ssl through localhost:"++show (icSSLWrapPort c)++") ..."+ ic <- connectIMAPPort "localhost" (icSSLWrapPort c)+ putStrLn$ "Authenticating user "++icUsername c++" ..."+ I.login ic (icUsername c) (icPasswd c)+ action ic++