diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,61 @@ +0.3.7 (2010-02-27) + + * New maintainer: Marco Túlio Gontijo e Silva . + * Include --max-diff option. + * README: Update the Homepage link and the darcs repository. + * darcs-monitor.1: Don't generate manpage and correct syntax for + "...". + * Make the code Warning-free and hlint-free. + * darcs-monitor.cabal: + - Include more fields. + - Include upper bound to base dependency. + - Include ChangeLog in Extra-Source-Files. + * ChangeLog: Include the log for 0.3.[3-6] in ChangeLog. + +0.3.6 (2008-05-10) + + * use Cabal's mechanism for telling the program what version it is + * consequently the Setup.hs customization has been removed + +0.3.5 (2008-05-10) + + * change the Cabal description to reflect the fact that this package + fails to build with development versions of HaXml + +0.3.4 (2008-05-04) + + * add a Description to the Cabal file + +0.3.3 (2008-05-04) + + * fixes to enable building with GHC 6.8 + * now requires Cabal 1.2 + +0.3.2 (2007-08-31) + + * documentation update + +0.3.1 (2007-05-31) + + * documentation update + +0.3 (2007-05-31) + + * there is now support for the %CHANGES% and %SHORTREPO% + substitutions in the template + * a default template is now provided + * ' and " entity references in darcs changes –xml is now + supported + * patches with just the author email address (no real name) are + now handled correctly + * when multiple emails are sent, they are now sent in + chronological order + * emails are announced to the user + +0.2 (2007-02-12) + + * new option --dry-run + +0.1 (2007-02-11) + + * Initial release. diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -28,6 +28,7 @@ , confDarcsArgs :: [String] , confProgName :: String , confSendmailPath :: FilePath + , confMaxDiff :: Maybe Int , confEmailTemplate :: Maybe FilePath , confCharset :: Maybe String } diff --git a/EmailPatch.hs b/EmailPatch.hs --- a/EmailPatch.hs +++ b/EmailPatch.hs @@ -30,6 +30,7 @@ import Paths_darcs_monitor +defaultSendmail :: String defaultSendmail = "/usr/sbin/sendmail" sendMail :: (MonadConfig m, MonadIO m) => @@ -59,17 +60,18 @@ ,"-s"] menc <- asks confCharset met <- asks confEmailTemplate + maxDiff <- asks confMaxDiff et <- liftIO $ case met of Just s -> return s Nothing -> do let s = patchRepoDir pd ++ "email-template" ex <- doesFileExist s - case ex of - True -> return s - False -> getDataFileName "default-template" + if ex + then return s + else getDataFileName "default-template" tmpl <- liftIO $ readFile et let f hdr ('%':'%':r) = let r' = dropWhile (/= '\n') r - r'' = case r' of ('\n':r'') -> r'' - _ -> r' + r'' = case r' of ('\n':r''') -> r''' + _ -> r' in f hdr r'' f hdr ('%':r) = let (k,('%':r')) = span (/= '%') r he s = if hdr @@ -78,7 +80,13 @@ nhe = showString repl = case k of "RECIPIENT" -> nhe rec - "DIFF" -> he diff + "DIFF" -> he + $ case maxDiff of + Just md + | length diff > md + -> take md diff ++ + "[...incomplete...]" + _ -> diff "CHANGES" -> he changes "REPO" -> he (patchRepo pd) "SHORTREPO" -> he (shortRepo pd) @@ -109,7 +117,7 @@ headerEncode :: Maybe String -> String -> ShowS -headerEncode menc str = do +headerEncode menc str = case menc of Nothing -> showString str Just enc -> let ws = words str @@ -139,12 +147,14 @@ c2 = hds !! a2 hds = "0123456789ABCDEF" - +safe :: String safe = "<>@-+.abcdefghijklmnopqrstuvwxyABCDEFGHIJKLMNOPQRSTUVWXY0123456789\ \!\"#$%&\'()*,:;[]\\^_`{}|~/" +areSafe :: String -> Bool areSafe = all (`elem` safe) +shortRepo :: PatchData -> String shortRepo he | last repo == '/' = reverse $ takeWhile (/= '/') $ tail $ reverse repo | '/' `elem` repo = reverse $ takeWhile (/= '/') $ reverse repo diff --git a/README b/README --- a/README +++ b/README @@ -9,7 +9,7 @@ just emails; but no others are implemented at this time. There is a DarcsWiki page on darcs-monitor at - http://wiki.darcs.net/DarcsWiki/DarcsMonitor + http://wiki.darcs.net/RelatedSoftware/DarcsMonitor Installation @@ -25,7 +25,7 @@ ought to work for most people. -Darcs-monitor has been tested using GHC 6.8.1. It might not work with +Darcs-monitor has been tested using GHC 6.12.1. It might not work with older compilers; though patches are accepted for fixing any unportabilities. @@ -92,10 +92,10 @@ Feedback -Please send comments and bug reports to antti-juhani@kaijanaho.fi. +Please send comments and bug reports to marcot@debian.org. Any patches should be prepared with Darcs against the repository - http://antti-juhani.kaijanaho.fi/darcs/darcs-monitor/ + http://people.debian.org/~marcot/darcs/darcs-monitor/ and sent using "darcs send". Have fun, diff --git a/darcs-monitor.1 b/darcs-monitor.1 new file mode 100644 --- /dev/null +++ b/darcs-monitor.1 @@ -0,0 +1,172 @@ +.\" Copyright © 2007 Antti-Juhani Kaijanaho +.\" +.\" This program is free software; you can redistribute it and/or modify +.\" it under the terms of the GNU General Public License as published by +.\" the Free Software Foundation; either version 2 of the License, or +.\" (at your option) any later version. +.\" +.\" This program is distributed in the hope that it will be useful, +.\" but WITHOUT ANY WARRANTY; without even the implied warranty of +.\" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +.\" GNU General Public License for more details. +.\" +.\" You should have received a copy of the GNU General Public License along +.\" with this program; if not, write to the Free Software Foundation, Inc., +.\" 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +.TH darcs-monitor 1 +.SH NAME +darcs\-monitor \- Darcs add-on that sends mail about newly pushed changes +.SH SYNOPSIS +.B darcs-monitor +[ +.I option +\&... +] +.B email +.I recipient +[ +.I repository +\&... +] +.sp +.B darcs\-monitor +.B \-h +| +.B \-\-help +.sp +.B darcs\-monitor +.B \-\-version +.SH DESCRIPTION +.B darcs\-monitor +reads one or more +.BR darcs (1) +repositories and sends email about every change it has not previously +sent an email about to the same address. +. +To have darcs-monitor run every time someone pushes to a repository, +add +the following lines to +.IR _darcs/prefs/defaults . +.IP +.B apply +.B posthook +.B darcs\-monitor +.BI \-\-charset= charset +.B email +.I recipient +.br +.B apply +.B run\-posthook +.br +.PP +In the above, +.I charset +should be the MIME charset that patches +(including their metadata) are in, and +.I recipient +should be the email +address where emails should be sent. +.PP +You can also run +.B darcs\-monitor +from +.BR crontab (1) +or from the command line. +. +In those cases, it is easiest to specify the path to the repository on +the command line after other arguments. +. +In fact, you can specify more than one. +.PP +By default, mail is sent by calling +.IR /usr/sbin/sendmail . +Another +.B sendmail (1) +binary can be specified by using a command-line switch. +.PP +You can customise the email by providing a template. +. +You should put your own template in the file +.I _darcs/third-party/darcs-monitor/email-template +(you can use other files, but then you have to specify where it is). +. +In the template you can use the following substitutions: +.TP +.B %RECIPIENT% +the email address to which email is sent +.TP +.B %DIFF% +the Darcs-provided diff -u of the patch +.TP +.B %CHANGES% +a Darcs-provided summary of changes +.TP +.B %REPO% +the path to the repository +.TP +.B %SHORTREPO% +the final component of the path to the repository +.TP +.B %AUTHOR% +the patch author +.TP +.B %DATE% +the patch date +.TP +.B %HASH% +the patch Darcs hash +.TP +.B %TITLE% +the patch name +.TP +.B %COMMENT% +the patch comment +.PP +Also, in the template, two percent signs in sequence +.BR "" ( %% ) +start a comment that extends to the end of the current line. +.SH OPTIONS +.TP +\-n, \-\-dry-run +Do not actually do anything, but do mark it done. +.TP +\-\-darcs\-path=FILE +Provide the location of the +.BR darcs (1) +executable. +.TP +\-\-darcs\-args=ARGS +Provide additional arguments to +.BR darcs (1), +separating arguments with commas. +.TP +\-\-use\-sendmail[=FILE] +Use +.BR sendmail (1) +(either at +.I /usr/sbin/sendmail +or at +.IR FILE ). +.TP +\-d, \-\-max\-diff=SIZE +Only include the first SIZE bytes of the diff in the e-mail. +.TP +\-\-charset=CHARSET +Specify the MIME name of the repository's character set. +.TP +\-h, \-\-help +Show usage. +.TP +\-\-version +Show version. +.SH "EXIT STATUS" +Success is indicated by 0, failure by any other exit status. +.SH FILES +.TP +.I /usr/share/darcs-monitor/default-template +The default email template. See above for the format. +.SH AUTHOR +.B darcs\-monitor +was written by Antti-Juhani Kaijanaho. +.SH "SEE ALSO" +.BR darcs (1) diff --git a/darcs-monitor.1.in b/darcs-monitor.1.in deleted file mode 100644 --- a/darcs-monitor.1.in +++ /dev/null @@ -1,169 +0,0 @@ -.\" Copyright © 2007 Antti-Juhani Kaijanaho -.\" -.\" This program is free software; you can redistribute it and/or modify -.\" it under the terms of the GNU General Public License as published by -.\" the Free Software Foundation; either version 2 of the License, or -.\" (at your option) any later version. -.\" -.\" This program is distributed in the hope that it will be useful, -.\" but WITHOUT ANY WARRANTY; without even the implied warranty of -.\" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -.\" GNU General Public License for more details. -.\" -.\" You should have received a copy of the GNU General Public License along -.\" with this program; if not, write to the Free Software Foundation, Inc., -.\" 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -.TH darcs-monitor 1 -.SH NAME -darcs\-monitor \- Darcs add-on that sends mail about newly pushed changes -.SH SYNOPSIS -.B darcs-monitor -[ -.I option -... -] -.B email -.I recipient -[ -.I repository -... -] -.sp -.B darcs\-monitor -.B \-h -| -.B \-\-help -.sp -.B darcs\-monitor -.B \-\-version -.SH DESCRIPTION -.B darcs\-monitor -reads one or more -.BR darcs (1) -repositories and sends email about every change it has not previously -sent an email about to the same address. -. -To have darcs-monitor run every time someone pushes to a repository, -add -the following lines to -.IR _darcs/prefs/defaults . -.IP -.B apply -.B posthook -.B darcs\-monitor -.BI \-\-charset= charset -.B email -.I recipient -.br -.B apply -.B run\-posthook -.br -.PP -In the above, -.I charset -should be the MIME charset that patches -(including their metadata) are in, and -.I recipient -should be the email -address where emails should be sent. -.PP -You can also run -.B darcs\-monitor -from -.BR crontab (1) -or from the command line. -. -In those cases, it is easiest to specify the path to the repository on -the command line after other arguments. -. -In fact, you can specify more than one. -.PP -By default, mail is sent by calling -.IR /usr/sbin/sendmail . -Another -.B sendmail (1) -binary can be specified by using a command-line switch. -.PP -You can customise the email by providing a template. -. -You should put your own template in the file -.I _darcs/third-party/darcs-monitor/email-template -(you can use other files, but then you have to specify where it is). -. -In the template you can use the following substitutions: -.TP -.B %RECIPIENT% -the email address to which email is sent -.TP -.B %DIFF% -the Darcs-provided diff -u of the patch -.TP -.B %CHANGES% -a Darcs-provided summary of changes -.TP -.B %REPO% -the path to the repository -.TP -.B %SHORTREPO% -the final component of the path to the repository -.TP -.B %AUTHOR% -the patch author -.TP -.B %DATE% -the patch date -.TP -.B %HASH% -the patch Darcs hash -.TP -.B %TITLE% -the patch name -.TP -.B %COMMENT% -the patch comment -.PP -Also, in the template, two percent signs in sequence -.BR "" ( %% ) -start a comment that extends to the end of the current line. -.SH OPTIONS -.TP -\-n, \-\-dry-run -Do not actually do anything, but do mark it done. -.TP -\-\-darcs\-path=FILE -Provide the location of the -.BR darcs (1) -executable. -.TP -\-\-darcs\-args=ARGS -Provide additional arguments to -.BR darcs (1), -separating arguments with commas. -.TP -\-\-use\-sendmail[=FILE] -Use -.BR sendmail (1) -(either at -.I /usr/sbin/sendmail -or at -.IR FILE ). -.TP -\-\-charset=CHARSET -Specify the MIME name of the repository's character set. -.TP -\-h, \-\-help -Show usage. -.TP -\-\-version -Show version. -.SH "EXIT STATUS" -Success is indicated by 0, failure by any other exit status. -.SH FILES -.TP -.I @DATADIR@/default-template -The default email template. See above for the format. -.SH AUTHOR -.B darcs\-monitor -was written by Antti-Juhani Kaijanaho. -.SH "SEE ALSO" -.BR darcs (1) diff --git a/darcs-monitor.cabal b/darcs-monitor.cabal --- a/darcs-monitor.cabal +++ b/darcs-monitor.cabal @@ -1,11 +1,17 @@ Cabal-Version: >= 1.2 Name: darcs-monitor -Version: 0.3.6 +Version: 0.3.7 License: GPL License-File: GPL.txt +Copyright: + 2007 Antti-Juhani Kaijanaho + 2007 Benja Fallenstein + 2007 Benjamin Franksen Author: Antti-Juhani Kaijanaho -Maintainer: antti-juhani@kaijanaho.fi +Maintainer: Marco Túlio Gontijo e Silva Stability: experimental +Homepage: http://wiki.darcs.net/RelatedSoftware/DarcsMonitor +Package-Url: http://hackage.haskell.org/packages/archive/darcs-monitor/0.3.7/darcs-monitor-0.3.7.tar.gz Synopsis: Darcs repository monitor (sends email) Description: Darcs-monitor will send email to a specified recipient about new changes added to a specific darcs repository. It can be run @@ -14,7 +20,7 @@ seems most convenient. Category: Distribution Build-Type: Simple -Extra-Source-Files: README darcs-monitor.1.in +Extra-Source-Files: ChangeLog README darcs-monitor.1 Data-Files: default-template flag splitBase @@ -23,8 +29,9 @@ Executable darcs-monitor Build-Depends: mtl, HaXml < 1.14 if flag(splitBase) - Build-Depends: base >=3, containers, directory, process + Build-Depends: base >=3 && < 5, containers, directory, process else Build-Depends: base < 3 Main-Is: darcs-monitor.hs Other-Modules: Config Darcs EmailPatch PatchData + GHC-Options: -Wall diff --git a/darcs-monitor.hs b/darcs-monitor.hs --- a/darcs-monitor.hs +++ b/darcs-monitor.hs @@ -32,7 +32,7 @@ import System.Environment import System.Exit import System.IO -import Text.XML.HaXml hiding (when,version) +import Text.XML.HaXml hiding (when,version,x,tag,cdata) import Config import Darcs @@ -45,31 +45,34 @@ | DarcsPathOpt String | DarcsArgsOpt [String] | SendmailOpt String + | MaxDiffOpt Int | EmailTemplateOpt String | CharsetOpt String | DryRunOpt options :: [OptDescr Opt] options = - [Option ['n'] ["dry-run"] (NoArg DryRunOpt) + [Option "n" ["dry-run"] (NoArg DryRunOpt) "Do not actually do anything, but do mark it done" - ,Option [] ["darcs-path"] (ReqArg DarcsPathOpt "FILE") + ,Option "" ["darcs-path"] (ReqArg DarcsPathOpt "FILE") "Provide location of darcs" - ,Option [] ["darcs-args"] (ReqArg (DarcsArgsOpt . splitArgs) "ARGS") + ,Option "" ["darcs-args"] (ReqArg (DarcsArgsOpt . splitArgs) "ARGS") "Provide additional arguments to darcs\n\ \(separate arguments with commas)" - ,Option [] ["use-sendmail"] (OptArg (\m -> SendmailOpt $ + ,Option "" ["use-sendmail"] (OptArg (\m -> SendmailOpt $ case m of Nothing -> defaultSendmail Just s -> s) "FILE") ("Use sendmail (either " ++ defaultSendmail ++ " or FILE") - ,Option [] ["email-template"] (ReqArg EmailTemplateOpt "FILE") + ,Option "d" ["max-diff"] (ReqArg (MaxDiffOpt . read) "SIZE") + "Only include the first SIZE bytes of the diff in the e-mail" + ,Option "" ["email-template"] (ReqArg EmailTemplateOpt "FILE") "Provide a template for emails" - ,Option [] ["charset"] (ReqArg CharsetOpt "CHARSET") + ,Option "" ["charset"] (ReqArg CharsetOpt "CHARSET") "Specify character set" - ,Option ['h'] ["help"] (NoArg HelpOpt) "Show usage" - ,Option [] ["version"] (NoArg VersionOpt) "Show version" + ,Option "h" ["help"] (NoArg HelpOpt) "Show usage" + ,Option "" ["version"] (NoArg VersionOpt) "Show version" ] findOpt :: [a] -> b -> (a -> Maybe b) -> b @@ -82,6 +85,9 @@ splitArgs str = let (a,b) = span (/=',') str in case b of ',':r -> a : splitArgs r [] -> [a] + _ -> error + $ "darcs-monitor: splitArgs called with \ + \wrong arguments: b = " ++ b main :: IO () main = do args <- getArgs @@ -93,7 +99,7 @@ case opt of HelpOpt -> do putStr (usageInfo (usage pn) options) exitWith ExitSuccess - where usage pn = "Usage: " ++ pn ++ + where usage pn_ = "Usage: " ++ pn_ ++ " [OPTIONS] email RECIPIENT [REPO ...]" VersionOpt -> do putStrLn $ "darcs-monitor " ++ showVersion version @@ -117,6 +123,10 @@ case opt of SendmailOpt s -> Just s _ -> Nothing + , confMaxDiff = findOpt roa Nothing $ \opt -> + case opt of + MaxDiffOpt s -> Just $ Just s + _ -> Nothing , confEmailTemplate = findOpt roa Nothing $ \opt -> case opt of EmailTemplateOpt s -> @@ -141,24 +151,28 @@ rest) s:_ -> err ("unknown command " ++ s) _ -> err "missing command" - repos <- case args'' of [] -> do wd <- liftIO $ getCurrentDirectory + repos <- case args'' of [] -> do wd <- liftIO getCurrentDirectory return [wd] _ -> return args'' mapM_ (processRepo dryRun cmd) repos +err :: (MonadConfig m, MonadIO m) => String -> m a err msg = do pn <- asks confProgName liftIO $ do hPutStrLn stderr (pn ++ ": " ++ msg) exitFailure type Command m = (String, PatchData -> m Bool) +dir :: String dir = "_darcs/third-party/darcs-monitor/" + +seenPatchesFileName :: String seenPatchesFileName = dir ++ "seen-patches" type SeenPatches = Map String (Set String) readSeenPatches :: MonadIO m => String -> m SeenPatches -readSeenPatches repo = do +readSeenPatches repo = liftIO $ catch (do fc <- readFile (repo ++ seenPatchesFileName) return (read fc) ) $ \_ -> return Map.empty @@ -172,13 +186,13 @@ seenPatches <- readSeenPatches repo xml <- invokeDarcs ["changes", "--reverse", "--repo="++repo,"--xml-output"] let Document _ _ (Elem "changelog" _ content) _ = xmlParse repo xml - let patches = filter (\c -> case c of CElem e -> True ; _ -> False) content - spl <- forM patches $ \ (CElem (Elem "patch" attrs content)) -> + let patches = filter (\c -> case c of CElem _e -> True ; _ -> False) content + spl <- forM patches $ \ (CElem (Elem "patch" attrs content_)) -> do let author = getAttr "author" attrs localDate = getAttr "local_date" attrs hash = getAttr "hash" attrs - name = getElem "name" content - comment = getElem "comment" content + name = getElem "name" content_ + comment = getElem "comment" content_ (authorName, authorEmail) = parseAuthor author dt = PatchData { patchRepo = repo , patchAuthor = authorName @@ -191,19 +205,17 @@ } res <- let f set | dryRun = return (Set.insert tag set) f set = do ok <- cmd dt - case ok of True -> return $ - Set.insert tag set - False -> return set + return $ if ok then Set.insert tag set else set in case Map.lookup hash seenPatches of - Just set -> case Set.member tag set of - True -> return set - False -> f set - Nothing -> f (Set.empty) + Just set + -> if Set.member tag set then return set else f set + Nothing -> f Set.empty return (hash,res) let seenPatches' :: SeenPatches seenPatches' = Map.fromList spl liftIO $ writeFile (repo ++ seenPatchesFileName) (show seenPatches') +parseAuthor :: String -> (String, String) parseAuthor str | '<' `elem` str = let (name, '<':rest) = span (/= '<') str (addr, _) = span (/= '>') rest @@ -213,10 +225,13 @@ in (trim name, trim addr) | otherwise = ("", trim str) -ltrim str = dropWhile isSpace str +ltrim :: String -> String +ltrim = dropWhile isSpace +trim :: String -> String trim = reverse . ltrim . reverse . ltrim +getAttr :: (Eq a) => a -> [(a, AttValue)] -> String getAttr name attrs = case lookup name attrs of Nothing -> "" Just (AttValue x) -> massage x "" @@ -226,10 +241,17 @@ massage ss massage [] = id -getElem name (CElem (Elem name' _ content) : rest) +getElem :: Name -> [Content] -> String +getElem name (CElem (Elem name' _ content) : _rest) | name == name' = getContent content "" getElem name (_ : rest) = getElem name rest +getElem name [] + = error + $ "darcs-monitor: getElem called with wrong parameter: name = " + ++ show name + ++ ", contents = []" +getContent :: [Content] -> String -> String getContent (CElem (Elem _ _ content) : rest) = getContent content . getContent rest getContent (CString _ cdata : rest) = showString cdata . @@ -239,6 +261,7 @@ getContent (CMisc _ : rest) = getContent rest getContent [] = id +getRef :: Reference -> String -> String getRef (RefEntity "lt") = showChar '<' getRef (RefEntity "gt") = showChar '>' getRef (RefEntity "amp") = showChar '&'