Fix file paths for recursive rmdom

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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 6c04738..65ba7fb 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -22,6 +22,17 @@ structure Apache :> APACHE = struct
 
 open Ast
 
+val _ = Env.type_one "web_node"
+       Env.string
+       (fn node =>
+           List.exists (fn x => x = node) Config.Apache.webNodes_all
+           orelse (Domain.hasPriv "www"
+                   andalso List.exists (fn x => x = node) Config.Apache.webNodes_admin))
+
+val _ = Env.registerFunction ("web_node_to_node",
+                             fn [e] => SOME e
+                              | _ => NONE)
+
 val _ = Env.type_one "proxy_port"
        Env.int
        (fn n => n > 1024)
@@ -62,8 +73,8 @@ val _ = Env.type_one "location"
 val dl = ErrorMsg.dummyLoc
 
 val _ = Defaults.registerDefault ("WebNodes",
-                                 (TList (TBase "node", dl), dl),
-                                 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
+                                 (TList (TBase "web_node", dl), dl),
+                                 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
 
 val _ = Defaults.registerDefault ("SSL",
                                  (TBase "bool", dl),
@@ -169,9 +180,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
@@ -223,7 +236,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
@@ -235,7 +253,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
@@ -251,7 +272,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
                  ()))
@@ -261,6 +282,7 @@ fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFile
 fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
 
 val rewriteEnabled = ref false
+val localRewriteEnabled = ref false
 val currentVhost = ref ""
 val currentVhostId = ref ""
 
@@ -308,6 +330,7 @@ val () = Env.containerV_one "vhost"
                 currentVhostId := vhostId;
 
                 rewriteEnabled := false;
+                localRewriteEnabled := false;
                 vhostFiles := map (fn node =>
                                       let
                                           val file = Domain.domainFile {node = node,
@@ -359,24 +382,38 @@ val () = Env.containerV_one "vhost"
                    write "</VirtualHost>\n";
                    app (TextIO.closeOut o #2) (!vhostFiles)))
 
+val inLocal = ref false
+
 val () = Env.container_one "location"
         ("prefix", Env.string)
         (fn prefix =>
             (write "\t<Location ";
              write prefix;
-             write ">\n"),
-         fn () => write "\t</Location>\n")
+             write ">\n";
+             inLocal := true),
+         fn () => (write "\t</Location>\n";
+                   inLocal := false;
+                   localRewriteEnabled := false))
 
 val () = Env.container_one "directory"
         ("directory", Env.string)
         (fn directory =>
             (write "\t<Directory ";
              write directory;
-             write ">\n"),
-         fn () => write "\t</Directory>\n")
+             write ">\n";
+             inLocal := true),
+         fn () => (write "\t</Directory>\n";
+                   inLocal := false;
+                   localRewriteEnabled := false))
 
 fun checkRewrite () =
-    if !rewriteEnabled then
+    if !inLocal then
+       if !rewriteEnabled orelse !localRewriteEnabled then
+           ()
+       else
+           (write "\tRewriteEngine on\n";
+            localRewriteEnabled := true)
+    else if !rewriteEnabled then
        ()
     else
        (write "\tRewriteEngine on\n";
@@ -630,7 +667,7 @@ val () = Env.action_one "addDefaultCharset"
                    write ty;
                    write "\n"))
 
-val () = Env.action_one "davSvn"
+(*val () = Env.action_one "davSvn"
         ("path", Env.string)
         (fn path => (write "\tDAV svn\n\tSVNPath ";
                      write path;
@@ -640,7 +677,7 @@ val () = Env.action_one "authzSvnAccessFile"
         ("path", Env.string)
         (fn path => (write "\tAuthzSVNAccessFile ";
                      write path;
-                     write "\n"))
+                     write "\n"))*)
 
 val () = Env.action_two "addDescription"
         ("description", Env.string, "patterns", Env.list Env.string)
@@ -702,4 +739,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