X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/64e85bae9da8de223cef4e12a7e659f6d7938638..00a13ad8579e0ee0d950d3b944429551de3bf532:/src/plugins/apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 6970a86..3d7c199 100644
--- 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)
@@ -47,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
@@ -62,8 +77,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),
@@ -85,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"
@@ -169,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
@@ -181,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
@@ -223,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
@@ -235,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
@@ -251,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
 		  ()))
@@ -261,6 +293,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 ""
 
@@ -288,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) =>
@@ -299,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 "")
@@ -308,12 +345,15 @@ val () = Env.containerV_one "vhost"
 		 currentVhostId := vhostId;
 
 		 rewriteEnabled := false;
+		 localRewriteEnabled := false;
 		 vhostFiles := map (fn node =>
 				       let
 					   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
@@ -344,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 ";
@@ -359,24 +402,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";
@@ -702,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