/etc/init.d script for domtool-server

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

diff --git a/src/main.sml b/src/main.sml
index f9b2c9f..cb39416 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -275,6 +275,30 @@ fun requestDir dname =
     end
     handle ErrorMsg.Error => ()
 
+fun requestPing () =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       OpenSSL.close bio;
+       OS.Process.success
+    end
+    handle _ => OS.Process.failure
+
+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 +425,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 () => ())
@@ -628,7 +667,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 =
@@ -714,6 +753,16 @@ fun service () =
                                MsgConfig code => doConfig [code]
                              | MsgMultiConfig codes => doConfig codes
 
+                             | MsgShutdown =>
+                               if Acl.query {user = user, class = "priv", value = "all"}
+                                  orelse Acl.query {user = user, class = "priv", value = "shutdown"} then
+                                   print ("Domtool dispatcher shutting down at " ^ Date.toString (Date.fromTimeUniv (Time.now ())) ^ "\n\n")
+                               else
+                                   (print "Unauthorized shutdown command!\n";
+                                    OpenSSL.close bio
+                                    handle OpenSSL.OpenSSL _ => ();
+                                    loop ())
+
                              | MsgGrant acl =>
                                doIt (fn () =>
                                         if Acl.query {user = user, class = "priv", value = "all"} then
@@ -805,6 +854,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
@@ -948,6 +1011,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