autoproc (empty) → 0.1
raw patch · 11 files changed
+1102/−0 lines, 11 filesdep +basedep +directorydep +mtlsetup-changed
Dependencies added: base, directory, mtl, process, unix
Files
- Autoproc/Classifier.hs +280/−0
- Autoproc/Configuration.hs +27/−0
- Autoproc/Procmail.hs +103/−0
- Autoproc/Rules/Dagit.hs +310/−0
- Autoproc/Run.hs +27/−0
- Autoproc/Transform.hs +134/−0
- LICENSE +28/−0
- Main.hs +93/−0
- README +63/−0
- Setup.hs +5/−0
- autoproc.cabal +32/−0
+ Autoproc/Classifier.hs view
@@ -0,0 +1,280 @@+module Autoproc.Classifier where++-- The purpose of this module is to define the abstract and concrete+-- syntax for the condition expression language.++import Control.Monad.Writer hiding (when)++-- Some functions in this module get their meaning and values from+-- Configuration module. If you want to change a default such as+-- locking, check the Configuration module.+import Autoproc.Configuration++data EmailAddress = Addr String deriving Show++data Mailbox = Mailbox String++data CExp = CExp [Flag] Cond Act deriving Show++data Flag = Copy+ | Wait+ | IgnoreErrors+ | RawWrite+ | NeedLock Bool+ | Chain+ | CaseSensitive deriving (Eq, Show)++data Cond = And Cond Cond+ | Or Cond Cond+ | Not Cond+ | Always+ | Never+ | CheckMatch String+ | CheckHeader String+ | CheckBody String deriving (Eq, Show)++data Act = File String+ | Fwd [EmailAddress]+ | Filter String+ | Nest [CExp] deriving Show++--type Rule = Cond -> Act -> m CExp+--type Rule = Cond -> Act -> CExp+--data RuleM a = RuleM a++---------------------------------------------------------------------------+-- Basic functions for manipulating conditions and creating Rules++(.&&.) :: Cond -> Cond -> Cond+c1 .&&. c2 = And c1 c2++(.||.) :: Cond -> Cond -> Cond+c1 .||. c2 = Or c1 c2++subject, body, said :: String -> Cond+subject s = CheckHeader ("^Subject.*"++s)+body s = CheckBody s+said s = subject s .||. body s++from, to, to_ :: EmailAddress -> Cond+from (Addr s) = CheckHeader ("^From.*"++s)+to (Addr s) = CheckHeader ("^TO"++s)+to_ (Addr s) = CheckHeader ("^TO_"++s)++when :: Cond -> Act -> Writer [CExp] ()+when c a = whenWithOptions [lock] c a++whenWithOptions :: [Flag] -> Cond -> Act -> Writer [CExp] ()+whenWithOptions fs c a = tell [CExp fs c a]++placeIn :: Mailbox -> Act+placeIn (Mailbox m) = File m++also :: Act -> Act -> Act+also (Nest as) (Nest bs) = Nest (flagAllButLast Copy (as++bs))+also (Nest as) b = Nest (flagAllButLast Copy+ (as++(execWriter $+ whenWithOptions [] Always b)))+also a (Nest bs) = Nest (flagAllButLast Copy+ ((execWriter+ (whenWithOptions [] Always a))++bs))+also a b = Nest (flagAllButLast Copy+ ((execWriter $ whenWithOptions [] Always a)+++ (execWriter $ whenWithOptions [] Always b)))++flagAllButLast :: Flag -> [CExp] -> [CExp]+flagAllButLast _ [] = []+flagAllButLast f cs = (map (addFlag f) (init cs))++[removeFlag f (last cs)]++addFlag :: Flag -> CExp -> CExp+addFlag f (CExp fs a c) = (CExp (f:fs) a c)++removeFlag :: Flag -> CExp -> CExp+removeFlag f (CExp fs a c) = (CExp (filter (/= f) fs) a c)++forwardTo :: [EmailAddress] -> Act+forwardTo es = Fwd es++isSpam :: Cond+isSpam = CheckHeader ("^x-spam-status: yes") .||.+ CheckHeader ("^x-spam-flag: yes")++spamLevel :: Int -> Cond+spamLevel n = CheckHeader ("^x-spam-Level: "++(concat (replicate n "\\*")))++--------------------------------------------------------------------------+-- Match monad is just the identity monad, this makes it so that the user+-- cannot use match arbitrarily. Used a monad instead of just a data+-- wrapper because now we can use the monad utilities like liftM++data Match a = Match a++instance Monad Match where+ return = Match+ (>>=) (Match a) f = (f a)++match :: Match String+match = return "$MATCH"++whenMatch :: Match Cond -> Match Act -> Writer [CExp] ()+whenMatch mc ma = whenMatchWithOptions [lock] mc ma++whenMatchWithOptions :: [Flag] -> Match Cond -> Match Act -> Writer [CExp] ()+whenMatchWithOptions fs (Match c) (Match a) = tell [CExp fs c a]++placeInUsingMatch :: Match Mailbox -> Match Act+placeInUsingMatch = liftM placeIn++(%) :: Cond -> String -> Match Cond+(CheckHeader s1) % s2 = return (CheckHeader (s1++"\\/"++s2))+(CheckBody s1) % s2 = return (CheckBody (s1++"\\/"++s2))+(CheckMatch s1) % s2 = return (CheckMatch (s1++"\\/"++s2))++refineBy :: Match Cond -> Match Cond -> Match Cond+refineBy = liftM2 (.&&.)++alsoUsingMatch :: Match Act -> Match Act -> Match Act+alsoUsingMatch = liftM2 also++---------------------------------------------------------------------------+-- A few functions to create short hand for sorting+sortBy :: (a -> Cond) -> a -> Mailbox -> Writer [CExp] ()+sortBy f s m = when (f s) (placeIn m)++sortByTo_, sortByTo, sortByFrom :: EmailAddress -> Mailbox -> Writer [CExp] ()+sortByTo_ = sortBy to_+sortByTo = sortBy to+sortByFrom = sortBy from++sortBySubject :: String -> Mailbox -> Writer [CExp] ()+sortBySubject = sortBy subject++----------------------------------------------------------------------------+-- Everything below here depends on the values in the Configuration module++-- | If the email address (the String argument) contains "foo", then place the email into a folder+-- by the name "foo". Actually, the name of the mailbox is created by+-- appending boxPrefix which is defined in the Configuration module.+simpleSortByFrom :: String -> Writer [CExp] ()+simpleSortByFrom s = sortByFrom (Addr s) (mailbox s)++simpleSortByTo_, simpleSortByTo:: String -> Writer [CExp] ()+simpleSortByTo s = sortByTo (Addr s) (mailbox s)+simpleSortByTo_ s = sortByTo_ (Addr s) (mailbox s)++mailbox :: String -> Mailbox+mailbox s = Mailbox (boxPrefix++s)++mailBoxFromMatch :: Match String -> Match Mailbox+mailBoxFromMatch = liftM mailbox++lock :: Flag+lock = NeedLock lockDefault++---------------------------------------------------------------------------+-- This is the actually "Classifier" implementation. It's not as powerful.+-- Please consider this "syntax" to be experimental.++type Class = (String, [Cond])++type Trigger = (String, Int, Act)++type Classifier = Writer [CExp] ()++mkTrigger :: Trigger -> Classifier+mkTrigger (s, i, a) = when (CheckHeader+ ("^"++(mkHeader s)++(replicate i '*')))+ a++mkClassifiers :: Class -> Writer [CExp] ()+mkClassifiers (s, cs) = more (length cs) s cs+ where+ more _ _ [] = return ()+ more n t (x:xs) = (when x $ Nest $ incrementHeader t n) >>+ (more n t xs)++incrementHeader :: String -> Int -> [CExp]+incrementHeader s n = concat+ [execWriter (whenMatch ((CheckHeader ("^"++mkHeader s)) %+ (replicate n '*'))+ updateHeader),+ execWriter (when (Not (CheckHeader ("^"++mkHeader s)))+ writeHeader)]+ where+ updateHeader = do { m <- match;+ return (Filter ("formail -I\""++mkHeader s++m++"*\"")) }+ writeHeader = Filter ("formail -I\""++mkHeader s++"*\"")++mkHeader :: String -> String+mkHeader s = "X-classifier-"++s++": "++classify :: [Class] -> [Trigger] -> Writer [CExp] ()+classify cs ts = mapM_ mkClassifiers cs >> mapM_ mkTrigger ts++classifyBy :: (String, Cond) -> Act -> Writer [CExp] ()+classifyBy (s, c) a = classify [(s,[c])] [(s, 1, a)]++classifyByAddress::(EmailAddress -> Cond) -> EmailAddress -> Mailbox -> Writer [CExp] ()+classifyByAddress f e@(Addr s) m = classify [(s, [f e])] [(s, 1, placeIn m)]++classifyByTo_, classifyByTo, classifyByFrom:: EmailAddress -> Mailbox -> Writer [CExp] ()+classifyByTo_ = classifyByAddress to_+classifyByTo = classifyByAddress to+classifyByFrom = classifyByAddress from++classifyByFromAddr :: String -> String -> Writer [CExp] ()+classifyByFromAddr x y = classifyByFrom (Addr x) (mailbox y)++classifyBySubject :: String -> Mailbox -> Writer [CExp] ()+classifyBySubject s m = classify [(s, [subject s])] [(s, 1, placeIn m)]++simpleClassifyBySubject :: String -> Writer [CExp] ()+simpleClassifyBySubject x = classifyBySubject x (mailbox x)++simpleClassifyByFrom, simpleClassifyByTo_, simpleClassifyByTo::String -> Writer [CExp] ()+simpleClassifyByFrom s = classifyByFrom (Addr s) (mailbox s)+simpleClassifyByTo s = classifyByTo (Addr s) (mailbox s)+simpleClassifyByTo_ s = classifyByTo_ (Addr s) (mailbox s)++defaultRule :: String -> Writer [CExp] ()+defaultRule str = when Always $ File str++-- | If the subject line contains a certain string, send it to a certain mailbox.+subjectToMbox :: String -> String -> Writer [CExp] ()+subjectToMbox substr mbox = sortBySubject substr $ mailbox mbox++-- | As with 'subjectToMbox', except by email address.+addressToMbox :: String -> String -> Writer [CExp] ()+addressToMbox addr mbox = sortByFrom (Addr addr) (mailbox mbox)++-- | 'addressToMbox' is fine, but may not work well for mailing lists.+toAddressToMbox :: String -> String -> Writer [CExp] ()+toAddressToMbox addr mbox = sortByTo_ (Addr addr) (mailbox mbox)++{- | 'stuffToMbox' is a very general filtering statement, which is intended for specialization+ by other functions.++ The idea is to take a logical operator and fold it over a list of strings.+ If the result is @True@, then the email gets dropped into a specified mailbox.+ So if you wanted to insist that only an email which has strings @x@, @y@, and @z@ in+ the subject-line could appear in the xyz mailbox, you'd use .&&. as the logical operator,+ "xyz" as the @mbox@ argument, [x, y, z] as the list, and a seed value of True. You also need the+ 'subject' operator, which will map over the list and turn it into properly typed+ stuff. -}+stuffToMbox :: Cond -> (a1 -> a) -> (a -> Cond -> Cond) -> String -> [a1] -> Writer [CExp] ()+stuffToMbox seed header operator mbox items = when (foldr (operator) seed $ map header items)+ (insertMbox mbox)++-- | If all the strings appear in the subject line, deposit the email in the specified mailbox+subjectsToMbox :: [String] -> String -> Writer [CExp] ()+subjectsToMbox x y = stuffToMbox Always subject (.&&.) y x++-- | If any of the strings appear in the subject line, send it to the mbox+-- This is currently a bit of a null-op, and I'm not sure it works.+anySubjectsToMbox :: [String] -> String -> Writer [CExp] ()+anySubjectsToMbox x y = stuffToMbox Never subject (.||.) y x++-- subjectsNotToMbox = stuffToMbox Never subject ((.||.) .) ""++insertMbox :: String -> Act+insertMbox = placeIn . mailbox
+ Autoproc/Configuration.hs view
@@ -0,0 +1,27 @@+module Autoproc.Configuration where++-- Anything which is specific to your system should be changed here.++boxPrefix :: String+boxPrefix = "INBOX."++lockDefault :: Bool+lockDefault = True++-- These variables are used to generate the start of .procmailrc+defaultVariables :: [(String, String)]+defaultVariables = [("SHELL", "/bin/sh"),+ ("PATH", "/usr/local/bin:/usr/bin:/bin:$PATH"),+ ("DATE", "`date +%m_%d_%Y`"),+ ("MAILDIR", "$HOME"),+ ("DEFAULT", "$HOME"),+ ("PMDIR", "$HOME/.procmail"),+ ("DUMMY", "`test -d $PMDIR || mkdir $PMDIR`"),+ ("LOGFILE", "$PMDIR/$DATE.log"),+ ("LOGABSTRACT", "on"),+ ("VERBOSE", "off")]++showVars :: [(String, String)] -> String+showVars [] = ""+showVars (v:vs) = (fst v) ++ " = " ++ (snd v) ++ "\n"+ ++ showVars vs
+ Autoproc/Procmail.hs view
@@ -0,0 +1,103 @@+module Autoproc.Procmail where+-- One thing to keep in mind:+-- Procmail seems to "just work" by running regular expressions over the+-- email and doing something.++-- The goal of this module is to capture the abstract syntax of procmail+-- and to output to the procmail syntax.++import Data.List (sort)++data PExp = PExp [RecipeFlag] [Condition] Action++data RecipeFlag = CheckHeader | CheckBody+ | CaseSensitive | Chain+ | ElseIf | PipeAsFilter | Copy+ | Wait | IgnoreErrors | RawWrite | NeedLock Bool deriving (Eq, Ord)++data Condition = Condition ConditionFlag String+data ConditionFlag = Normal | Invert | Eval | UseExitCode+ | LessThan | GreaterThan | Var String++{-++ There are two types of actions:++ 1) delivering+ 2) non-delivering++ The difference is that a delivering message stops execution of rules+ a non-delivering rule feeds a carbon-copy of the message to rule and+ then continues on trying rules.++-}++data Action = Forward [String] | Pipe String | File String+ | Nest [PExp]++--This is useful when used with the list monad+--to print each element of the list xs on a line by itself use:+-- xs >>= showLn+showLn :: (Show a) => a -> String+showLn = (++ "\n") . show++instance Show PExp where+ show (PExp fs cs a) = ":0"++showFlags fs++"\n"+ ++(cs >>= (\x -> if show x == "" then ""+ else showLn x))+ ++show a++"\n"+ where+ showFlags [NeedLock b] = show (NeedLock b)+ showFlags hs = " " ++ ((show =<<) . sort) hs++instance Show RecipeFlag where+ show CheckHeader = "H"+ show CheckBody = "B"+ show CaseSensitive = "D"+ show Chain = "A"+ show ElseIf = "E"+ show PipeAsFilter = "f"+ show Copy = "c"+ show Wait = "w"+ show IgnoreErrors = "i"+ show RawWrite = "r"+ show (NeedLock True) = ":"+ show (NeedLock False) = ""++instance Show Condition where+ show (Condition _ []) = ""+ show (Condition cf s) = "* " ++ show cf ++ s++instance Show ConditionFlag where+ show Normal = ""+ show Invert = "!"+ show Eval = "$"+ show UseExitCode = "?"+ show LessThan = "<"+ show GreaterThan = ">"+ show (Var s) = s++" ?? "++instance Show Action where+ show (Nest es) = "{ \n"++(es >>= showLn)++"}"+ show (File s) = s+ show (Forward es) = "! "++(es >>= (++ " "))+ show (Pipe s) = "| "++s+++{-+Here is a test case to try:+PExp [] [(Condition Normal "^From.*peter"), (Condition Normal "^Subject:.*compilers")] (Nest [PExp [Copy] [] (Forward "william@somewhere.edu"), PExp [] [] (File "petcompil")])++It should generate output equivalent to:+:0+* ^From.*peter+* ^Subject:.*compilers+ {+ :0 c+ ! william@somewhere.edu++ :0+ petcompil+ }++-}
+ Autoproc/Rules/Dagit.hs view
@@ -0,0 +1,310 @@+module Autoproc.Rules.Dagit where++import Autoproc.Classifier++import Control.Monad.Writer hiding (when)++{- | Any rules that you create need to end up in the rules list. Other+ than that, feel free to define your own rules using these rules an+ examples.++ A rule is something of the form:++> when condition action++Examples of condition might include:++> (from (Addr "foo@bar"))+> (subject "Hi again")++And example actions are things like:++> (insertMbox "steve")@, @(forward [Addr "friend@yahoo.com"])++ I have created some aliases for commonly used constructions+ For example, @simpleSortByFrom "joe"@, is equivalent to:++> when (from (Addr "joe")) (insertMbox "joe")++ For a full list of what is possible, check the "Autoproc.Classifier" module. -}+--Rules start here:+dagitRules :: Writer [CExp] ()+dagitRules = do spamc; spamcheck; sarah; mom; dad; rogan; lkm; cvsupdates;+ cdspaper; bugs; forms3Tech; forms3; euses; darcsUsers;+ darcsDevel; sbclDevel; ogi; clispDevel; csGradTalk;+ classes; nwn; debian; csmaillist; momentum; fixReplyTo; dagitDefaultRule++-- | I use this rule to make sure any mail that is not sorted goes into+-- my mail spool. It uses "Autoproc.Classifier"'s 'defaultRule'+dagitDefaultRule :: Writer [CExp] ()+dagitDefaultRule = defaultRule "/var/mail/dagit"++--Friends/Family+-- | If the email address contains "sparish", then place the email into a folder+-- by the name "sparish". Actually, the name of the mailbox is created by+-- appending boxPrefix which is defined in the Configuration module.+sarah :: Writer [CExp] ()+sarah = simpleSortByFrom "sparish"++-- | Similar to 'sarah', except we are sorting based on the subject line,+-- and giving the mailbox. As above, boxPrefix will be added to "nwn".+nwn :: Writer [CExp] ()+nwn = subjectToMbox "nwn" "nwn"+-- If the email address contains Griffinmndm then the email is from Mom.+mom :: Writer [CExp] ()+mom = addressToMbox "Griffinmndm" "mom"+dad :: Writer [CExp] ()+dad = addressToMbox "naturesgifts" "dad"+rogan :: Writer [CExp] ()+rogan = addressToMbox "creswick" "rogan"++--Mailing lists+lkm :: Writer [CExp] ()+lkm = toAddressToMbox "linux-kernel@vger.kernel.org" "linux-kernel"++-- This is an example of the general syntax. The above examples are converted+-- to an analogous when statement.++cvsupdates :: Writer [CExp] ()+cvsupdates = subjectsToMbox ["\\[forms3-tech\\]", "\\[cvs\\]"] "cvsupdates"++cdspaper :: Writer [CExp] ()+cdspaper = subjectsToMbox ["\\[CDs Paper Update\\]"] "cdpaper"++bugs :: Writer [CExp] ()+bugs = subjectsToMbox ["\\[forms3-tech\\]", "\\[jira\\]"] "bugs"++forms3Tech :: Writer [CExp] ()+forms3Tech = simpleSortByTo_ "forms3-tech"++forms3 :: Writer [CExp] ()+forms3 = simpleSortByTo_ "forms3"++euses :: Writer [CExp] ()+euses = when ((subject "\\[eusesnewsletter\\]") .||.+ (to_ (Addr "eusesosugrads")) .||.+ (to_ (Addr "eusesall")))+ (insertMbox "euses")++darcsUsers :: Writer [CExp] ()+darcsUsers = simpleSortByTo_ "darcs-users"++darcsDevel :: Writer [CExp] ()+darcsDevel = simpleSortByTo_ "darcs-devel"++sbclDevel :: Writer [CExp] ()+sbclDevel = simpleSortByTo_ "sbcl-devel"++ogi :: Writer [CExp] ()+ogi = subjectToMbox "OGI" "csmaillist"++clispDevel :: Writer [CExp] ()+clispDevel = simpleSortByTo_ "clisp-devel"++csGradTalk :: Writer [CExp] ()+csGradTalk = simpleSortByTo_ "cs-grad-talk"++-- This rule has a custom header check. It checks the header of the+-- email for a line that begins with "X-Loop: ...".+-- People familiar with regular expressions will recognize the meaning.+-- of ^ and .*+debian :: Writer [CExp] ()+debian = when (CheckHeader "^X-Loop: debian.*@lists.debian.org")+ (insertMbox "debian")++csmaillist :: Writer [CExp] ()+csmaillist = when (subject "\\[cs-grads\\]" .||.+ subject "\\[eecs-grads\\]" .||.+ to_ (Addr "eecs-grads"))+ (insertMbox "csmaillist")++--Class lists++-- This is a rather sophisticated example demonstrating matching.+-- When the % operator is used, the text that matches the regular+-- expression on the right hand side of the %, is stored in the variable+-- match. This requires whenMatch instead of when.+classes :: Writer [CExp] ()+classes = whenMatch (((to_ (Addr "class-")) % ".*@") `refineBy`+ ((CheckMatch "()") % "[^@]+"))+ (placeInUsingMatch (mailBoxFromMatch match))++-- Example showing that usage of match is checked using the type+-- system. In this example match would not have a value because the+-- operator % has not been used in the condition.+--test = when (to_ (Addr "test"))+-- (placeInUsingMatch (mailbox match))++--spam rules+-- | A filter is a special action that transforms the email for+-- the benefit of future rules. This particular rule,+-- hands the email off to spam assassin so that it can be checked for+-- signs of spam.+spamc :: Writer [CExp] ()+spamc = when Always (Filter "/usr/local/bin/spamc")++-- isSpam and spamLevel are special conditions for use with SpamAssassin.+spamcheck :: Writer [CExp] ()+spamcheck = when (isSpam .||.+ (spamLevel 3) .||.+ (from (Addr "nationalmkt@planters.net")))+ (insertMbox "caughtspam")++momentum :: Writer [CExp] ()+momentum = subjectToMbox "momentum!" "caughtspam"++--Random Examples+-- | An example that demonstrates forwarding an email.+sharing :: Writer [CExp] ()+sharing = when (said "caring" .&&. from (Addr "ecards"))+ (forwardTo [(Addr "dagit@codersbase.com"),+ (Addr "thedagit@hotmail.com")])++-- | This rules "fixes" the reply-to header of a mailing list. I don't+-- recommend doing this unless you know what you are doing.+fixReplyTo :: Writer [CExp] ()+fixReplyTo = whenMatch (to_ (Addr "") % "osu-free@lists") filter'+ where filter' = do m <- match+ return $ Filter $ "formail -I\"Reply-To: "++m++"\""++-- This example shows that conditions can be inverted.+notTest :: Writer [CExp] ()+notTest = when ((Not ((said "caring") .||.+ (subject "Hi"))) .&&.+ (from (Addr "steve")))+ (insertMbox "notCaring")++-- | Sometimes we want just one condition, but we have multiple actions.+-- In this case, use the also syntax. It allows multiple action for+-- one rule.+alsoTest :: Writer [CExp] ()+alsoTest = when (from (Addr "steve"))+ ((insertMbox "steve") `also`+ (forwardTo [Addr "steve's boss", Addr "steve's friend"]) `also`+ (insertMbox "backup"))++--End of Rules+++-- Example Classifiers, not all of the rules have been captured as+-- classifiers++--Friends/Family+sarah' :: Writer [CExp] ()+sarah' = simpleClassifyByFrom "sparish"+nwn' :: Writer [CExp] ()+nwn' = simpleClassifyBySubject "nwn"+mom' :: Writer [CExp] ()+mom' = classifyByFromAddr "Griffinmndm" "mom"+dad' :: Writer [CExp] ()+dad' = classifyByFromAddr "naturesgifts" "dad"+rogan' :: Writer [CExp] ()+rogan' = classifyByFromAddr "creswick" "rogan"++--Mailing lists+lkm' :: Writer [CExp] ()+lkm' = classifyByTo_ (Addr "linux-kernel@vger.kernel.org")+ (mailbox "linux-kernel")++---------------------------------------------------------++-- TODO: do some refactoring here++ogi' :: Writer [CExp] ()+ogi' = classifyBy ("ogi",+ (subject "OGI"))+ (insertMbox "csmaillist")++debian' :: Writer [CExp] ()+debian' = classifyBy ("debian",+ (CheckHeader "^X-Loop: debian.*@lists.debian.org") )+ (insertMbox "debian")++---++cvsupdates' :: Writer [CExp] ()+cvsupdates' = classifyBy ("cvsupdates",+ (subject "[forms3-tech]" .&&.+ subject "[cvs]"))+ (insertMbox "cvsupdates")++bugs' :: Writer [CExp] ()+bugs' = classifyBy ("bugs",+ (subject "[forms3-tech]" .&&.+ subject "[jira]"))+ (insertMbox "bugs")++csmaillist' :: Writer [CExp] ()+csmaillist' = classifyBy ("csmaillist", (subject "[cs-grads]" .||.+ subject "[eecs-grads]" .||.+ to_ (Addr "eecs-grads")))+ (insertMbox "csmaillist")++euses' :: Writer [CExp] ()+euses' = classifyBy ("euses", ((subject "[eusesnewsletter]") .||.+ (to_ (Addr "eusesosugrads")) .||.+ (to_ (Addr "eusesall"))))+ (insertMbox "euses")++--------------------------------------------------------------+++forms3Tech' :: Writer [CExp] ()+forms3Tech' = simpleClassifyByTo_ "forms3-tech"++forms3' :: Writer [CExp] ()+forms3' = simpleClassifyByTo_ "forms3"++darcsUsers' :: Writer [CExp] ()+darcsUsers' = simpleClassifyByTo_ "darcs-users"++darcsDevel' :: Writer [CExp] ()+darcsDevel' = simpleClassifyByTo_ "darcs-devel"++sbclDevel' :: Writer [CExp] ()+sbclDevel' = simpleClassifyByTo_ "sbcl-devel"++clispDevel' :: Writer [CExp] ()+clispDevel' = simpleClassifyByTo_ "clisp-devel"++csGradTalk' :: Writer [CExp] ()+csGradTalk' = simpleClassifyByTo_ "cs-grad-talk"++momentum' :: Writer [CExp] ()+momentum' = classifyBySubject "momentum!" (mailbox "caughtspam")++orTest :: Writer [CExp] ()+orTest = when (subject "1" .||.+ subject "2" .&&.+ subject "3" .&&.+ subject "4" .&&.+ subject "5" .&&.+ subject "6" .&&.+ subject "7" .&&.+ subject "8" .&&.+ subject "9" .&&.+ subject "10" .&&.+ subject "11" .&&.+ subject "12" .&&.+ subject "13" .&&.+ subject "14" .&&.+ subject "15")+ (insertMbox "orTest")++notOrTest :: Writer [CExp] ()+notOrTest = when (Not (subject "1" .||.+ subject "2" .&&.+ subject "3" .&&.+ subject "4" .&&.+ subject "5" .&&.+ subject "6" .&&.+ subject "7" .&&.+ subject "8" .&&.+ subject "9" .&&.+ subject "10" .&&.+ subject "11" .&&.+ subject "12" .&&.+ subject "13" .&&.+ subject "14" .&&.+ subject "15"))+ (insertMbox "notOrTest")
+ Autoproc/Run.hs view
@@ -0,0 +1,27 @@+module Autoproc.Run where++import Autoproc.Classifier (CExp)+import Autoproc.Configuration (showVars)+import Autoproc.Procmail (PExp, showLn)+import Autoproc.Transform (generate)++import Control.Monad.Writer (execWriter, Writer)++showProcmailrc :: [(String, String)] -> [PExp] -> String+showProcmailrc vars ps = showVars (vars) +++ "\n\n" +++ "############################\n\n" +++ (ps >>= showLn)++autoprocMessage :: IO ()+autoprocMessage = putStr $ unlines ["#.procmailrc",+ "# Automatically generated procmail recipes by Autoproc.",+ "# To find out more about Autoproc visit:",+ "# 'http://www.codersbase.com/Autoproc'",+ "# To fetch the latest version of autoproc with Darcs:",+ "# 'darcs get http://projects.codersbase.com/repos/autoproc'",+ "",+ ""]++autoprocMain :: [(String, String)] -> Writer [CExp] a -> IO ()+autoprocMain vars rules = autoprocMessage >> (putStrLn . showProcmailrc vars . concatMap generate $ execWriter rules)
+ Autoproc/Transform.hs view
@@ -0,0 +1,134 @@+module Autoproc.Transform (generate) where++-- The purpose of this module is to define the transformations from+-- condition expression to procmail representation.++import qualified Autoproc.Procmail as Pm+import qualified Autoproc.Classifier as Cf++import Data.List (nub)++-- This raises the question, Why not use RecipeFlag for CExp? The+-- reason is that we are trying to separate the final representation+-- (procmail) from the condition expression representation. So in the+-- future if CExp flags change, we need only redefine this function.+-- Similar logic applies to Act and Cond.+-- Note: The above reasoning has saved me many times during development.+transformFlag :: Cf.Flag -> Pm.RecipeFlag+transformFlag Cf.Copy = Pm.Copy+transformFlag Cf.Wait = Pm.Wait+transformFlag Cf.IgnoreErrors = Pm.IgnoreErrors+transformFlag (Cf.NeedLock b) = (Pm.NeedLock b)+transformFlag Cf.Chain = Pm.Chain+transformFlag Cf.CaseSensitive = Pm.CaseSensitive++transformCond :: Cf.Cond -> [Pm.Condition]+transformCond (Cf.Or _ _) = error "transformCond cannot handle Or."+transformCond (Cf.And c1 c2) = transformCond c1 ++ transformCond c2+transformCond (Cf.Not c) = [Pm.Condition Pm.Invert c']+ where [Pm.Condition _ c'] = transformCond c+transformCond Cf.Always = [Pm.Condition Pm.Normal []]+transformCond (Cf.CheckHeader s) = [Pm.Condition Pm.Normal s]+transformCond (Cf.CheckBody s) = [Pm.Condition Pm.Normal s]+transformCond (Cf.CheckMatch s) = [Pm.Condition (Pm.Var "$MATCH") s]++transformAct :: Cf.Act -> Pm.Action+transformAct (Cf.File s) = Pm.File s+transformAct (Cf.Filter s) = Pm.Pipe s+transformAct (Cf.Fwd es) = Pm.Forward (map unAddress es)+ where unAddress (Cf.Addr a) = a+transformAct (Cf.Nest as) = Pm.Nest (map transform as)++-- This pushes "not" as far down as possible.+-- This helps us to reach a "normal" form+distributeNot :: Cf.Cond -> Cf.Cond+distributeNot (Cf.Not (Cf.And c1 c2)) = Cf.Or (distributeNot (Cf.Not c1))+ (distributeNot (Cf.Not c2))+distributeNot (Cf.Not (Cf.Or c1 c2)) = Cf.And (distributeNot (Cf.Not c1))+ (distributeNot (Cf.Not c2))+distributeNot (Cf.Not (Cf.Not c)) = distributeNot c+distributeNot (Cf.And c1 c2) = Cf.And (distributeNot c1)+ (distributeNot c2)+distributeNot (Cf.Or c1 c2) = Cf.Or (distributeNot c1)+ (distributeNot c2)+distributeNot c = c++-- Each call to factor moves the Or one step closer to the top. This must+-- be called many times by repeated to reach a normal form.+-- The goal here is to pull Or to the outside.+-- We don't worry about not, because that should have been handled by+-- distributeNot already.+factor :: Cf.Cond -> Cf.Cond+factor (Cf.And (Cf.Or c1 c2) c3) = (Cf.Or (Cf.And (factor c1) (factor c3))+ (Cf.And (factor c2) (factor c3)))+factor (Cf.And c1 (Cf.Or c2 c3)) = (Cf.Or (Cf.And (factor c1) (factor c2))+ (Cf.And (factor c1) (factor c3)))+factor (Cf.Or c1 c2) = (Cf.Or (factor c1) (factor c2))+factor (Cf.And c1 c2) = (Cf.And (factor c1) (factor c2))+factor c = c++repeated :: (Cf.Cond -> Cf.Cond) -> Cf.Cond -> Cf.Cond+repeated t c = loop c+ where loop c' = if c' == (t c') then c'+ else repeated t (t c')++-- Procmail does not have a notion of Or, so we must put the+-- conditions at the same level and repeat the action. This way, when+-- one of the conditions becomes true, the action is performed.+reduceOr :: Cf.CExp -> [Cf.CExp]+reduceOr (Cf.CExp fs (Cf.Or c1 c2) a) = (reduceOr (Cf.CExp fs c1 a)) +++ (reduceOr (Cf.CExp fs c2 a))+reduceOr x = [x]++-- 1. distrubuteNot+-- 2. factor+-- 3. reduceOr+-- The result is a list of CExp, none of which have an Or in their conditions+-- and not is only used on individual conditions+simplify :: Cf.CExp -> [Cf.CExp]+simplify (Cf.CExp fs c a) = reduceOr (Cf.CExp fs c'' a)+ where+ c' = repeated distributeNot c+ c'' = repeated factor c'++-- This function assumses a simplified CExp, hence the first pattern match.+transform :: Cf.CExp -> Pm.PExp+transform (Cf.CExp _ (Cf.Or _ _) _) = error "use simplify."+transform (Cf.CExp fs c a) = Pm.PExp (nub fs') (transformCond c)+ (transformAct a)+ where+ fs' = (if any' then [Pm.CheckHeader,Pm.CheckBody] else+ if body then [Pm.CheckBody] else+ if header then [Pm.CheckHeader] else [])++newFlags+ body = checksBody c+ header = checksHeader c+ any' = checksAny c+ newFlags = (if isFilter a then [Pm.Wait, Pm.PipeAsFilter] else [])+++ (map transformFlag fs)++isFilter :: Cf.Act -> Bool+isFilter (Cf.Filter _) = True+isFilter _ = False++checksHeader :: Cf.Cond -> Bool+checksHeader (Cf.And c1 c2) = checksHeader c1 || checksHeader c2+checksHeader (Cf.Or c1 c2) = checksHeader c1 || checksHeader c2+checksHeader (Cf.Not c) = checksHeader c+checksHeader (Cf.CheckHeader _) = True+checksHeader _ = False++checksBody :: Cf.Cond -> Bool+checksBody (Cf.And c1 c2) = checksBody c1 || checksBody c2+checksBody (Cf.Or c1 c2) = checksBody c1 || checksBody c2+checksBody (Cf.Not c) = checksBody c+checksBody (Cf.CheckBody _) = True+checksBody _ = False++-- Perhaps checksEither is a better name?+checksAny :: Cf.Cond -> Bool+checksAny c = checksHeader c && checksBody c++-- This is how to generate a procmail recipe from a single expression+-- in the condition expression language.+generate :: Cf.CExp -> [Pm.PExp]+generate c = map transform (simplify c)
+ LICENSE view
@@ -0,0 +1,28 @@+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ Main.hs view
@@ -0,0 +1,93 @@+module Main (main) where++import Autoproc.Configuration (defaultVariables)+import Autoproc.Run (autoprocMain)+import Autoproc.Rules.Dagit (dagitRules)++import Prelude hiding (catch)+import System.IO (openFile, IOMode(WriteMode), hClose)+import System.Posix.Process (executeFile, forkProcess, createSession, getProcessStatus)+import System.Process (runProcess, waitForProcess)+import System.Directory (getAppUserDataDirectory, getModificationTime)+import Control.Monad.Trans (liftIO, MonadIO)+import Control.Exception (bracket, catch)+import Control.Monad (when)+import System.Exit (ExitCode(..), exitWith)+import Control.Applicative ((<$>))++-- | The entry point into autoproc. Attempts to compile @~/.autoproc/autoproc.hs@+-- for autoproc, and if it doesn't find one, just compiles the default.+-- This code and method is totally stolen from XMonad. Thanks guys!+main :: IO ()+main = catch (buildLaunch) (\_ -> autoprocMain defaultVariables dagitRules)++-- | Build "~/.autoproc/autoproc.hs" with GHC, then execute it. If there are no+-- errors, this function does not return. An exception is raised in any of+-- these cases:+-- * ghc missing+-- * ~/.autoproc/autoproc.hs missing+-- * autoproc.hs fails to compile+-- ** wrong ghc in path (fails to compile)+-- ** type error, syntax error, ..+-- * Missing autoproc/AutoprocContrib modules due to ghc upgrade+--+buildLaunch :: IO ()+buildLaunch = do+ recompile True+ dir <- getAutoprocDir+ executeFile (dir ++ "/autoproc") False [] Nothing+ return ()++-- | Return the path to @~\/.autoproc@.+getAutoprocDir :: MonadIO m => m String+getAutoprocDir = liftIO $ getAppUserDataDirectory "autoproc"++-- | 'recompile force', recompile @~\/.autoproc\/autoproc.hs@ when any of the+-- following apply:+-- * force is True+-- * the autoproc executable does not exist+-- * the autoproc executable is older than autoproc.hs+--+-- The -i flag is used to restrict recompilation to the autoproc.hs file only.+--+-- Compilation errors (if any) are logged to ~\/.autoproc\/autoproc.errors. If+-- GHC indicates failure with a non-zero exit code, an xmessage displaying+-- that file is spawned.+--+-- False is returned if there are compilation errors.+recompile :: MonadIO m => Bool -> m Bool+recompile force = liftIO $ do+ dir <- getAutoprocDir+ let binn = "autoproc"+ bin = dir ++ "/" ++ binn+ base = dir ++ "/" ++ "autoproc"+ err = base ++ ".errors"+ src = base ++ ".hs"+ srcT <- getModTime src+ binT <- getModTime bin+ if (force || srcT > binT)+ then do+ status <- bracket (openFile err WriteMode) hClose $ \h -> do+ waitForProcess =<< runProcess "ghc" ["--make", "autoproc.hs", "-i", "-no-recomp", "-v0", "-o",binn] (Just dir)+ Nothing Nothing Nothing (Just h)++ -- now, if it fails, run xmessage to let the user know:+ when (status /= ExitSuccess) $ do+ ghcErr <- readFile err+ let msg = unlines $+ ["Error detected while loading autoproc configuration file: " ++ src]+ ++ lines ghcErr ++ ["","Please check the file for errors."]+ doubleFork $ executeFile "xmessage" True ["-default", "okay", msg] Nothing+ return (status == ExitSuccess)+ else return True+ where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)++-- | Double fork and execute an IO action (usually one of the exec family of+-- functions)+doubleFork :: MonadIO m => IO () -> m ()+doubleFork m = liftIO $ do+ pid <- forkProcess $ do+ forkProcess (createSession >> m)+ exitWith ExitSuccess+ getProcessStatus True False pid+ return ()
+ README view
@@ -0,0 +1,63 @@+= Autoproc =++Autoproc is a utility/language for email filtering. Autoproc makes it+easy to define filtering rules. The rules define a Haskell program,+that when executed generates a valid Procmail recipes file. This file+can then be used with Procmail to sort and filter your email before+you see it.++You will need to have GHC or Hugs, Procmail and formail installed.++== Installation ==++To get a copy of Autoproc, use++ darcs get http://projects.codersbase.com/repos/autoproc++If you don't have darcs do not despair, currently Autoproc is about 5+files and can be easily downloaded by pointing your web browser at the+address just given.++You can also visit Hackage, where you should be able to find a tarball of autoproc (or eventually you could install Autoproc through cabal-install).++== Customizing Autoproc ==++Autoproc runs on the XMonad model. If you aren't familiar with XMonad, the idea is that the package is constructed such that it provides a library, and then it compiles a thin executable using that library.++This is fine if the baked in configuration exactly suits your needs, but how do you have a system-wide XMonad which you can configure in a full Haskell style without some sort of Emacs-style interpreter? Well, the thin executable is tasked with looking for a xmonad.hs in a fixed location; if it exists, it gets compiled and the *new* binary gets run. And your personal xmonad.hs can do anything it wants - as all of XMonad's functionality is exposed as a library your xmonad.hs can import and modify at will. So your xmonad.hs boils down to 'main = xmonad $ myCrazyFunkyArgs'.++In Autoproc's case, what you do is create ~/.autoproc/autoproc.hs, and then set things up. (If you don't, Autoproc will use its compiled in configuration, which is surely not what you want.)++While I was testing this Xmonad-style configuration, I created an autoproc.hs that looks like this:++> import Autoproc.Configuration (defaultVariables)+> import Autoproc.Run+> import Autoproc.Rules.Dagit++> main ∷ IO ()+> main = do print "foo bar"+> autoprocMain defaultVariables dagitRules++('defaultVariables' provides the key-values of environmental variables, and 'dagitRules' is all the Procmail filtering rules.)++Now, this is the same environmental variables and configuration rules used by default, but there's nothing stopping me from taking defaultVariables and replacing it with++> myVariables = [("SHELL", "/bin/zsh")]++And I can run arbitrary stuff before and after the rules and variables are compiled down to text - my output will start with "foo bar", as useless a customization as that is...++== Running Autoproc ==++To run the autoproc binary and save your rules to the file recipes use the+following command:++ $ autoproc > recipes++If you are familiar with Procmail you may want to examine the file to+see that everything was generated correctly. Once you are confident+that you would like to use this file, you can simply move it to+$HOME/.procmailrc Depending on your system you may need to do+additional configuration to get Procmail itself running. Usually this+is done with a .forward file, or on some systems having a .procmailrc+is enough.+
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks simpleUserHooks
+ autoproc.cabal view
@@ -0,0 +1,32 @@+name: autoproc+version: 0.1+synopsis: EDSL for Procmail scripts+description: Autoproc is a utility which allows you to write an email filterer in an Haskell+ EDSL (embedded domain specific language); autoproc will then compile+ it down to a Procmail configuration file (.procmailrc). This file can+ then be used with Procmail to sort and filter your email before+ you see it.+category: System+license: BSD3+license-file: LICENSE+author: Jason Dagit+maintainer: Jason Dagit <dagit@codersbase.com>+homepage: http://projects.codersbase.com/repos/autoproc++build-type: Simple+Cabal-Version: >= 1.2+tested-with: GHC==6.8.2++data-files: README++Library+ exposed-modules: Autoproc.Classifier, Autoproc.Configuration, Autoproc.Run,+ Autoproc.Procmail, Autoproc.Rules.Dagit, Autoproc.Transform++ build-depends: base>3, mtl, unix, directory, process++ ghc-options: -Wall -optl-Wl,-s+ ghc-prof-options: -prof -auto-all++Executable autoproc+ main-is: Main.hs