Generation of slash-tilde waklog directives for each user

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

diff --git a/src/main.sml b/src/main.sml
index 62af91b..ac9207d 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006-2007, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -251,21 +251,37 @@ fun requestSlaveBio' printErr =
 
 fun requestSlaveBio () = requestSlaveBio' true
 
-fun request fname =
+fun request (fname, libOpt) =
     let
-       val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
-
-       val inf = TextIO.openIn fname
+       val (user, bio) = requestBio (fn () =>
+                                        let
+                                            val env = basis ()
+                                            val env = case libOpt of
+                                                          NONE => env
+                                                        | SOME lib => #1 (check env lib)
+                                        in
+                                            ignore (check env fname)
+                                        end)
+
+       fun readFile fname =
+           let
+               val inf = TextIO.openIn fname
 
-       fun loop lines =
-           case TextIO.inputLine inf of
-               NONE => String.concat (List.rev lines)
-             | SOME line => loop (line :: lines)
+               fun loop lines =
+                   case TextIO.inputLine inf of
+                       NONE => String.concat (rev lines)
+                     | SOME line => loop (line :: lines)
+           in
+               loop []
+               before TextIO.closeIn inf
+           end
 
-       val code = loop []
+       val code = readFile fname
+       val msg = case libOpt of
+                     NONE => MsgConfig code
+                   | SOME fname' => MsgMultiConfig [readFile fname', code]
     in
-       TextIO.closeIn inf;
-       Msg.send (bio, MsgConfig code);
+       Msg.send (bio, msg);
        case Msg.recv bio of
            NONE => print "Server closed connection unexpectedly.\n"
          | SOME m =>
@@ -311,7 +327,7 @@ fun requestDir dname =
        val (_, files) = Order.order (SOME b) files
 
        val _ = if !ErrorMsg.anyErrors then
-                   (print "J\n";raise ErrorMsg.Error)
+                   raise ErrorMsg.Error
                else
                    ()
 
@@ -911,6 +927,21 @@ fun requestDescribe dom =
        OpenSSL.close bio
     end
 
+fun requestReUsers () =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgReUsers);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Callbacks run.\n"
+             | MsgError s => print ("Failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 structure SS = StringSet
 
 fun domainList dname =
@@ -1094,6 +1125,10 @@ val regenerateTc = regenerateEither true
                                    (fn G => fn evs => fn file =>
                                                          (#1 (check G file), evs))
 
+fun usersChanged () =
+    (Domain.onUsersChange ();
+     ignore (OS.Process.system Config.publish_reusers))
+
 fun rmuser user =
     let
        val doms = Acl.class {user = user, class = "domain"}
@@ -1103,7 +1138,8 @@ fun rmuser user =
                                     | _ => false) (StringSet.listItems doms)
     in
        Acl.rmuser user;
-       Domain.rmdom doms
+       Domain.rmdom doms;
+       usersChanged ()
     end
 
 fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
@@ -1249,6 +1285,10 @@ fun service () =
                                          if Acl.query {user = user, class = "priv", value = "all"} then
                                              (Acl.grant acl;
                                               Acl.write Config.aclFile;
+                                              if #class acl = "user" then
+                                                  usersChanged ()
+                                              else
+                                                  ();
                                               ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".",
                                                NONE))
                                          else
@@ -1539,14 +1579,15 @@ fun service () =
                                      (fn () => ())
 
                               | MsgMysqlFixperms =>
-                                doIt (fn () => if OS.Process.isSuccess
-                                                      (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
-                                                   ("Requested mysql-fixperms",
-                                                    NONE)
+                                (print "Starting mysql-fixperms\n";
+                                 doIt (fn () => if OS.Process.isSuccess
+                                                       (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
+                                                    ("Requested mysql-fixperms",
+                                                     NONE)
                                                 else
                                                     ("Requested mysql-fixperms, but execution failed!",
                                                      SOME "Script execution failed."))
-                                     (fn () => ())
+                                      (fn () => ()))
 
                               | MsgDescribe dom =>
                                 doIt (fn () => if not (Domain.validDomain dom) then
@@ -1562,6 +1603,11 @@ fun service () =
                                                      NONE)))
                                      (fn () => ())
 
+                              | MsgReUsers =>
+                                doIt (fn () => (usersChanged ();
+                                                ("Users change callbacks run", NONE)))
+                                     (fn () => ())
+
                               | _ =>
                                 doIt (fn () => ("Unexpected command",
                                                 SOME "Unexpected command"))