diff --git a/HackMail.cabal b/HackMail.cabal --- a/HackMail.cabal +++ b/HackMail.cabal @@ -1,5 +1,5 @@ Name: HackMail -Version: 0.0 +Version: 0.0.1 Synopsis: A Procmail Replacement as Haskell EDSL Description: A program for filtering/sorting email. Monadic EDSL for sorting, supports multiple mail storage formats. Homepage: http://patch-tag.com/publicrepos/Hackmail @@ -14,12 +14,12 @@ Library Build-Depends: base, - directory >= 1.0, - Crypto >= 4.2, - parsec >= 2.1, - mtl >= 1.1, - old-time >= 1.0, - hint >= 0.3 + directory >=1.0, + Crypto >=4.2, + parsec >=2.1, + mtl >=1.1, + old-time >=1.0, + hint >=0.3 Exposed-Modules: HackMail.Data.MainTypes, HackMail.Data.Email, HackMail.Data.ParseEmail, @@ -28,16 +28,18 @@ HackMail.Data.FilterConf HackMail.Control.Misc HackMail.Control.Checksum + HackMail.Control.DaemonMode + HackMail.Hackmain Executable hackmail Main-is: Main.hs Build-Depends: base, - directory >= 1.0, - Crypto >= 4.2, - parsec >= 2.1, - mtl >= 1.1, - old-time >= 1.0, - hdaemonize >= 0.1, - hint >= 0.3 + directory >=1.0, + Crypto >=4.2, + parsec >=2.1, + mtl >=1.1, + old-time >=1.0, + hdaemonize >=0.1, + hint >=0.3 diff --git a/HackMail/Control/DaemonMode.hs b/HackMail/Control/DaemonMode.hs new file mode 100644 --- /dev/null +++ b/HackMail/Control/DaemonMode.hs @@ -0,0 +1,52 @@ +module HackMail.Control.DaemonMode where + +import Control.Applicative +import Control.Concurrent +import Control.Monad + +import Data.IORef +import Data.List hiding (sort) +import Data.Maybe (fromJust) + +import System.Directory +import System.Time + +import HackMail.Data.MainTypes + + +-- Plan +-- start up polling directory from opts/config, if theres a modification, call the sorting (FilterMain) +-- routine on each new file. deleting them afterward, go back to polling. +runDaemon opts conf = do + -- an IORef to store the last modification time + modFlag <- getModificationTime (fromJust $ incomingMailLoc opts) >>= newIORef + poll_and_sort modFlag opts conf + + +poll_and_sort flag opts conf = do + b <- poll flag (fromJust $ incomingMailLoc opts) + if b then (do {threadDelay (30 * 10^6); poll_and_sort flag opts conf}) -- poll every thirty seconds (TODO: Make configurable) + else sort opts conf + -- update modification time + current_modTime <- getModificationTime (fromJust $ incomingMailLoc opts) + prevTime <- readIORef flag + writeIORef flag current_modTime + -- loop + poll_and_sort flag opts conf + +poll flag path = do + modTime <- getModificationTime path + flagTime <- readIORef flag + return (flagTime == modTime) + +sort opts conf = do + dirContents <- filter (isSuffixOf ".eml") <$> getDirectoryContents (fromJust $ incomingMailLoc opts) + -- this is ugly and bad... + dirContents' <- mapM parseEmailFromFile dirContents + let dirC = map unpack dirContents' + mapM fMain dirC + mapM_ removeFile dirContents + where fMain x = (runFilter (filterMain conf) (conf, x)) + +unpack (Left err) = error $ "Couldn't Sort, parse error\n" ++ (show err) +unpack (Right em) = em diff --git a/HackMail/Hackmain.hs b/HackMail/Hackmain.hs new file mode 100644 --- /dev/null +++ b/HackMail/Hackmain.hs @@ -0,0 +1,123 @@ +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- +-- | +--Module : Hackmain.hs +--Author : Joe Fredette +--License : BSD3 +--Copyright : Joe Fredette +-- +--Maintainer : Joe Fredette +--Stability : Unstable +--Portability : not portable +-- +-------------------------------------------------------------------------------- +--Description : The main module, manages configs and etc. +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + -- This (Undecideable) is smelly, I do not like it, there must be + -- a better soltuion +{-# LANGUAGE UndecidableInstances, ScopedTypeVariables, FlexibleContexts #-} +module HackMail.Hackmain where + +import System.Environment +import System.Directory +import System.Exit +import System.IO + +import Control.Arrow +import Control.Monad +import Control.Monad.Reader +import Control.Applicative + +import Data.Typeable +import Data.Maybe +import Data.List + +import Language.Haskell.Interpreter + +import System.Posix.Daemonize + +import HackMail.Data.MainTypes +import HackMail.Control.DaemonMode +import HackMail.Control.Misc + +configFolderPathIO :: IO FilePath +configFolderPathIO = do + home <- (getEnv "HOME") + return $ home ++ "/.hackmail/" + +debugBool = True +debug s = if debugBool then putStrLn s else return () + + +main = do + -- get arguments, parse them + opts <- getOpts <$> getArgs + -- determine if config folder & FilterMain.hs/lhs exist; build config + configFolderPath <- configFolderPathIO + b_dir <- doesDirectoryExist configFolderPath + conf' <- (if' b_dir buildConf noConfFolderError) + -- delegate... + -- if in pipe mode, get the email, else start the daemon + if (daemonMode opts) then daemon_mode opts conf' + else pipe_mode opts conf' + +daemon_mode, pipe_mode :: Options -> Config -> IO () +daemon_mode opts conf = daemonize $ runDaemon opts conf -- TODO + -- eventually make this "serviced" + -- w/ error logging +pipe_mode opts conf = do + error "Pipe mode not implemented yet." + content <- getContents + content <- if (".eml" `isSuffixOf` content) then readFile content else return content + let email = unpack . parseEmail $ content + runFilter (filterMain conf) (conf, email) + where unpack (Left err) = error $ "Parse Error:\n " ++ show err + unpack (Right em) = em + + +buildConf :: IO Config +buildConf = do + configFolderPath <- configFolderPathIO + -- determine extension type and ensure existence of FilterMain.*hs + b_isHS <- doesFileExist $ (filterMainPath configFolderPath) ++ ".hs" + b_isLHS <- doesFileExist $ (filterMainPath configFolderPath) ++ ".lhs" + let filterMainL = (filterMainPath configFolderPath) ++ (getExt b_isHS b_isLHS $ (".hs",".lhs")) + -- open and extract all necessary functions/data from FilterMain, all this takes place in + -- the interpreter monad. + (inboxL, fMain) <- runUnsafeInterpreter . getFilterMainStuff $ filterMainL + return (Conf inboxL filterMainL fMain) + where filterMainPath c = (c ++ "FilterMain") + + +-- Returns a pair, a path to the inbox location (where new emails enter the system) and also +-- a Filter, the filter delivers (it's a Reader + IO monad) the email based on the config+options. +getFilterMainStuff :: FilePath -> Interpreter (Path, Filter ()) +getFilterMainStuff fMainLoc = do + loadModules [fMainLoc]; setTopLevelModules ["FilterMain"] + inboxL <- parse <$> interpret "(inbox)" infer + fMain <- (interpret "(mainFilter)" infer) + return (inboxL, fMain) + +getExt :: Bool -> Bool -> ((a,a) -> a) +getExt True True = error $ "Both FilterMain.hs and FilterMain.lhs exist, don't know which one to" + ++ "use, exiting." +getExt False False = error $ "FilterMain.hs and FilterMain.lhs do not exist, exiting." +getExt True False = fst +getExt False True = snd + +noConfFolderError = do + putStrLn "~/.hackmail/ does not exist, creating and exiting." + configFolderPathIO >>= createDirectory + exitFailure + +runUnsafeInterpreter :: Interpreter a -> IO a +runUnsafeInterpreter s = do + res <- runInterpreter s + case res of + Left r -> error (show r) + Right r -> return r + + + +