Add shutdown command

diff --git a/src/main-admin.sml b/src/main-admin.sml
index e3dc67b..1eda532 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -30,7 +30,8 @@ fun requestPerms user =
 
 val _ =
     case CommandLine.arguments () of
-       ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value}
+       ["shutdown"] => Main.requestShutdown ()
+      | ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value}
       | ["revoke", user, class, value] => Main.requestRevoke {user = user, class = class, value = value}
       | ["perms", user] => requestPerms user
       | ["perms"] => requestPerms (Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid (Posix.ProcEnv.getuid ())))

diff --git a/src/main.sig b/src/main.sig
index ca699b8..87f3028 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -34,6 +34,7 @@ signature MAIN = sig
     val request : string -> unit
     val requestDir : string -> unit
 
+    val requestShutdown : unit -> unit
     val requestGrant : Acl.acl -> unit
     val requestRevoke : Acl.acl -> unit
     val requestListPerms : string -> (string * string list) list option

diff --git a/src/main.sml b/src/main.sml
index 7403743..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 () => ())
@@ -643,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 =
@@ -729,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
@@ -977,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

diff --git a/src/msg.sml b/src/msg.sml
index a9063aa..f05d012 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -169,6 +169,7 @@ fun send (bio, m) =
       | MsgDbPasswd {dbtype, passwd} => (OpenSSL.writeInt (bio, 28);
                                         OpenSSL.writeString (bio, dbtype);
                                         OpenSSL.writeString (bio, passwd))
+      | MsgShutdown => OpenSSL.writeInt (bio, 29)
 
 fun checkIt v =
     case v of
@@ -263,6 +264,7 @@ fun recv bio =
                                (SOME dbtype, SOME passwd) =>
                                SOME (MsgDbPasswd {dbtype = dbtype, passwd = passwd})
                              | _ => NONE)
+                  | 29 => SOME MsgShutdown
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 445f8af..3003a39 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -81,5 +81,7 @@ datatype msg =
        (* One line of a response to MsgSmtpLogReq *)
        | MsgDbPasswd of {dbtype : string, passwd : string}
        (* Change a DBMS user's password *)
+       | MsgShutdown
+       (* Halt the server *)
 
 end