setsa
[hcoop/domtool2.git] / src / main.sml
index 23cedce..ef6e563 100644 (file)
@@ -422,13 +422,13 @@ fun requestListMailboxes domain =
     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
 
@@ -477,6 +477,39 @@ fun requestRmMailbox p =
        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 ()
@@ -636,6 +669,20 @@ fun service () =
                                 (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
@@ -773,7 +820,7 @@ fun service () =
                                         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
@@ -788,7 +835,7 @@ fun service () =
                                                             passwd = passwd, mailbox = mailbox} of
                                                 NONE => ("Added mailbox " ^ emailUser ^ "@" ^ domain ^ " at " ^ mailbox,
                                                          NONE)
-                                              | SOME msg => ("Error adding mailbox: " ^ msg,
+                                              | SOME msg => ("Error adding mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
                                                              SOME msg))
                                     (fn () => ())
                                
@@ -797,7 +844,7 @@ fun service () =
                                         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
@@ -808,7 +855,7 @@ fun service () =
                                                                passwd = passwd} of
                                                 NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain,
                                                          NONE)
-                                              | SOME msg => ("Error changing mailbox password: " ^ msg,
+                                              | SOME msg => ("Error changing mailbox password for " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
                                                              SOME msg))
                                     (fn () => ())
 
@@ -817,17 +864,39 @@ fun service () =
                                         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
                                             case Vmail.rm {domain = domain, user = emailUser} of
                                                 NONE => ("Deleted mailbox " ^ emailUser ^ "@" ^ domain,
                                                          NONE)
-                                              | SOME msg => ("Error deleting mailbox: " ^ msg,
+                                              | SOME msg => ("Error deleting mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
                                                              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"))