X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/aa56e112996b3650e8ac343831322d2a9ab0de54..de7fde3da2abb20767042276f24aae79c5925f95:/src/plugins/apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 13062a2..6c04738 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -79,7 +79,7 @@ val _ = Defaults.registerDefault ("Group",
 
 val _ = Defaults.registerDefault ("DocumentRoot",
 				  (TBase "your_path", dl),
-				  (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl)))
+				  (fn () => (EString (Config.homeBase ^ "/" ^ Domain.getUser () ^ "/" ^ Config.Apache.public_html), dl)))
 
 val _ = Defaults.registerDefault ("ServerAdmin",
 				  (TBase "email", dl),
@@ -173,35 +173,77 @@ val vhostsChanged = ref false
 val () = Slave.registerPreHandler
 	     (fn () => vhostsChanged := false)
 
+fun findVhostUser fname =
+    let
+	val inf = TextIO.openIn fname
+
+	fun loop () =
+	    case TextIO.inputLine inf of
+		NONE => NONE
+	      | SOME line =>
+		case String.tokens Char.isSpace line of
+		    ["SuexecUserGroup", user, _] => SOME user
+		  | _ => loop ()
+    in
+	loop ()
+	before TextIO.closeIn inf
+    end
+
 val () = Slave.registerFileHandler (fn fs =>
 				       let
 					   val spl = OS.Path.splitDirFile (#file fs)
 				       in
 					   if String.isSuffix ".vhost" (#file spl)
 					      orelse String.isSuffix ".vhost_ssl" (#file spl) then
-					       (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.logDir
-										^ "/"
-										^ #base (OS.Path.splitBaseExt 
-											     (#file spl)))))
-							    
-						  | _ =>
-						    ignore (OS.Process.system (Config.cp
-									       ^ " "
-									       ^ #file fs
-									       ^ " "
-									       ^ Config.Apache.confDir
-									       ^ "/"
-									       ^ #file spl)))
+					       case findVhostUser (#file fs) of
+						   NONE => print ("Can't find user in " ^ #file fs ^ "!  Taking no action.\n")
+						 | SOME user =>
+						   let
+						       val realVhostFile = OS.Path.joinDirFile
+									       {dir = Config.Apache.confDir,
+										file = #file spl}
+
+						       val realLogDir = OS.Path.joinDirFile
+									    {dir = Config.homeBase,
+									     file = user}
+						       val realLogDir = OS.Path.joinDirFile
+									    {dir = realLogDir,
+									     file = "apache"}
+						       val realLogDir = OS.Path.joinDirFile
+									    {dir = realLogDir,
+									     file = "log"}
+						       val realLogDir = OS.Path.joinDirFile
+									    {dir = realLogDir,
+									     file = Slave.hostname ()}
+						       val {base, ...} = OS.Path.splitBaseExt (#file spl)
+						       val realLogDir = OS.Path.joinDirFile
+									    {dir = realLogDir,
+									     file = base}
+						   in
+						       vhostsChanged := true;
+						       case #action fs of
+							   Slave.Delete =>
+							   (ignore (OS.Process.system (Config.rm
+										       ^ " -rf "
+										       ^ realVhostFile));
+							    ignore (OS.Process.system (Config.rm
+										       ^ " -rf "
+										       ^ realLogDir)))
+							 | Slave.Add =>
+							   (ignore (OS.Process.system (Config.cp
+										       ^ " "
+										       ^ #file fs
+										       ^ " "
+										       ^ realVhostFile));
+							    OS.FileSys.mkDir realLogDir)
+							   
+							 | _ =>
+							   ignore (OS.Process.system (Config.cp
+										      ^ " "
+										      ^ #file fs
+										      ^ " "
+										      ^ realVhostFile))
+						   end
 					   else
 					       ()
 				       end)
@@ -214,14 +256,15 @@ val () = Slave.registerPostHandler
 	      else
 		  ()))
 
-val vhostFiles : TextIO.outstream list ref = ref []
-fun write s = app (fn file => TextIO.output (file, s)) (!vhostFiles)
+val vhostFiles : (string * TextIO.outstream) list ref = ref []
+fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
+fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
 
 val rewriteEnabled = ref false
 val currentVhost = ref ""
 val currentVhostId = ref ""
 
-val pre = ref (fn _ : {nodes : string list, id : string, hostname : string} => ())
+val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
 fun registerPre f =
     let
 	val old = !pre
@@ -278,7 +321,25 @@ val () = Env.containerV_one "vhost"
 								else
 								    "80");
 					   TextIO.output (file, ">\n");
-					   file
+					   TextIO.output (file, "\tErrorLog ");
+					   TextIO.output (file, Config.homeBase);
+					   TextIO.output (file, "/");
+					   TextIO.output (file, user);
+					   TextIO.output (file, "/apache/log/");
+					   TextIO.output (file, node);
+					   TextIO.output (file, "/");
+					   TextIO.output (file, vhostId);
+					   TextIO.output (file, "/error.log\n\tCustomLog ");
+					   TextIO.output (file, Config.homeBase);
+					   TextIO.output (file, "/");
+					   TextIO.output (file, user);
+					   TextIO.output (file, "/apache/log/");
+					   TextIO.output (file, node);
+					   TextIO.output (file, "/");
+					   TextIO.output (file, vhostId);
+					   TextIO.output (file, "/access.log combined\n");
+					   (Config.homeBase ^ "/" ^ user ^ "/apache/log/"
+					    ^ node ^ "/" ^ vhostId, file)
 				       end)
 				   nodes;
 		 write "\tServerName ";
@@ -291,20 +352,12 @@ val () = Env.containerV_one "vhost"
 		 write docroot;
 		 write "\n\tServerAdmin ";
 		 write sadmin;
-		 write "\n\tErrorLog ";
-		 write Config.Apache.logDir;
-		 write "/";
-		 write vhostId;
-		 write "/error.log\n\tCustomLog ";
-		 write Config.Apache.logDir;
-		 write "/";
-		 write vhostId;
-		 write "/access.log combined\n";
-		 !pre {nodes = nodes, id = vhostId, hostname = fullHost}
+		 write "\n";
+		 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
 	     end,
 	  fn () => (!post ();
 		    write "</VirtualHost>\n";
-		    app TextIO.closeOut (!vhostFiles)))
+		    app (TextIO.closeOut o #2) (!vhostFiles)))
 
 val () = Env.container_one "location"
 	 ("prefix", Env.string)
@@ -398,9 +451,7 @@ val () = Env.action_one "rewriteLogLevel"
 	 (fn level =>
 	     (checkRewrite ();
 	      write "\tRewriteLog ";
-	      write Config.Apache.logDir;
-	      write "/";
-	      write (!currentVhostId);
+	      write' (fn x => x);
 	      write "/rewrite.log\n\tRewriteLogLevel ";
 	      write (Int.toString level);
 	      write "\n"))