Mailman shortcut working
[hcoop/domtool2.git] / src / plugins / apache.sml
index f935549..f36bfa4 100644 (file)
@@ -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
@@ -454,7 +469,7 @@ val () = Env.containerV_one "vhost"
                                           else
                                               ();
 
-                                          TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav.");
+                                          TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
                                           TextIO.output (file, user);
                                           TextIO.output (file, "/DAVLock");
 
@@ -819,6 +834,9 @@ val () = Env.action_one "authzSvnAccessFile"
                      write path;
                      write "\n"))*)
 
+val () = Env.action_none "davFilesystem"
+        (fn path => write "\tDAV filesystem\n")
+
 val () = Env.action_two "addDescription"
         ("description", Env.string, "patterns", Env.list Env.string)
         (fn (desc, pats) =>
@@ -884,10 +902,17 @@ val () = Env.action_two "setEnv"
         (fn (key, value) => (write "\tSetEnv \"";
                              write key;
                              write "\" \"";
-                             write value;
+                             write (String.translate (fn #"\"" => "\\\""
+                                                       | ch => str ch) value);
                              write "\"\n"))
 
 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