Generation of slash-tilde waklog directives for each user

[hcoop/domtool2.git] / src / plugins / apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index b34eb56..0b0b11d 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -68,13 +68,19 @@ val _ = Env.type_one "proxy_target"
                fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets
            in
                case String.fields (fn ch => ch = #":") s of
-                   ["http", "//localhost", rest] =>
-                   (case String.fields (fn ch => ch = #"/") rest of
-                        port :: _ =>
-                        (case Int.fromString port of
-                             NONE => default ()
-                           | SOME n => n > 1024 orelse default ())
-                      | _ => default ())
+                   "http" :: "//localhost" :: rest =>
+                   let
+                       val rest = String.concatWith ":" rest
+                   in
+                       CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
+                                                andalso ch <> #"\"" andalso ch <> #"'") rest
+                       andalso case String.fields (fn ch => ch = #"/") rest of
+                                   port :: _ =>
+                                   (case Int.fromString port of
+                                        NONE => default ()
+                                      | SOME n => n > 1024 orelse default ())
+                                 | _ => default ()
+                   end
                  | _ => default ()
            end)
 
@@ -237,10 +243,12 @@ val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
 
 val vhostsChanged = ref false
 val logDeleted = ref false
+val delayedLogMoves = ref (fn () => ())
 
 val () = Slave.registerPreHandler
             (fn () => (vhostsChanged := false;
-                       logDeleted := false))
+                       logDeleted := false;
+                       delayedLogMoves := (fn () => print "Executing delayed log moves/deletes.\n")))
 
 fun findVhostUser fname =
     let
@@ -333,18 +341,20 @@ val () = Slave.registerFileHandler (fn fs =>
                                                               Slave.Delete _ =>
                                                               let
                                                                   val ldir = realLogDir oldUser
+                                                                  val dlm = !delayedLogMoves
                                                               in
                                                                   if !logDeleted then
                                                                       ()
                                                                   else
-                                                                      (ignore (OS.Process.system (down ()));
+                                                                      ((*ignore (OS.Process.system (down ()));*)
                                                                        ignore (OS.Process.system (fixperms ()));
                                                                        logDeleted := true);
                                                                   ignore (OS.Process.system (Config.rm
                                                                                              ^ " -rf "
                                                                                              ^ realVhostFile));
-                                                                  Slave.moveDirCreate {from = ldir,
-                                                                                       to = backupLogs ()}
+                                                                  delayedLogMoves := (fn () => (dlm ();
+                                                                                                Slave.moveDirCreate {from = ldir,
+                                                                                                                     to = backupLogs ()}))
                                                               end
                                                             | Slave.Add =>
                                                               let
@@ -372,15 +382,18 @@ val () = Slave.registerFileHandler (fn fs =>
                                                                    let
                                                                        val old = realLogDir oldUser
                                                                        val rld = realLogDir user
+
+                                                                       val dlm = !delayedLogMoves
                                                                    in
                                                                        if !logDeleted then
                                                                            ()
                                                                        else
-                                                                           (ignore (OS.Process.system (down ()));
+                                                                           ((*ignore (OS.Process.system (down ()));*)
                                                                             logDeleted := true);
-                                                                       ignore (OS.Process.system (Config.rm
-                                                                                                  ^ " -rf "
-                                                                                                  ^ realLogDir oldUser));
+                                                                       delayedLogMoves := (fn () => (dlm ();
+                                                                                                     ignore (OS.Process.system (Config.rm
+                                                                                                                                ^ " -rf "
+                                                                                                                                ^ realLogDir oldUser))));
                                                                        if Posix.FileSys.access (rld, []) then
                                                                            ()
                                                                        else
@@ -397,8 +410,9 @@ val () = Slave.registerFileHandler (fn fs =>
 val () = Slave.registerPostHandler
         (fn () =>
             (if !vhostsChanged then
-                 Slave.shellF ([if !logDeleted then undown () else reload ()],
-                               fn cl => "Error reloading Apache with " ^ cl)
+                 (Slave.shellF ([reload ()],
+                             fn cl => "Error reloading Apache with " ^ cl);
+                  if !logDeleted then !delayedLogMoves () else ())
              else
                  ()))
 
@@ -505,6 +519,10 @@ fun vhostBody (env, makeFullHost) =
                                           TextIO.output (file, group))
                                      else
                                          (TextIO.output (file, "\n\tSuexecUserGroup ");
+                                          TextIO.output (file, user);
+                                          TextIO.output (file, " ");
+                                          TextIO.output (file, group);
+                                          TextIO.output (file, "\n\tsuPHP_UserGroup ");
                                           TextIO.output (file, user);
                                           TextIO.output (file, " ");
                                           TextIO.output (file, group))
@@ -580,6 +598,15 @@ val () = Env.container_one "directory"
                    inLocal := false;
                    localRewriteEnabled := false))
 
+val () = Env.container_one "filesMatch"
+        ("regexp", Env.string)
+        (fn prefix =>
+            (write "\t<FilesMatch \"";
+             write prefix;
+             write "\">\n"),
+         fn () => (write "\t</FilesMatch>\n";
+                   localRewriteEnabled := false))
+
 fun checkRewrite () =
     if !inLocal then
        if !localRewriteEnabled then
@@ -597,9 +624,9 @@ val () = Env.action_three "localProxyRewrite"
         ("from", Env.string, "to", Env.string, "port", Env.int)
         (fn (from, to, port) =>
             (checkRewrite ();
-             write "\tRewriteRule\t";
+             write "\tRewriteRule\t\"";
              write from;
-             write "\thttp://localhost:";
+             write "\"\thttp://localhost:";
              write (Int.toString port);
              write "/";
              write to;
@@ -627,10 +654,11 @@ val () = Env.action_three "rewriteRule"
         ("from", Env.string, "to", Env.string, "flags", Env.list flag)
         (fn (from, to, flags) =>
             (checkRewrite ();
-             write "\tRewriteRule\t";
+             write "\tRewriteRule\t\"";
              write from;
-             write "\t";
+             write "\"\t\"";
              write to;
+             write "\"";
              case flags of
                  [] => ()
                | flag::rest => (write " [";
@@ -644,10 +672,11 @@ val () = Env.action_three "rewriteCond"
         ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
         (fn (from, to, flags) =>
             (checkRewrite ();
-             write "\tRewriteCond\t";
+             write "\tRewriteCond\t\"";
              write from;
-             write "\t";
+             write "\"\t\"";
              write to;
+             write "\"";
              case flags of
                  [] => ()
                | flag::rest => (write " [";
@@ -661,9 +690,9 @@ val () = Env.action_one "rewriteBase"
         ("prefix", Env.string)
         (fn prefix =>
             (checkRewrite ();
-             write "\tRewriteBase\t";
+             write "\tRewriteBase\t\"";
              write prefix;
-             write "\n"))
+             write "\"\n"))
 
 val () = Env.action_one "rewriteLogLevel"
         ("level", Env.int)
@@ -1053,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, "<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