smtplog
[hcoop/domtool2.git] / src / main.sml
index 5025cb2..f9b2c9f 100644 (file)
@@ -416,6 +416,22 @@ fun requestDbTable p =
        OpenSSL.close bio
     end
 
+fun requestListMailboxes domain =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgListMailboxes domain);
+       (case Msg.recv bio of
+            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.")
+       before OpenSSL.close bio
+    end
+
 fun requestNewMailbox p =
     let
        val (_, bio) = requestBio (fn () => ())
@@ -461,6 +477,60 @@ 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 requestSmtpLog domain =
+    let
+       val (_, bio) = requestBio (fn () => ())
+
+       val _ = Msg.send (bio, MsgSmtpLogReq domain)
+
+       fun loop () =
+           case Msg.recv bio of
+               NONE => print "Server closed connection unexpectedly.\n"
+             | SOME m =>
+               case m of
+                   MsgOk => ()
+                 | MsgSmtpLogRes line => (print line;
+                                          loop ())
+                 | MsgError s => print ("Log search failed: " ^ s ^ "\n")
+                 | _ => print "Unexpected server reply.\n"
+    in
+       loop ();
+       OpenSSL.close bio
+    end
+
 fun regenerate context =
     let
        val b = basis ()
@@ -620,6 +690,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
@@ -738,12 +822,26 @@ fun service () =
                                              SOME ("Invalid database name " ^ dbname)))
                                     (fn () => ())
 
+                             | MsgListMailboxes domain =>
+                               doIt (fn () =>
+                                        if not (Domain.yourDomain domain) then
+                                            ("User wasn't authorized to list mailboxes for " ^ domain,
+                                             SOME "You're not authorized to configure that domain.")
+                                        else
+                                            case Vmail.list domain of
+                                                Vmail.Listing users => (Msg.send (bio, MsgMailboxes users);
+                                                                        ("Sent mailbox list for " ^ domain,
+                                                                         NONE))
+                                              | Vmail.Error msg => ("Error listing mailboxes for " ^ domain ^ ": " ^ msg,
+                                                                    SOME msg))
+                                    (fn () => ())
+
                              | MsgNewMailbox {domain, user = emailUser, passwd, mailbox} =>
                                doIt (fn () =>
                                         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
@@ -758,7 +856,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 () => ())
                                
@@ -767,7 +865,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
@@ -778,7 +876,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 () => ())
 
@@ -787,17 +885,51 @@ 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 () => ())
+
+                             | MsgSmtpLogReq domain =>
+                               doIt (fn () =>
+                                        if not (Domain.yourDomain domain) then
+                                            ("Unauthorized user tried to request SMTP logs for " ^ domain,
+                                             SOME "You aren't authorized to configure that domain.")
+                                        else
+                                            (SmtpLog.search (fn line => Msg.send (bio, MsgSmtpLogRes line))
+                                             domain;
+                                             ("Requested SMTP logs for " ^ domain,
+                                              NONE)))
+                               (fn () => ())
+
                              | _ =>
                                doIt (fn () => ("Unexpected command",
                                                SOME "Unexpected command"))