{-# OPTIONS -cpp #-} -- -- Copyright (C) 2003 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- 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., 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -- -- | @progress@ - submit a ~pls-style progress report -- -- The progress utility reads a progress report file, nominally -- in html format, and writes it to the user's directory with a -- new filename in the format requried by the ~pls weblog. If a -- non-option argument is present on the command line, progress -- attempts to read from this file. If no file is given, and the -- @-e@ option is set, progress invokes an editor for input, -- otherwise progress reads from standard input. -- -- An additional flag, @-m@, indicates the resulting html file -- should also be pretty-printed as ascii, and posted to the -- email address set by the @PROGRESS_LIST@ variable, or -- @pls.all@ otherwise. The default behaviour, without @-m@, is -- to not send mail. -- -- Additionally, a mechanism is provided to abort the submission -- progress. If the text to be sent contains no characters in the -- range [a-zA-Z] then no file is written, and no mail is sent, -- irrespective of the @-m@ -- flag. This is the only internal -- means of aborting an editing session. -- -- Some options also have a long form. -- -- -- /OPTIONS:/ -- -- > -m --mail -- -- Format the resulting file as ascii and mail to list. -- -- > -e --edit -- -- Invoke and editor, and take input from the resulting file -- -- > --help -- -- Display a helpful message -- -- > -p --path path -- -- Save file to @$USER@ directory under different path -- -- > -l --list list -- -- Mail to list /list/ -- -- > -w --with cmd -- -- Use @cmd@ to postprocess the source before mailing -- -- > -s string -- -- Use string as email subject line -- -- > -g group -- -- Set file group to be @group@ -- -- > -t tag -- -- Append a different, possibly null, tag to the email that is -- sent. Useful for generating the mail with a postprocessor that -- won't parse the tag. -- -- The progress utility exits with 0 on success >0 otherwise -- -- -- /EXAMPLES:/ -- -- > $ progress -- -- Read from stdin, writing to default directory -- -- > $ progress -m -- -- Same as above, but mail the result to list -- -- > $ progress -e -- -- Read input from file resulting from editor invocation -- -- > $ progress -m file.html -- -- Write file.html into default directory and send -- postprocessed output to default mailing list. -- -- > $ progress -me -- -- And mail the result -- -- > $ progress -mw 'lynx -dump' -- > $ progress -mw cat -- > $ progress -mw cpp -- > $ progress -mw runhugs -t"" -- -- Before mailing, filter source through a variety of -- postprocessors. -- -- /ENVIRONMENT:/ -- -- progress utilises the @EDITOR@ variable when the @-e@ -- option is given. -- -- Additionally, the following variables may be set: -- -- > PROGRESS_PATH [ /web/pls/internal/meetings/progressreports/ ] -- -- The path to a directory in which a @USER@ directory can -- be found, into which the resulting file will be renamed and -- written. -- -- > PROGRESS_LIST [ pls.all ] -- -- Email address to mail pretty printed result. -- -- > PROGRESS_SUBJ [ Progress report ] -- -- Subject line of the mail to be sent. -- -- > PROGRESS_PPR [ w3m -T text/html -dump -cols 70 ] -- -- Html pretty printer to use. This command must pretty -- print it's file argument to stdout. -- -- > PROGRESS_GROUP [ pls+install ] -- -- Unix group to chown the resulting file to. -- -- > PROGRESS_TAG [ \n\n-- $USER ] -- -- Tag to append to outgoing mail -- -- /FILES:/ -- -- > /tmp/progress_report.XXXXXXXXXX -- -- Temp file, generated by @mkstemp(3)@ to which stdin, editor -- or file is written. -- -- /BUGS:/ -- -- If you provide both a file name and the @-e@ option on -- the command line argument, the @-e@ is silently ignored. -- The mail client is hardwired, as are the permissions to -- which the log file is set. -- module Main(main) where import Bits ((.|.)) import Monad (when,unless) import Data.List (intersperse) import Foreign.C (newCString,peekCString,CInt,CString) import Text.Regex (mkRegex,matchRegex) import Data.Maybe (isNothing) import System.IO (readFile,writeFile) import System.Cmd (system) import System.Exit (ExitCode(..),exitWith) import System.Time #if __GLASGOW_HASKELL__ >= 601 import System.Posix hiding (getEnv,mkstemp) #else import System.Posix hiding (getEnv) #endif import System.Locale (defaultTimeLocale) import System.Directory import System.Environment (getArgs,getProgName,getEnv) import System.Console.GetOpt -- Path used, if $PROGRESS_PATH not defined pATH = "/web/pls/internal/meetings/progressreports/" -- address to mail result to if $PROGRESS_LIST not defined lIST = "pls.all" -- editor to use if $EDITOR is not defined eDITOR = "vim" -- html pretty printer, if $PROGRESS_PPR not defined pPR = "w3m -T text/html -dump -cols 70" -- mail subject, if $PROGRESS_SUBJ not defined sUBJ = "Progress report" -- Group for blog files, if $PROGRESS_GROUP is not defined gROUP = "pls+install" -- Tag to append to end of email, does not appear in web log tAG = "
-- " -- mail client mAIL = "mail -s" -- Template for mkstemp file generation tEMPLATE = "/tmp/progress_report.XXXXXXXXXX" -- Format for progress report file names. fORMAT = "%d_%m_%Y.html" -- Permissions for files in blog directory pERMS = "640" -- url of man page uRL = "http://www.cse.unsw.edu.au/~dons/code/progress/html/Main.html" main = do prog <- getProgName argv <- getArgs (file,mail,notag,vars) <- parseArgs argv prog user <- getEnv "USER" list <- getvalue lIST "PROGRESS_LIST" (List "") vars path'<- getvalue pATH "PROGRESS_PATH" (Path "") vars ppr <- getvalue pPR "PROGRESS_PPR" (With "") vars group<- getvalue gROUP "PROGRESS_GROUP" (Group "") vars subj <- getvalue sUBJ "PROGRESS_SUBJ" (Subject "") vars tag' <- getvalue (tAG++user) "PROGRESS_TAG" (Tag "") vars let path = path' ++ if (last path' /= '/') then "/" else "" let tag = "\n" ++ tag' tmpf <- mkstemp tEMPLATE () <- if file == "" then edit tmpf else copy file tmpf -- a blank file here means no more action f <- readFile tmpf when (isNothing $ matchRegex (mkRegex "[a-zA-Z]") f) $ do exitWith ExitSuccess setCurrentDirectory $ path++user now <- getTime tuef <- findTuesday now copy tmpf tuef chgrp group tuef chmod pERMS tuef -- note, permissions aren't used yet -- the mail infrastructure when mail $ do unless notag $ appendFile tmpf tag let pipe = [ ppr, tmpf, "|", mAIL, "'"++subj++"'", list ] system $ concat $ intersperse " " pipe return () putStrLn $ "wrote: " ++ path ++ user ++ "/"++ tuef removeFile tmpf exitWith ExitSuccess -- | Return the value of a variable, considering the environment, -- the command line args , and the default values getvalue :: String -> String -> Flag -> [(Flag,String)] -> IO String getvalue def varid flag flags = do v <- getEnvDefault varid def let l = [ s | (f,s)<-flags, f == flag ] return $ if l == [] then v else head l -- | Get the current clock time as a CalendarTime type getTime :: IO (CalendarTime) getTime = do now <- getClockTime now' <- toCalendarTime now return now' -- | flag types data Flag = Mail | Editor | Help | Tag String | Path String | List String | With String | Subject String | Group String deriving Eq -- | recognized input sources opts :: [OptDescr Flag] opts = [ Option ['m'] ["mail"] (NoArg Mail) "mail resulting file", Option ['e'] ["edit"] (NoArg Editor) "take input from $EDITOR", Option ['?'] ["help"] (NoArg Help) "this message", Option ['p'] ["path"] (ReqArg Path "path") "path to user directory", Option ['l'] ["list"] (ReqArg List "address") "list to mail to", Option ['w'] ["with"] (ReqArg With "cmd") "html ppr to use", Option ['t'] ["tag" ] (ReqArg Tag "tag") "tag to append to the email", Option ['s'] [] (ReqArg Subject "string") "mail subject line", Option ['g'] [] (ReqArg Group "group") "group to chgrp file to" ] -- | parseArgs checks the arguments, returning the source file -- name and a boolean indicating if we mail the result parseArgs :: [String] -> String -> IO (String,Bool,Bool,[(Flag,String)]) parseArgs argv p = case (getOpt Permute opts argv) of (os,n,[]) -> do when (length n > 1 || elem Help os) $ error $ (usageInfo (header p) opts) ++ msg ++ uRL let src = if length n == 1 then head n else if elem Editor os then "" else "-" let vs = map pair os -- must have specified -t "" let notag = elem (Tag "","") vs return (src, elem Mail os, notag, vs) (_,_,err) -> error $ concat err ++ (usageInfo (header p) opts) ++ msg ++ uRL where header p = "Usage: " ++ p ++ " [OPTION...] [file]" msg = "\nThe full unix man page is at:\n" pair (Path a) = (Path "",a) pair (List a) = (List "",a) pair (With a) = (With "",a) pair (Group a) = (Group "",a) pair (Subject a)= (Subject "",a) pair (Tag a) = (Tag "",a) pair a = (a,"") -- | chmod does a semi-native chmod. This is better than system() -- This currently hard codes @640@ as the mode chmod :: String -> String -> IO () chmod perms file = do setFileMode file mode where mode = ownerReadMode .|. ownerWriteMode .|. groupReadMode -- | chgrp does a semi-native Haskell chgrp. Better than system() -- Broken on OpenBSD (FIXME) -- Fail: unsupported operation -- Action: getGroupEntryForName -- Reason: Result too large -- chgrp :: String -> String -> IO () chgrp group file = do user <- getRealUserID (GroupEntry _ gid _ ) <- getGroupEntryForName group setOwnerAndGroup file user gid -- | findNextTuesday does the time magic. We add the number of -- seconds in a day to the clocktime until we hit a Tuesday. And -- rely on toCalendarTiem to handle all the weirdness of end of -- months/years/leap years. findTuesday :: CalendarTime -> IO String findTuesday time@(CalendarTime _ _ _ _ _ _ _ Tuesday _ _ _ _ ) = return $ clean $ formatCalendarTime defaultTimeLocale fORMAT time findTuesday time = let (TOD secs ps) = toClockTime time in do time' <- toCalendarTime (TOD (secs + 60*60*24) ps) findTuesday time' -- | clean removes leading zeroes from days and months clean :: String -> String clean ('0':d:'_':rest) = d : '_' : clean rest clean ( d :e:'_':rest) = d : e : '_' : clean rest clean s = s -- | copy the input file to the out file. -- if the first argument is "-" then copy reads from stdin copy :: String -> String -> IO () copy inf outf = do str <- if inf == "-" then getContents else readFile inf writeFile outf str -- | invoke editor, storing input in a temp file edit :: String -> IO () edit tmpf = do editor <- getEnvDefault "EDITOR" eDITOR v <- system $ editor ++" "++ tmpf when (v /= ExitSuccess) $ error $ editor ++ " returned non-zero status" -- | The mkstemp() function makes the same replacement to the -- template and creates the template file, mode 0600, returning -- the file path. It opens for reading and writing, but we -- reopen it so as to use Haskell file io. mkstemp avoids the -- race between testing for a file's existence and opening it for -- use. We use it to generate a safe temp file for editing, -- amongs other things mkstemp :: String -> IO String mkstemp template = do str <- newCString template fd <- c_mkstemp str if (fd == -1) then error "mkstemp failed! this is super-bad" else do str' <- peekCString str ; return str' -- real mkstemp foreign import ccall unsafe "mkstemp" c_mkstemp :: CString -> IO (CInt)