$(MAKE_MLB_BASE) >src/vmail.mlb
echo "main-vmail.sml" >>src/vmail.mlb
+src/setsa.mlb: src/prefix.mlb src/sources src/suffix.mlb
+ $(MAKE_MLB_BASE) >src/setsa.mlb
+ echo "main-setsa.sml" >>src/setsa.mlb
+
openssl/smlnj/FFI/libssl.h.cm: openssl/openssl_sml.h
cd openssl/smlnj ; ml-nlffigen -d FFI -lh LibsslH.libh -include ../libssl-h.sml \
-cm libssl.h.cm -D__builtin_va_list="void*" \
bin/vmail: $(COMMON_MLTON_DEPS) src/vmail.mlb
mlton -output bin/vmail -link-opt -ldl src/vmail.mlb
+bin/setsa: $(COMMON_MLTON_DEPS) src/setsa.mlb
+ mlton -output bin/setsa -link-opt -ldl src/setsa.mlb
+
install:
cp scripts/domtool-publish /usr/local/sbin/
cp scripts/domtool-reset-global /usr/local/sbin/
-cp bin/domtool-doc /usr/local/bin/
-cp bin/dbtool /usr/local/bin/
-cp bin/vmail /usr/local/bin/
+ -cp bin/setsa /usr/local/bin/
cp src/plugins/domtool-postgres /usr/local/sbin/
cp src/plugins/domtool-mysql /usr/local/sbin/
domtool-doc
dbtool
vmail
+setsa
\ No newline at end of file
--- /dev/null
+structure SpamAssassin :> SPAM_ASSASSIN_CONFIG = struct
+
+val addrsDir = "/etc/spamassassin/addrs"
+
+end
--- /dev/null
+structure SpamAssassin : SPAM_ASSASSIN_CONFIG
--- /dev/null
+signature SPAM_ASSASSIN_CONFIG = sig
+
+ val addrsDir : string
+
+end
domtool-doc.mlb
dbtool.mlb
vmail.mlb
+setsa.mlb
val validDomain : string -> bool
val yourDomain : string -> bool
val validUser : string -> bool
+ val validEmailUser : string -> bool
val ip : string Env.arg
fun validUser s = size s > 0 andalso size s < 20
andalso CharVector.all Char.isAlphaNum s
+fun validEmailUser s =
+ size s > 0 andalso size s < 50
+ andalso CharVector.all (fn ch => Char.isAlphaNum ch
+ orelse ch = #"."
+ orelse ch = #"_"
+ orelse ch = #"-"
+ orelse ch = #"+") s
+
val validGroup = validUser
val _ = Env.type_one "no_spaces"
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * 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.
+ *)
+
+(* Setting SpamAssassin filtering preferences *)
+
+signature SET_SA = sig
+
+ datatype address =
+ User of string
+ | Email of string
+
+ val query : address -> bool
+ val set : address * bool -> unit
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * 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.
+ *)
+
+(* Setting SpamAssassin filtering preferences *)
+
+structure SetSA :> SET_SA = struct
+
+datatype address =
+ User of string
+ | Email of string
+
+fun address (User s) = s ^ "@localhost"
+ | address (Email s) = s
+
+fun file addr = OS.Path.joinDirFile {dir = Config.SpamAssassin.addrsDir,
+ file = address addr}
+
+fun query addr = Posix.FileSys.access (file addr, [])
+
+fun set (addr, setting) =
+ if setting then
+ TextIO.closeOut (TextIO.openAppend (file addr))
+ else
+ OS.FileSys.remove (file addr)
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * 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.
+ *)
+
+(* Driver for SpamAssassin filtering preferences *)
+
+val _ =
+ let
+ fun defaultEmail () = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid (Posix.ProcEnv.getuid ()))
+
+ val args = CommandLine.arguments ()
+
+ val (addr, args) =
+ case args of
+ "on" :: _ => (defaultEmail (), args)
+ | "off" :: _ => (defaultEmail (), args)
+ | addr :: rest => (addr, rest)
+ | [] => (defaultEmail (), args)
+ in
+ case args of
+ [] => Main.requestSaQuery addr
+ | ["on"] => Main.requestSaSet (addr, true)
+ | ["off"] => Main.requestSaSet (addr, false)
+ | _ => print "Invalid command-line argiments\n"
+ end
val requestPasswdMailbox : {domain : string, user : string, passwd : string}
-> unit
val requestRmMailbox : {domain : string, user : string} -> unit
+
+ val requestSaQuery : string -> unit
+ val requestSaSet : string * bool -> unit
end
in
Msg.send (bio, MsgListMailboxes domain);
(case Msg.recv bio of
- NONE => Vmail.Error "Server closed connection unexpectedly.\n"
+ NONE => Vmail.Error "Server closed connection unexpectedly."
| SOME m =>
case m of
MsgMailboxes users => (Msg.send (bio, MsgOk);
Vmail.Listing users)
| MsgError s => Vmail.Error ("Creation failed: " ^ s)
- | _ => Vmail.Error "Unexpected server reply.\n")
+ | _ => Vmail.Error "Unexpected server reply.")
before OpenSSL.close bio
end
OpenSSL.close bio
end
+fun requestSaQuery addr =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgSaQuery addr);
+ (case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgSaStatus b => (print ("SpamAssassin filtering for " ^ addr ^ " is "
+ ^ (if b then "ON" else "OFF") ^ ".\n");
+ Msg.send (bio, MsgOk))
+ | MsgError s => print ("Query failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n")
+ before OpenSSL.close bio
+ end
+
+fun requestSaSet p =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgSaSet p);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => print ("SpamAssassin filtering for " ^ #1 p ^ " is now "
+ ^ (if #2 p then "ON" else "OFF") ^ ".\n")
+ | MsgError s => print ("Set failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
fun regenerate context =
let
val b = basis ()
(fn () => OS.FileSys.remove outname)
end
+ fun checkAddr s =
+ case String.fields (fn ch => ch = #"@") s of
+ [user'] =>
+ if user = user' then
+ SOME (SetSA.User s)
+ else
+ NONE
+ | [user', domain] =>
+ if Domain.validEmailUser user' andalso Domain.yourDomain domain then
+ SOME (SetSA.Email s)
+ else
+ NONE
+ | _ => NONE
+
fun cmdLoop () =
case Msg.recv bio of
NONE => (OpenSSL.close bio
if not (Domain.yourDomain domain) then
("User wasn't authorized to add a mailbox to " ^ domain,
SOME "You're not authorized to configure that domain.")
- else if not (Domain.validUser emailUser) then
+ else if not (Domain.validEmailUser emailUser) then
("Invalid e-mail username " ^ emailUser,
SOME "Invalid e-mail username")
else if not (CharVector.all Char.isGraph passwd) then
if not (Domain.yourDomain domain) then
("User wasn't authorized to change password of a mailbox for " ^ domain,
SOME "You're not authorized to configure that domain.")
- else if not (Domain.validUser emailUser) then
+ else if not (Domain.validEmailUser emailUser) then
("Invalid e-mail username " ^ emailUser,
SOME "Invalid e-mail username")
else if not (CharVector.all Char.isGraph passwd) then
if not (Domain.yourDomain domain) then
("User wasn't authorized to change password of a mailbox for " ^ domain,
SOME "You're not authorized to configure that domain.")
- else if not (Domain.validUser emailUser) then
+ else if not (Domain.validEmailUser emailUser) then
("Invalid e-mail username " ^ emailUser,
SOME "Invalid e-mail username")
else
SOME msg))
(fn () => ())
+ | MsgSaQuery addr =>
+ doIt (fn () =>
+ case checkAddr addr of
+ NONE => ("User tried to query SA filtering for " ^ addr,
+ SOME "You aren't allowed to configure SA filtering for that recipient.")
+ | SOME addr' => (Msg.send (bio, MsgSaStatus (SetSA.query addr'));
+ ("Queried SA filtering status for " ^ addr,
+ NONE)))
+ (fn () => ())
+
+ | MsgSaSet (addr, b) =>
+ doIt (fn () =>
+ case checkAddr addr of
+ NONE => ("User tried to set SA filtering for " ^ addr,
+ SOME "You aren't allowed to configure SA filtering for that recipient.")
+ | SOME addr' => (SetSA.set (addr', b);
+ Msg.send (bio, MsgOk);
+ ("Set SA filtering status for " ^ addr ^ " to "
+ ^ (if b then "ON" else "OFF"),
+ NONE)))
+ (fn () => ())
+
| _ =>
doIt (fn () => ("Unexpected command",
SOME "Unexpected command"))
| NONE => NONE)
| _ => NONE
+fun sendBool (bio, b) =
+ if b then
+ OpenSSL.writeInt (bio, 1)
+ else
+ OpenSSL.writeInt (bio, 0)
+
+fun recvBool bio =
+ case OpenSSL.readInt bio of
+ SOME 0 => SOME false
+ | SOME 1 => SOME true
+ | _ => NONE
+
fun send (bio, m) =
case m of
MsgOk => OpenSSL.writeInt (bio, 1)
(OpenSSL.writeString (bio, user);
OpenSSL.writeString (bio, mailbox)))
(bio, users))
+ | MsgSaQuery addr => (OpenSSL.writeInt (bio, 23);
+ OpenSSL.writeString (bio, addr))
+ | MsgSaStatus b => (OpenSSL.writeInt (bio, 24);
+ sendBool (bio, b))
+ | MsgSaSet (addr, b) => (OpenSSL.writeInt (bio, 25);
+ OpenSSL.writeString (bio, addr);
+ sendBool (bio, b))
fun checkIt v =
case v of
SOME {user = user, mailbox = mailbox}
| _ => NONE)
bio)
+ | 23 => Option.map MsgSaQuery (OpenSSL.readString bio)
+ | 24 => Option.map MsgSaStatus (recvBool bio)
+ | 25 => (case (OpenSSL.readString bio, recvBool bio) of
+ (SOME user, SOME b) => SOME (MsgSaSet (user, b))
+ | _ => NONE)
| _ => NONE)
end
(* List all mailboxes for a domain *)
| MsgMailboxes of {user : string, mailbox : string} list
(* Reply to MsgListMailboxes *)
+ | MsgSaQuery of string
+ (* Check on the SpamAsssassin filtering status of a user or e-mail address *)
+ | MsgSaStatus of bool
+ (* Response to MsgSaQuery *)
+ | MsgSaSet of string * bool
+ (* Set the filtering status of a user or e-mail address *)
end
mail/vmail.sig
mail/vmail.sml
+mail/setsa.sig
+mail/setsa.sml
+
order.sig
order.sml