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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 54df3d5..f36bfa4 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -22,12 +22,14 @@ structure Apache :> APACHE = struct
 
 open Ast
 
+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
@@ -89,33 +91,29 @@ fun ssl e = case e of
 
 val dl = ErrorMsg.dummyLoc
 
-val _ = Defaults.registerDefault ("WebNodes",
-				  (TList (TBase "web_node", dl), dl),
-				  (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
-
-val _ = Defaults.registerDefault ("SSL",
-				  (TBase "ssl", dl),
-				  (fn () => (EVar "no_ssl", dl)))
-
-val _ = Defaults.registerDefault ("User",
-				  (TBase "your_user", dl),
-				  (fn () => (EString (Domain.getUser ()), dl)))
-
-val _ = Defaults.registerDefault ("Group",
-				  (TBase "your_group", dl),
-				  (fn () => (EString "nogroup", dl)))
-
-val _ = Defaults.registerDefault ("DocumentRoot",
-				  (TBase "your_path", dl),
-				  (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
-
-val _ = Defaults.registerDefault ("ServerAdmin",
-				  (TBase "email", dl),
-				  (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
-
-val _ = Defaults.registerDefault ("SuExec",
-				  (TBase "suexec_flag", dl),
-				  (fn () => (EVar "true", dl)))
+val defaults = [("WebNodes",
+		 (TList (TBase "web_node", dl), dl),
+		 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))),
+		("SSL",
+		 (TBase "ssl", dl),
+		 (fn () => (EVar "no_ssl", dl))),
+		("User",
+		 (TBase "your_user", dl),
+		 (fn () => (EString (Domain.getUser ()), dl))),
+		("Group",
+		 (TBase "your_group", dl),
+		 (fn () => (EString "nogroup", dl))),
+		("DocumentRoot",
+		 (TBase "your_path", dl),
+		 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
+		("ServerAdmin",
+		 (TBase "email", dl),
+		 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
+		("SuExec",
+		 (TBase "suexec_flag", dl),
+		 (fn () => (EVar "true", dl)))]
+
+val () = app Defaults.registerDefault defaults
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
 		     | (EVar "permanent", _) => SOME "permanent"
@@ -240,6 +238,7 @@ fun isWaklog node =
 fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
 fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
 fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
+fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
 
 fun logDir {user, node, vhostId} =
     String.concat [Config.Apache.logDirOf (isVersion1 node) user,
@@ -259,10 +258,12 @@ 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 #action fs <> Slave.Delete) then
+						      orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
 						       print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "!  Taking no action.\n")
 						   else
 						       let
@@ -275,21 +276,31 @@ val () = Slave.registerFileHandler (fn fs =>
 							       logDir {user = valOf user,
 								       node = Slave.hostname (),
 								       vhostId = vhostId}
+
+							   fun backupLogs () =
+							       OS.Path.joinDirFile
+								   {dir = Config.Apache.backupLogDirOf
+									      (isVersion1 (Slave.hostname ())),
+								    file = vhostId}
 						       in
 							   vhostsChanged := true;
 							   case #action fs of
-							       Slave.Delete =>
-							       (if !logDeleted then
-								    ()
-								else
-								    (ignore (OS.Process.system (down ()));
-								     logDeleted := true);
-   							        ignore (OS.Process.system (Config.rm
-											   ^ " -rf "
-											   ^ realVhostFile));
-								ignore (OS.Process.system (Config.rm
-											   ^ " -rf "
-											   ^ realLogDir oldUser)))
+							       Slave.Delete _ =>
+							       let
+								   val ldir = realLogDir oldUser
+							       in
+								   if !logDeleted then
+								       ()
+								   else
+								       (ignore (OS.Process.system (down ()));
+									ignore (OS.Process.system (fixperms ()));
+									logDeleted := true);
+   							           ignore (OS.Process.system (Config.rm
+											      ^ " -rf "
+											      ^ realVhostFile));
+								   Slave.moveDirCreate {from = ldir,
+											to = backupLogs ()}
+							       end
 							     | Slave.Add =>
 							       let
 								   val rld = realLogDir user
@@ -302,7 +313,8 @@ val () = Slave.registerFileHandler (fn fs =>
 								   if Posix.FileSys.access (rld, []) then
 								       ()
 								   else
-								       Slave.mkDirAll rld
+								       Slave.moveDirCreate {from = backupLogs (),
+											    to = rld}
 							       end
 							       
 							     | _ =>
@@ -371,6 +383,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
@@ -894,4 +909,10 @@ val () = Env.action_two "setEnv"
 val () = Domain.registerResetLocal (fn () =>
 				       ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
 
+val () = Domain.registerDescriber (Domain.considerAll
+				   [Domain.Extension {extension = "vhost",
+						      heading = fn host => "Web vhost " ^ host},
+				    Domain.Extension {extension = "vhost_ssl",
+						      heading = fn host => "SSL web vhost " ^ host}])
+
 end