Add shutdown command

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index ef6e563..8bb2d4e 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -275,6 +275,21 @@ fun requestDir dname =
     end
     handle ErrorMsg.Error => ()
 
+fun requestShutdown () =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgShutdown);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Shutdown begun.\n"
+             | MsgError s => print ("Shutdown failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 fun requestGrant acl =
     let
        val (user, bio) = requestBio (fn () => ())
@@ -401,6 +416,21 @@ fun requestDbUser dbtype =
        OpenSSL.close bio
     end
 
+fun requestDbPasswd rc =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgDbPasswd rc);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Your password has been changed.\n"
+             | MsgError s => print ("Password set failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 fun requestDbTable p =
     let
        val (user, bio) = requestBio (fn () => ())
@@ -510,6 +540,27 @@ fun requestSaSet p =
        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 ()
@@ -607,7 +658,7 @@ fun service () =
              | SOME bio =>
                let
                    val user = OpenSSL.peerCN bio
-                   val () = print ("\nConnection from " ^ user ^ "\n")
+                   val () = print ("\nConnection from " ^ user ^ " at " ^ Date.toString (Date.fromTimeUniv (Time.now ())) ^ "\n")
                    val () = Domain.setUser user
 
                    fun doIt f cleanup =
@@ -693,6 +744,14 @@ fun service () =
                                MsgConfig code => doConfig [code]
                              | MsgMultiConfig codes => doConfig codes
 
+                             | MsgShutdown =>
+                               if Acl.query {user = user, class = "priv", value = "shutdown"} then
+                                   print ("Domtool dispatcher shutting down at " ^ Date.toString (Date.fromTimeUniv (Time.now ())) ^ "\n")
+                               else
+                                   (OpenSSL.close bio
+                                    handle OpenSSL.OpenSSL _ => ();
+                                    loop ())
+
                              | MsgGrant acl =>
                                doIt (fn () =>
                                         if Acl.query {user = user, class = "priv", value = "all"} then
@@ -784,6 +843,20 @@ fun service () =
                                                  SOME ("Error adding user: " ^ msg)))
                                     (fn () => ())
 
+                             | MsgDbPasswd {dbtype, passwd} =>
+                               doIt (fn () =>
+                                        case Dbms.lookup dbtype of
+                                            NONE => ("Database passwd request with unknown datatype type " ^ dbtype,
+                                                     SOME ("Unknown database type " ^ dbtype))
+                                          | SOME handler =>
+                                            case #passwd handler {user = user, passwd = passwd} of
+                                                NONE => ("Changed " ^ dbtype ^ " password of user " ^ user ^ ".",
+                                                         NONE)
+                                              | SOME msg =>
+                                                ("Error setting " ^ dbtype ^ " password of user " ^ user ^ ": " ^ msg,
+                                                 SOME ("Error adding user: " ^ msg)))
+                                    (fn () => ())
+
                              | MsgCreateDbTable {dbtype, dbname} =>
                                doIt (fn () =>
                                         if Dbms.validDbname dbname then
@@ -897,6 +970,18 @@ fun service () =
                                                             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"))
@@ -915,6 +1000,7 @@ fun service () =
                            handle OpenSSL.OpenSSL _ => ();
                            loop ())
     in
+       print ("Domtool dispatcher starting up at " ^ Date.toString (Date.fromTimeUniv (Time.now ())) ^ "\n");
        print "Listening for connections....\n";
        loop ();
        OpenSSL.shutdown sock