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 9b9d296..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
@@ -327,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
                    ()
 
@@ -927,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 =
@@ -1110,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"}
@@ -1119,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 ()))
@@ -1265,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
@@ -1579,6 +1603,11 @@ fun service () =
                                                      NONE)))
                                      (fn () => ())
 
+                              | MsgReUsers =>
+                                doIt (fn () => (usersChanged ();
+                                                ("Users change callbacks run", NONE)))
+                                     (fn () => ())
+
                               | _ =>
                                 doIt (fn () => ("Unexpected command",
                                                 SOME "Unexpected command"))