Correct locations of public_html

[hcoop/domtool2.git] / src / plugins / apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 13062a2..6c04738 100644 (file)
--- 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"))