Allow vetoing of suexec

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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 91209af..3d7c199 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -58,6 +58,10 @@ val _ = Env.type_one "rewrite_arg"
        Env.string
        (CharVector.all Char.isAlphaNum)
 
+val _ = Env.type_one "suexec_flag"
+       Env.bool
+       (fn b => b orelse Domain.hasPriv "www")
+
 fun validLocation s =
     size s > 0 andalso size s < 1000 andalso CharVector.all
                                                 (fn ch => Char.isAlphaNum ch
@@ -96,6 +100,10 @@ val _ = Defaults.registerDefault ("ServerAdmin",
                                  (TBase "email", dl),
                                  (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 
+val _ = Defaults.registerDefault ("SuExec",
+                                 (TBase "suexec_flag", dl),
+                                 (fn () => (EApp ((EVar "suexec_flag", dl),
+                                                  (EVar "true", dl)), dl)))
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "permanent", _) => SOME "permanent"
@@ -180,9 +188,11 @@ val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
                        | _ => NONE
 
 val vhostsChanged = ref false
+val logDeleted = ref false
 
 val () = Slave.registerPreHandler
-            (fn () => vhostsChanged := false)
+            (fn () => (vhostsChanged := false;
+                       logDeleted := false))
 
 fun findVhostUser fname =
     let
@@ -192,9 +202,12 @@ fun findVhostUser fname =
            case TextIO.inputLine inf of
                NONE => NONE
              | SOME line =>
-               case String.tokens Char.isSpace line of
-                   ["SuexecUserGroup", user, _] => SOME user
-                 | _ => loop ()
+               if String.isPrefix "# Owner: " line then
+                   case String.tokens Char.isSpace line of
+                       [_, _, user] => SOME user
+                     | _ => NONE
+               else
+                   loop ()
     in
        loop ()
        before TextIO.closeIn inf
@@ -234,7 +247,12 @@ val () = Slave.registerFileHandler (fn fs =>
                                                       vhostsChanged := true;
                                                       case #action fs of
                                                           Slave.Delete =>
-                                                          (ignore (OS.Process.system (Config.rm
+                                                          (if !logDeleted then
+                                                               ()
+                                                           else
+                                                               (ignore (OS.Process.system Config.Apache.down);
+                                                                logDeleted := true);
+                                                           ignore (OS.Process.system (Config.rm
                                                                                       ^ " -rf "
                                                                                       ^ realVhostFile));
                                                            ignore (OS.Process.system (Config.rm
@@ -246,7 +264,10 @@ val () = Slave.registerFileHandler (fn fs =>
                                                                                       ^ #file fs
                                                                                       ^ " "
                                                                                       ^ realVhostFile));
-                                                           OS.FileSys.mkDir realLogDir)
+                                                           if Posix.FileSys.access (realLogDir, []) then
+                                                               ()
+                                                           else
+                                                               OS.FileSys.mkDir realLogDir)
                                                           
                                                         | _ =>
                                                           ignore (OS.Process.system (Config.cp
@@ -262,7 +283,7 @@ val () = Slave.registerFileHandler (fn fs =>
 val () = Slave.registerPostHandler
         (fn () =>
             (if !vhostsChanged then
-                 Slave.shellF ([Config.Apache.reload],
+                 Slave.shellF ([if !logDeleted then Config.Apache.undown else Config.Apache.reload],
                                fn cl => "Error reloading Apache with " ^ cl)
              else
                  ()))
@@ -300,6 +321,9 @@ fun registerAliaser f =
        aliaser := (fn x => (old x; f x))
     end
 
+fun suexec_flag (EApp ((EVar "suexec_flag", _), e), _) = Env.bool e
+  | suexec_flag _ = NONE
+
 val () = Env.containerV_one "vhost"
         ("host", Env.string)
         (fn (env, host) =>
@@ -311,6 +335,7 @@ val () = Env.containerV_one "vhost"
                 val group = Env.env Env.string (env, "Group")
                 val docroot = Env.env Env.string (env, "DocumentRoot")
                 val sadmin = Env.env Env.string (env, "ServerAdmin")
+                val suexec = Env.env suexec_flag (env, "SuExec")
 
                 val fullHost = host ^ "." ^ Domain.currentDomain ()
                 val vhostId = fullHost ^ (if ssl then ".ssl" else "")
@@ -326,7 +351,9 @@ val () = Env.containerV_one "vhost"
                                           val file = Domain.domainFile {node = node,
                                                                         name = confFile}
                                       in
-                                          TextIO.output (file, "<VirtualHost ");
+                                          TextIO.output (file, "# Owner: ");
+                                          TextIO.output (file, user);
+                                          TextIO.output (file, "\n<VirtualHost ");
                                           TextIO.output (file, Domain.nodeIp node);
                                           TextIO.output (file, ":");
                                           TextIO.output (file, if ssl then
@@ -357,10 +384,13 @@ val () = Env.containerV_one "vhost"
                                   nodes;
                 write "\tServerName ";
                 write fullHost;
-                write "\n\tSuexecUserGroup ";
-                write user;
-                write " ";
-                write group;
+                if suexec then
+                    (write "\n\tSuexecUserGroup ";
+                     write user;
+                     write " ";
+                     write group)
+                else
+                    ();
                 write "\n\tDocumentRoot ";
                 write docroot;
                 write "\n\tServerAdmin ";
@@ -729,4 +759,7 @@ val () = Env.action_one "readmeName"
                      write name;
                      write "\n"))
 
+val () = Domain.registerResetLocal (fn () =>
+                                      ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+
 end