[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[msmtp-users] queueing facility for msmtp written in Standard ML
I'm not sure if this will be of use to people, but I've included below
the queueing facility for msmtp that I wrote in (the functional
programming language) Standard ML. I call the program msmtp-queue.
It has a -daemon option for starting a daemon, a -queue option for
queueing a message and waking up the daemon, a -wakeup otion for
waking up the daemon, and a -quit option for terminating the daemon.
I'm now using this happily on Mac OS X, as a complement to fetchmail.
Alley Stoughton
PS I don't read the mailing list regularly, but I can be contacted
directly at stough@...35...
------------------------------------------------------------------------------
#!/bin/bash
# start msmtp-queue
# edit the following line to set heapdir to the directory where
# msmtp-queue's heap image will reside
heapdir=/usr/local/smlnj/bin/.heap
# set sml to SML/NJ executable
sml=/usr/local/bin/sml
exec $sml @SMLload=$heapdir/msmtp-queue @SMLcmdname=$0 "$@"
------------------------------------------------------------------------------
(* msmtp-queue.cm *)
Library
source(-)
is
$/basis.cm
msmtp-queue.sig
msmtp-queue.sml
------------------------------------------------------------------------------
(* msmtp-queue.sig *)
signature MAIN =
sig
val main : string * string list -> OS.Process.status
end;
------------------------------------------------------------------------------
(* msmtp-queue.sml *)
structure Main :> MAIN =
struct
val msmtpProg = "/usr/local/bin/msmtp"
val msmtpArgs = ["-t"]
val pidFile = ".msmtp-queue.pid"
val queueDir = ".msmtp-queue"
fun error(prog, s) =
(print(prog ^ ": " ^ s ^ "\n");
OS.Process.exit OS.Process.failure)
fun sleep n = OS.Process.sleep(Time.fromSeconds(IntInf.fromInt n))
exception BadInt
fun stringToInt x =
case Int.scan StringCvt.DEC Substring.getc (Substring.full x) of
NONE => raise BadInt
| SOME(n, y) =>
if Substring.isEmpty(StringCvt.skipWS Substring.getc y)
then n
else raise BadInt
fun getPID() = Word32.toInt(Posix.Process.pidToWord(Posix.ProcEnv.getpid()))
fun getHomeDir() =
Posix.SysDB.Passwd.home(Posix.SysDB.getpwuid(Posix.ProcEnv.getuid()))
fun makeFileName() =
Date.fmt "%Y:%m:%d-%H:%M:%S" (Date.fromTimeLocal(Time.now())) ^
"-" ^ Int.toString(getPID())
exception NODaemon
fun readDaemonPID() =
let val stm = TextIO.openIn(getHomeDir() ^ "/" ^ pidFile)
val pid = stringToInt(valOf(TextIO.inputLine stm))
val _ = TextIO.closeIn stm
in Posix.Process.wordToPid(Word32.fromInt pid) end
handle _ => raise NODaemon
fun alreadyDaemon() = (readDaemonPID(); true) handle NoDaemon => false
fun writeDaemonPID() =
let val pid = getPID()
val homeDir = getHomeDir()
val stm = TextIO.openOut(homeDir ^ "/" ^ pidFile)
val _ = TextIO.output(stm, Int.toString pid ^ "\n")
val _ = TextIO.closeOut stm
in () end
fun sort _ nil = nil
| sort f (x :: xs) =
let fun insert x nil = [x]
| insert x (y_ys as y :: ys) =
(case f(x, y) of
LESS => x :: y_ys
| EQUAL => y_ys
| GREATER => y :: insert x ys)
in insert x (sort f xs) end
fun getNextMessageFileName dirStm =
let fun readDir() =
case Posix.FileSys.readdir dirStm of
NONE => nil
| SOME s => s :: readDir()
val _ = Posix.FileSys.rewinddir dirStm
in SOME(hd(sort String.compare (readDir())))
handle _ => NONE
end
fun sendMessage inStm =
let val proc = Unix.execute(msmtpProg, msmtpArgs)
val outStm = Unix.textOutstreamOf proc
fun loop() =
case TextIO.inputLine inStm of
NONE => ()
| SOME s => (TextIO.output(outStm, s); loop())
val _ = loop()
in Unix.reap proc end
handle _ => OS.Process.failure
fun quit prog =
let val pid = readDaemonPID()
val sigTERM = Posix.Signal.term
in (Posix.Process.kill(Posix.Process.K_PROC pid, sigTERM);
OS.Process.exit OS.Process.success)
end
handle _ => error(prog, "no daemon running")
fun wakeup prog =
let val pid = readDaemonPID()
val sigUSR1 = Posix.Signal.usr1
in (Posix.Process.kill(Posix.Process.K_PROC pid, sigUSR1);
OS.Process.exit OS.Process.success)
end
handle _ => error(prog, "no daemon running")
fun queue prog =
let val homeDir = getHomeDir()
val fileName = makeFileName()
val stm = TextIO.openOut("/tmp/" ^ fileName)
fun loop() =
case TextIO.inputLine TextIO.stdIn of
NONE => ()
| SOME s => (TextIO.output(stm, s); loop())
val _ = loop()
val _ = TextIO.closeOut stm
in Posix.FileSys.rename{old = "/tmp/" ^ fileName,
new = homeDir ^ "/" ^ queueDir ^ "/" ^ fileName}
handle _ => error(prog, "queue directory does not exist");
wakeup prog
end
fun daemonBody sleepSecs =
let val sigINT = valOf(Signals.fromString "INT")
val sigHUP = valOf(Signals.fromString "HUP")
val sigQUIT = valOf(Signals.fromString "QUIT")
val sigTERM = valOf(Signals.fromString "TERM")
val sigUSR1 = valOf(Signals.fromString "USR1")
val allSigs = [sigINT, sigHUP, sigQUIT, sigTERM, sigUSR1]
val _ = Signals.maskSignals(Signals.MASK allSigs)
val _ = writeDaemonPID()
val quitRef = ref false
fun handler(signal, _, cont) =
if signal = sigUSR1 (* we're being woken up *)
then cont
else (quitRef := true; cont)
val _ = Signals.setHandler(sigINT, Signals.HANDLER handler)
val _ = Signals.setHandler(sigHUP, Signals.HANDLER handler)
val _ = Signals.setHandler(sigQUIT, Signals.HANDLER handler)
val _ = Signals.setHandler(sigTERM, Signals.HANDLER handler)
val _ = Signals.setHandler(sigUSR1, Signals.HANDLER handler)
val _ = Signals.unmaskSignals(Signals.MASK allSigs)
val dirStm = Posix.FileSys.opendir "."
fun loop() =
if !quitRef
then (Posix.FileSys.unlink(getHomeDir() ^ "/" ^ pidFile);
OS.Process.exit OS.Process.success)
else case getNextMessageFileName dirStm of
NONE => (sleep sleepSecs; loop())
| SOME fileName =>
let val stm = TextIO.openIn fileName
in if sendMessage stm = OS.Process.success
then (Posix.FileSys.unlink fileName;
loop())
else (sleep sleepSecs; loop())
end
in loop() end
fun daemon(prog, sleepSecs) =
if alreadyDaemon()
then error(prog, "daemon already running")
else (Posix.FileSys.chdir(getHomeDir() ^ "/" ^ queueDir)
handle _ => error(prog, "queue directory doesn't exist");
case Posix.Process.fork() of
NONE => daemonBody sleepSecs
| SOME _ => OS.Process.exit OS.Process.success)
fun usage prog =
(print("usage:\n" ^
" " ^ prog ^ " -quit\n" ^
" " ^ prog ^ " -wakeup\n" ^
" " ^ prog ^ " -queue\n" ^
" " ^ prog ^ " -daemon SLEEP\n");
OS.Process.exit OS.Process.failure)
fun main(prog, args) =
case args of
["-quit"] => quit prog
| ["-wakeup"] => wakeup prog
| ["-queue"] => queue prog
| ["-daemon", sleepSecs] =>
let val sleepSecs =
stringToInt sleepSecs
handle BadInt => usage prog
in if sleepSecs < 1
then usage prog
else daemon(prog, sleepSecs)
end
| _ => usage prog
end;