X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/7e197d72e7a51507611aa37e9d05bb135172ceb3..9f27d58f1ce0833bb5460d7ca612c74f378548a1:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 7403743..8bb2d4e 100644
--- 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