Generation of slash-tilde waklog directives for each user

diff --git a/configDefault/apache.cfg b/configDefault/apache.cfg
index a58359a..6a5dd65 100644 (file)
--- a/configDefault/apache.cfg
+++ b/configDefault/apache.cfg
@@ -59,4 +59,6 @@ fun backupLogDirOf version1 =
 
 val defaultPhpVersion = 4
 
 
 val defaultPhpVersion = 4
 

+val waklogUserFile = "/var/domtool/waklog.conf"
+

 end
 end

diff --git a/configDefault/apache.csg b/configDefault/apache.csg
index e4c9e70..9d47866 100644 (file)
--- a/configDefault/apache.csg
+++ b/configDefault/apache.csg
@@ -26,4 +26,6 @@ signature APACHE_CONFIG = sig
 
     val defaultPhpVersion : int
 
 
     val defaultPhpVersion : int
 

+    val waklogUserFile : string
+

 end
 end

diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg
index 2ccca1a..906d7f4 100644 (file)
--- a/configDefault/domtool.cfg
+++ b/configDefault/domtool.cfg
@@ -59,3 +59,5 @@ fun domtoolDir user =
                                  file = ".domtool"}
 
 val worldReadable = ["/usr/share/moin", "/usr/share/apache/icons"]
                                  file = ".domtool"}
 
 val worldReadable = ["/usr/share/moin", "/usr/share/apache/icons"]

+
+val publish_reusers = "/usr/bin/sudo " ^ domtool_publish ^ " users"

diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs
index a8b04ee..a1c755a 100644 (file)
--- a/configDefault/domtool.cfs
+++ b/configDefault/domtool.cfs
@@ -66,3 +66,5 @@ val mailNodes_admin : string list
 val domtoolDir : string -> string
 
 val worldReadable : string list
 val domtoolDir : string -> string
 
 val worldReadable : string list

+
+val publish_reusers : string

diff --git a/scripts/domtool-publish b/scripts/domtool-publish
index 9a7574d..f11bc4c 100755 (executable)
--- a/scripts/domtool-publish
+++ b/scripts/domtool-publish
@@ -74,7 +74,11 @@ case $1 in
         apache1.3-fixperms)
                 /bin/chown -R domtool.domtool /var/log/apache/user
         ;;
         apache1.3-fixperms)
                 /bin/chown -R domtool.domtool /var/log/apache/user
         ;;

+        users)
+                /bin/cp /var/domtool/waklog.conf /etc/apache2/
+               /etc/init.d/apache2 reload
+        ;;

        *)
        *)

-               echo "Usage: domtool-publish [apache|bind|courier|exim|mailman|smtplog STRING]"
+               echo "Usage: domtool-publish [apache|bind|courier|exim|mailman|smtplog STRING|users]"

        ;;
 esac
        ;;
 esac

diff --git a/src/domain.sig b/src/domain.sig
index 9364238..8d10fe0 100644 (file)
--- a/src/domain.sig
+++ b/src/domain.sig
@@ -115,4 +115,8 @@ signature DOMAIN = sig
     val considerAll : description list -> subject -> string
     (* Find files in a domain directory matching some patterns and generate
      * headings and contents listings for them. *)
     val considerAll : description list -> subject -> string
     (* Find files in a domain directory matching some patterns and generate
      * headings and contents listings for them. *)

+
+    (* Callbacks to run whenever the set of Domtool users has changed *)
+    val registerOnUsersChange : (unit -> unit) -> unit
+    val onUsersChange : unit -> unit

 end
 end

diff --git a/src/domain.sml b/src/domain.sml
index 700fac1..63b039c 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -989,4 +989,15 @@ val () = Env.registerAction ("domainHost",
                                           (EString (host ^ "." ^ currentDomain ()), dl))
                              | (_, args) => Env.badArgs ("domainHost", args))
 
                                           (EString (host ^ "." ^ currentDomain ()), dl))
                              | (_, args) => Env.badArgs ("domainHost", args))
 

+val ouc = ref (fn () => ())
+
+fun registerOnUsersChange f =
+    let
+       val f' = !ouc
+    in
+       ouc := (fn () => (f' (); f ()))
+    end
+
+fun onUsersChange () = !ouc ()
+

 end
 end

diff --git a/src/main-admin.sml b/src/main-admin.sml
index 183db60..2353617 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -59,6 +59,7 @@ val _ =
        | ["users"] =>
         (Acl.read Config.aclFile;
          app (fn s => (print s; print "\n")) (Acl.users ()))
        | ["users"] =>
         (Acl.read Config.aclFile;
          app (fn s => (print s; print "\n")) (Acl.users ()))

+       | ["reusers"] => Main.requestReUsers ()

                      
        | _ => (print "Invalid command-line arguments\n";
               print "See the documentation: http://wiki.hcoop.net/DomTool/AdminProcedures\n"))
                      
        | _ => (print "Invalid command-line arguments\n";
               print "See the documentation: http://wiki.hcoop.net/DomTool/AdminProcedures\n"))

