Server executing client's requested configuration with the right permissions

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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 1f61476..13062a2 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -61,29 +61,29 @@ val _ = Env.type_one "location"
 
 val dl = ErrorMsg.dummyLoc
 
-val _ = Main.registerDefault ("WebNodes",
-                             (TList (TBase "node", dl), dl),
-                             (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
+val _ = Defaults.registerDefault ("WebNodes",
+                                 (TList (TBase "node", dl), dl),
+                                 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
 
-val _ = Main.registerDefault ("SSL",
-                             (TBase "bool", dl),
-                             (fn () => (EVar "false", dl)))
+val _ = Defaults.registerDefault ("SSL",
+                                 (TBase "bool", dl),
+                                 (fn () => (EVar "false", dl)))
 
-val _ = Main.registerDefault ("User",
-                             (TBase "your_user", dl),
-                             (fn () => (EString (Domain.getUser ()), dl)))
+val _ = Defaults.registerDefault ("User",
+                                 (TBase "your_user", dl),
+                                 (fn () => (EString (Domain.getUser ()), dl)))
 
-val _ = Main.registerDefault ("Group",
-                             (TBase "your_group", dl),
-                             (fn () => (EString (Domain.getUser ()), dl)))
+val _ = Defaults.registerDefault ("Group",
+                                 (TBase "your_group", dl),
+                                 (fn () => (EString (Domain.getUser ()), dl)))
 
-val _ = Main.registerDefault ("DocumentRoot",
-                             (TBase "your_path", dl),
-                             (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl)))
+val _ = Defaults.registerDefault ("DocumentRoot",
+                                 (TBase "your_path", dl),
+                                 (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl)))
 
-val _ = Main.registerDefault ("ServerAdmin",
-                             (TBase "email", dl),
-                             (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
+val _ = Defaults.registerDefault ("ServerAdmin",
+                                 (TBase "email", dl),
+                                 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
@@ -182,11 +182,18 @@ val () = Slave.registerFileHandler (fn fs =>
                                               (vhostsChanged := true;
                                                case #action fs of
                                                    Slave.Delete =>
-                                                   ignore (OS.Process.system (Config.rm
-                                                                              ^ " -rf "
-                                                                              ^ Config.Apache.confDir
-                                                                              ^ "/"
-                                                                              ^ #file spl))
+                                                   (ignore (OS.Process.system (Config.rm
+                                                                               ^ " -rf "
+                                                                               ^ Config.Apache.confDir
+                                                                               ^ "/"
+                                                                               ^ #file spl));
+                                                    ignore (OS.Process.system (Config.rm
+                                                                               ^ " -rf "
+                                                                               ^ Config.Apache.logDir
+                                                                               ^ "/"
+                                                                               ^ #base (OS.Path.splitBaseExt 
+                                                                                            (#file spl)))))
+                                                           
                                                  | _ =>
                                                    ignore (OS.Process.system (Config.cp
                                                                               ^ " "
@@ -214,6 +221,30 @@ val rewriteEnabled = ref false
 val currentVhost = ref ""
 val currentVhostId = ref ""
 
+val pre = ref (fn _ : {nodes : string list, id : string, hostname : string} => ())
+fun registerPre f =
+    let
+       val old = !pre
+    in
+       pre := (fn x => (old x; f x))
+    end
+
+val post = ref (fn () => ())
+fun registerPost f =
+    let
+       val old = !post
+    in
+       post := (fn () => (old (); f ()))
+    end
+
+val aliaser = ref (fn _ : string => ())
+fun registerAliaser f =
+    let
+       val old = !aliaser
+    in
+       aliaser := (fn x => (old x; f x))
+    end
+
 val () = Env.containerV_one "vhost"
         ("host", Env.string)
         (fn (env, host) =>
@@ -268,9 +299,11 @@ val () = Env.containerV_one "vhost"
                 write Config.Apache.logDir;
                 write "/";
                 write vhostId;
-                write "/access.log combined\n"
+                write "/access.log combined\n";
+                !pre {nodes = nodes, id = vhostId, hostname = fullHost}
             end,
-         fn () => (write "</VirtualHost>\n";
+         fn () => (!post ();
+                   write "</VirtualHost>\n";
                    app TextIO.closeOut (!vhostFiles)))
 
 val () = Env.container_one "location"
@@ -438,7 +471,8 @@ val () = Env.action_one "serverAlias"
         (fn host =>
             (write "\tServerAlias ";
              write host;
-             write "\n"))
+             write "\n";
+             !aliaser host))
 
 val authType = fn (EVar "basic", _) => SOME "basic"
                | (EVar "digest", _) => SOME "digest"