X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/1638d5a206cd79e9619f0d3334fed29eaddc6b51..128e7b0b302e295411797f2465c508013bce4430:/src/plugins/apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 765d696..2d42a98 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -22,17 +22,41 @@ structure Apache :> APACHE = struct
 
 open Ast
 
+val dl = ErrorMsg.dummyLoc
+
+fun webNode 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.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))
+	webNode
 
 val _ = Env.registerFunction ("web_node_to_node",
 			      fn [e] => SOME e
 			       | _ => NONE)
 
+fun webPlace (EApp ((EString "web_place_default", _), (EString node, _)), _) =
+    SOME (node, Domain.nodeIp node)
+  | webPlace (EApp ((EApp ((EString "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
+    SOME (node, ip)
+  | webPlace _ = NONE
+
+fun webPlaceDefault node = (EApp ((EString "web_place_default", dl), (EString node, dl)), dl)
+
+val _ = Env.registerFunction ("web_place_to_web_node",
+			      fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+			       | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_node",
+			      fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+			       | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_ip",
+			      fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (webPlace e)
+			       | _ => NONE)
+
 val _ = Env.type_one "proxy_port"
 	Env.int
 	(fn n => n > 1024)
@@ -87,11 +111,9 @@ fun ssl e = case e of
 	      | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
 	      | _ => NONE
 
-val dl = ErrorMsg.dummyLoc
-
-val defaults = [("WebNodes",
-		 (TList (TBase "web_node", dl), dl),
-		 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))),
+val defaults = [("WebPlaces",
+		 (TList (TBase "web_place", dl), dl),
+		 (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
 		("SSL",
 		 (TBase "ssl", dl),
 		 (fn () => (EVar "no_ssl", dl))),
@@ -256,7 +278,9 @@ val () = Slave.registerFileHandler (fn fs =>
 									    file = #file spl}
 
 						   val user = findVhostUser (#file fs)
-						   val oldUser = findVhostUser realVhostFile
+						   val oldUser = case #action fs of
+								     Slave.Delete false => user
+								   | _ => findVhostUser realVhostFile
 					       in
 						   if (oldUser = NONE andalso #action fs <> Slave.Add)
 						      orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
@@ -379,6 +403,9 @@ fun registerPost f =
 	post := (fn () => (old (); f ()))
     end
 
+fun doPre x = !pre x
+fun doPost () = !post ()
+
 val aliaser = ref (fn _ : string => ())
 fun registerAliaser f =
     let
@@ -391,7 +418,7 @@ val () = Env.containerV_one "vhost"
 	 ("host", Env.string)
 	 (fn (env, host) =>
 	     let
-		 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
+		 val places = Env.env (Env.list webPlace) (env, "WebPlaces")
 
 		 val ssl = Env.env ssl (env, "SSL")
 		 val user = Env.env Env.string (env, "User")
@@ -410,7 +437,7 @@ val () = Env.containerV_one "vhost"
 
 		 rewriteEnabled := false;
 		 localRewriteEnabled := false;
-		 vhostFiles := map (fn node =>
+		 vhostFiles := map (fn (node, ip) =>
 				       let
 					   val file = Domain.domainFile {node = node,
 									 name = confFile}
@@ -420,7 +447,7 @@ val () = Env.containerV_one "vhost"
 					   TextIO.output (file, "# Owner: ");
 					   TextIO.output (file, user);
 					   TextIO.output (file, "\n<VirtualHost ");
-					   TextIO.output (file, Domain.nodeIp node);
+					   TextIO.output (file, ip);
 					   TextIO.output (file, ":");
 					   TextIO.output (file, case ssl of
 								    SOME _ => "443"
@@ -468,7 +495,7 @@ val () = Env.containerV_one "vhost"
 
 					   (ld, file)
 				       end)
-				   nodes;
+				   places;
 		 write "\n\tDocumentRoot ";
 		 write docroot;
 		 write "\n\tServerAdmin ";
@@ -479,7 +506,7 @@ val () = Env.containerV_one "vhost"
 		      write cert)
 		   | NONE => ();
 		 write "\n";
-		 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
+		 !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
 		 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
 	     end,
 	  fn () => (!post ();