diff --git a/src/main.sig b/src/main.sig
index ee637e4..db7ab02 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -46,6 +46,7 @@ signature MAIN = sig
     val requestRegenTc : unit -> unit
     val requestRmuser : string -> unit
     val requestDescribe : string -> unit
     val requestRegenTc : unit -> unit
     val requestRmuser : string -> unit
     val requestDescribe : string -> unit

+    val requestReUsers : unit -> unit

 
     val requestSlavePing : unit -> OS.Process.status
     val requestSlaveShutdown : unit -> unit
 
     val requestSlavePing : unit -> OS.Process.status
     val requestSlaveShutdown : unit -> unit

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/)
 (* 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
  *
  * 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
        val (_, files) = Order.order (SOME b) files
 
        val _ = if !ErrorMsg.anyErrors then

-                   (print "J\n";raise ErrorMsg.Error)
+                   raise ErrorMsg.Error

                else
                    ()
 
                else
                    ()
 


@@ -927,6 +927,21 @@ fun requestDescribe dom =
        OpenSSL.close bio
     end
 
        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 =
 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))
 
                                    (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"}
 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;
                                     | _ => false) (StringSet.listItems doms)
     in
        Acl.rmuser user;

-       Domain.rmdom doms
+       Domain.rmdom doms;
+       usersChanged ()

     end
 
 fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
     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 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
                                               ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".",
                                                NONE))
                                          else


@@ -1579,6 +1603,11 @@ fun service () =
                                                      NONE)))
                                      (fn () => ())
 
                                                      NONE)))
                                      (fn () => ())
 

+                              | MsgReUsers =>
+                                doIt (fn () => (usersChanged ();
+                                                ("Users change callbacks run", NONE)))
+                                     (fn () => ())
+

                               | _ =>
                                 doIt (fn () => ("Unexpected command",
                                                 SOME "Unexpected command"))
                               | _ =>
                                 doIt (fn () => ("Unexpected command",
                                                 SOME "Unexpected command"))

diff --git a/src/msg.sml b/src/msg.sml
index 5eacaa2..3e028c1 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -236,6 +236,7 @@ fun send (bio, m) =
                            OpenSSL.writeString (bio, dom))
       | MsgDescription s => (OpenSSL.writeInt (bio, 40);
                             OpenSSL.writeString (bio, s))
                            OpenSSL.writeString (bio, dom))
       | MsgDescription s => (OpenSSL.writeInt (bio, 40);
                             OpenSSL.writeString (bio, s))

+      | MsgReUsers => OpenSSL.writeInt (bio, 41)

 
 fun checkIt v =
     case v of
 
 fun checkIt v =
     case v of


@@ -348,6 +349,7 @@ fun recv bio =
                   | 38 => SOME MsgMysqlFixperms
                   | 39 => Option.map MsgDescribe (OpenSSL.readString bio)
                   | 40 => Option.map MsgDescription (OpenSSL.readString bio)
                   | 38 => SOME MsgMysqlFixperms
                   | 39 => Option.map MsgDescribe (OpenSSL.readString bio)
                   | 40 => Option.map MsgDescription (OpenSSL.readString bio)

+                  | 41 => SOME MsgReUsers

                   | _ => NONE)
         
 end
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 1fd2411..ea3ea2c 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -124,5 +124,7 @@ datatype msg =
        (* Ask for a listing of all of a domain's real configuration *)
        | MsgDescription of string
        (* Reply to MsgDescribe *)
        (* Ask for a listing of all of a domain's real configuration *)
        | MsgDescription of string
        (* Reply to MsgDescribe *)

+       | MsgReUsers
+       (* Rerun all callbacks for cases where the set of users has changed *)

 
 end
 
 end

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index d97ac8b..0b0b11d 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -1082,4 +1082,24 @@ val () = Domain.registerDescriber (Domain.considerAll
 val () = Env.action_none "testNoHtaccess"
         (fn path => write "\tAllowOverride None\n")
 
 val () = Env.action_none "testNoHtaccess"
         (fn path => write "\tAllowOverride None\n")
 

+fun writeWaklogUserFile () =
+    let
+       val users = Acl.users ()
+       val outf = TextIO.openOut Config.Apache.waklogUserFile
+    in
+       app (fn user => if String.isSuffix "_admin" user then
+                           ()
+                       else
+                           (TextIO.output (outf, "<Location /~");
+                            TextIO.output (outf, user);
+                            TextIO.output (outf, ">\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
+                            TextIO.output (outf, user);
+                            TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
+                            TextIO.output (outf, user);
+                            TextIO.output (outf, "\n</Location>\n\n"))) users;
+       TextIO.closeOut outf
+    end
+
+val () = Domain.registerOnUsersChange writeWaklogUserFile
+

 end
 end