From: Adam Chlipala Date: Tue, 17 Feb 2009 16:30:21 +0000 (+0000) Subject: Generation of slash-tilde waklog directives for each user X-Git-Tag: release_2010-11-19~14 X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/563e77927eb5faaae4571bd2b0811de590368581 Generation of slash-tilde waklog directives for each user --- diff --git a/configDefault/apache.cfg b/configDefault/apache.cfg index a58359a..6a5dd65 100644 --- a/configDefault/apache.cfg +++ b/configDefault/apache.cfg @@ -59,4 +59,6 @@ fun backupLogDirOf version1 = val defaultPhpVersion = 4 +val waklogUserFile = "/var/domtool/waklog.conf" + end diff --git a/configDefault/apache.csg b/configDefault/apache.csg index e4c9e70..9d47866 100644 --- a/configDefault/apache.csg +++ b/configDefault/apache.csg @@ -26,4 +26,6 @@ signature APACHE_CONFIG = sig val defaultPhpVersion : int + val waklogUserFile : string + end diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index 2ccca1a..906d7f4 100644 --- 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"] + +val publish_reusers = "/usr/bin/sudo " ^ domtool_publish ^ " users" diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs index a8b04ee..a1c755a 100644 --- 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 publish_reusers : string diff --git a/scripts/domtool-publish b/scripts/domtool-publish index 9a7574d..f11bc4c 100755 --- 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 ;; + 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 diff --git a/src/domain.sig b/src/domain.sig index 9364238..8d10fe0 100644 --- 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. *) + + (* Callbacks to run whenever the set of Domtool users has changed *) + val registerOnUsersChange : (unit -> unit) -> unit + val onUsersChange : unit -> unit end diff --git a/src/domain.sml b/src/domain.sml index 700fac1..63b039c 100644 --- 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)) +val ouc = ref (fn () => ()) + +fun registerOnUsersChange f = + let + val f' = !ouc + in + ouc := (fn () => (f' (); f ())) + end + +fun onUsersChange () = !ouc () + end diff --git a/src/main-admin.sml b/src/main-admin.sml index 183db60..2353617 100644 --- 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 ())) + | ["reusers"] => Main.requestReUsers () | _ => (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 --- 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 requestReUsers : 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 --- 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")) diff --git a/src/msg.sml b/src/msg.sml index 5eacaa2..3e028c1 100644 --- 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)) + | MsgReUsers => OpenSSL.writeInt (bio, 41) 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) + | 41 => SOME MsgReUsers | _ => NONE) end diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 1fd2411..ea3ea2c 100644 --- 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 *) + | MsgReUsers + (* Rerun all callbacks for cases where the set of users has changed *) end diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index d97ac8b..0b0b11d 100644 --- 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") +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, "\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\n\n"))) users; + TextIO.closeOut outf + end + +val () = Domain.registerOnUsersChange writeWaklogUserFile + end