Correct locations of public_html
[hcoop/domtool2.git] / src / plugins / apache.sml
index 1f61476..6c04738 100644 (file)
@@ -61,29 +61,29 @@ val _ = Env.type_one "location"
 
 val dl = ErrorMsg.dummyLoc
 
-val _ = Main.registerDefault ("WebNodes",
-                             (TList (TBase "node", dl), dl),
-                             (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
+val _ = Defaults.registerDefault ("WebNodes",
+                                 (TList (TBase "node", dl), dl),
+                                 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
 
-val _ = Main.registerDefault ("SSL",
-                             (TBase "bool", dl),
-                             (fn () => (EVar "false", dl)))
+val _ = Defaults.registerDefault ("SSL",
+                                 (TBase "bool", dl),
+                                 (fn () => (EVar "false", dl)))
 
-val _ = Main.registerDefault ("User",
-                             (TBase "your_user", dl),
-                             (fn () => (EString (Domain.getUser ()), dl)))
+val _ = Defaults.registerDefault ("User",
+                                 (TBase "your_user", dl),
+                                 (fn () => (EString (Domain.getUser ()), dl)))
 
-val _ = Main.registerDefault ("Group",
-                             (TBase "your_group", dl),
-                             (fn () => (EString (Domain.getUser ()), dl)))
+val _ = Defaults.registerDefault ("Group",
+                                 (TBase "your_group", dl),
+                                 (fn () => (EString (Domain.getUser ()), dl)))
 
-val _ = Main.registerDefault ("DocumentRoot",
-                             (TBase "your_path", dl),
-                             (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl)))
+val _ = Defaults.registerDefault ("DocumentRoot",
+                                 (TBase "your_path", dl),
+                                 (fn () => (EString (Config.homeBase ^ "/" ^ Domain.getUser () ^ "/" ^ Config.Apache.public_html), dl)))
 
-val _ = Main.registerDefault ("ServerAdmin",
-                             (TBase "email", dl),
-                             (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
+val _ = Defaults.registerDefault ("ServerAdmin",
+                                 (TBase "email", dl),
+                                 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
@@ -173,28 +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.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)
@@ -207,13 +256,38 @@ 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 _ : {user : string, nodes : string list, id : string, hostname : string} => ())
+fun registerPre f =
+    let
+       val old = !pre
+    in
+       pre := (fn x => (old x; f x))
+    end
+
+val post = ref (fn () => ())
+fun registerPost f =
+    let
+       val old = !post
+    in
+       post := (fn () => (old (); f ()))
+    end
+
+val aliaser = ref (fn _ : string => ())
+fun registerAliaser f =
+    let
+       val old = !aliaser
+    in
+       aliaser := (fn x => (old x; f x))
+    end
+
 val () = Env.containerV_one "vhost"
         ("host", Env.string)
         (fn (env, host) =>
@@ -247,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 ";
@@ -260,18 +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"
+                write "\n";
+                !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
             end,
-         fn () => (write "</VirtualHost>\n";
-                   app TextIO.closeOut (!vhostFiles)))
+         fn () => (!post ();
+                   write "</VirtualHost>\n";
+                   app (TextIO.closeOut o #2) (!vhostFiles)))
 
 val () = Env.container_one "location"
         ("prefix", Env.string)
@@ -365,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"))
@@ -438,7 +522,8 @@ val () = Env.action_one "serverAlias"
         (fn host =>
             (write "\tServerAlias ";
              write host;
-             write "\n"))
+             write "\n";
+             !aliaser host))
 
 val authType = fn (EVar "basic", _) => SOME "basic"
                | (EVar "digest", _) => SOME "digest"