X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/aa56e112996b3650e8ac343831322d2a9ab0de54..c189cbe97d554b26ec6b203b4ce9f697947ecc38:/src/plugins/apache.sml
diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 13062a2..955e9d8 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -22,6 +22,17 @@ structure Apache :> APACHE = struct
open Ast
+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))
+
+val _ = Env.registerFunction ("web_node_to_node",
+ fn [e] => SOME e
+ | _ => NONE)
+
val _ = Env.type_one "proxy_port"
Env.int
(fn n => n > 1024)
@@ -62,8 +73,8 @@ val _ = Env.type_one "location"
val dl = ErrorMsg.dummyLoc
val _ = Defaults.registerDefault ("WebNodes",
- (TList (TBase "node", dl), dl),
- (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl)))
+ (TList (TBase "web_node", dl), dl),
+ (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
val _ = Defaults.registerDefault ("SSL",
(TBase "bool", dl),
@@ -79,7 +90,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 +184,80 @@ 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));
+ if Posix.FileSys.access (realLogDir, []) then
+ ()
+ else
+ OS.FileSys.mkDir realLogDir)
+
+ | _ =>
+ ignore (OS.Process.system (Config.cp
+ ^ " "
+ ^ #file fs
+ ^ " "
+ ^ realVhostFile))
+ end
else
()
end)
@@ -214,14 +270,16 @@ 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 localRewriteEnabled = 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
@@ -265,6 +323,7 @@ val () = Env.containerV_one "vhost"
currentVhostId := vhostId;
rewriteEnabled := false;
+ localRewriteEnabled := false;
vhostFiles := map (fn node =>
let
val file = Domain.domainFile {node = node,
@@ -278,7 +337,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,39 +368,45 @@ 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 "\n";
- app TextIO.closeOut (!vhostFiles)))
+ app (TextIO.closeOut o #2) (!vhostFiles)))
+
+val inLocal = ref false
val () = Env.container_one "location"
("prefix", Env.string)
(fn prefix =>
(write "\t\n"),
- fn () => write "\t\n")
+ write ">\n";
+ inLocal := true),
+ fn () => (write "\t\n";
+ inLocal := false;
+ localRewriteEnabled := false))
val () = Env.container_one "directory"
("directory", Env.string)
(fn directory =>
(write "\t\n"),
- fn () => write "\t\n")
+ write ">\n";
+ inLocal := true),
+ fn () => (write "\t\n";
+ inLocal := false;
+ localRewriteEnabled := false))
fun checkRewrite () =
- if !rewriteEnabled then
+ if !inLocal then
+ if !rewriteEnabled orelse !localRewriteEnabled then
+ ()
+ else
+ (write "\tRewriteEngine on\n";
+ localRewriteEnabled := true)
+ else if !rewriteEnabled then
()
else
(write "\tRewriteEngine on\n";
@@ -398,9 +481,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"))
@@ -579,7 +660,7 @@ val () = Env.action_one "addDefaultCharset"
write ty;
write "\n"))
-val () = Env.action_one "davSvn"
+(*val () = Env.action_one "davSvn"
("path", Env.string)
(fn path => (write "\tDAV svn\n\tSVNPath ";
write path;
@@ -589,7 +670,7 @@ val () = Env.action_one "authzSvnAccessFile"
("path", Env.string)
(fn path => (write "\tAuthzSVNAccessFile ";
write path;
- write "\n"))
+ write "\n"))*)
val () = Env.action_two "addDescription"
("description", Env.string, "patterns", Env.list Env.string)