HCoop
/
hcoop
/
domtool2.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Allow vetoing of suexec
[hcoop/domtool2.git]
/
src
/
plugins
/
apache.sml
diff --git
a/src/plugins/apache.sml
b/src/plugins/apache.sml
index
6970a86
..
3d7c199
100644
(file)
--- a/
src/plugins/apache.sml
+++ b/
src/plugins/apache.sml
@@
-22,6
+22,17
@@
structure Apache :> APACHE = struct
open Ast
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)
val _ = Env.type_one "proxy_port"
Env.int
(fn n => n > 1024)
@@
-47,6
+58,10
@@
val _ = Env.type_one "rewrite_arg"
Env.string
(CharVector.all Char.isAlphaNum)
Env.string
(CharVector.all Char.isAlphaNum)
+val _ = Env.type_one "suexec_flag"
+ Env.bool
+ (fn b => b orelse Domain.hasPriv "www")
+
fun validLocation s =
size s > 0 andalso size s < 1000 andalso CharVector.all
(fn ch => Char.isAlphaNum ch
fun validLocation s =
size s > 0 andalso size s < 1000 andalso CharVector.all
(fn ch => Char.isAlphaNum ch
@@
-62,8
+77,8
@@
val _ = Env.type_one "location"
val dl = ErrorMsg.dummyLoc
val _ = Defaults.registerDefault ("WebNodes",
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),
val _ = Defaults.registerDefault ("SSL",
(TBase "bool", dl),
@@
-85,6
+100,10
@@
val _ = Defaults.registerDefault ("ServerAdmin",
(TBase "email", dl),
(fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
(TBase "email", dl),
(fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
+val _ = Defaults.registerDefault ("SuExec",
+ (TBase "suexec_flag", dl),
+ (fn () => (EApp ((EVar "suexec_flag", dl),
+ (EVar "true", dl)), dl)))
val redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
val redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
@@
-169,9
+188,11
@@
val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
| _ => NONE
val vhostsChanged = ref false
| _ => NONE
val vhostsChanged = ref false
+val logDeleted = ref false
val () = Slave.registerPreHandler
val () = Slave.registerPreHandler
- (fn () => vhostsChanged := false)
+ (fn () => (vhostsChanged := false;
+ logDeleted := false))
fun findVhostUser fname =
let
fun findVhostUser fname =
let
@@
-181,9
+202,12
@@
fun findVhostUser fname =
case TextIO.inputLine inf of
NONE => NONE
| SOME line =>
case TextIO.inputLine inf of
NONE => NONE
| SOME line =>
- case String.tokens Char.isSpace line of
- ["SuexecUserGroup", user, _] => SOME user
- | _ => loop ()
+ if String.isPrefix "# Owner: " line then
+ case String.tokens Char.isSpace line of
+ [_, _, user] => SOME user
+ | _ => NONE
+ else
+ loop ()
in
loop ()
before TextIO.closeIn inf
in
loop ()
before TextIO.closeIn inf
@@
-223,7
+247,12
@@
val () = Slave.registerFileHandler (fn fs =>
vhostsChanged := true;
case #action fs of
Slave.Delete =>
vhostsChanged := true;
case #action fs of
Slave.Delete =>
- (ignore (OS.Process.system (Config.rm
+ (if !logDeleted then
+ ()
+ else
+ (ignore (OS.Process.system Config.Apache.down);
+ logDeleted := true);
+ ignore (OS.Process.system (Config.rm
^ " -rf "
^ realVhostFile));
ignore (OS.Process.system (Config.rm
^ " -rf "
^ realVhostFile));
ignore (OS.Process.system (Config.rm
@@
-235,7
+264,10
@@
val () = Slave.registerFileHandler (fn fs =>
^ #file fs
^ " "
^ realVhostFile));
^ #file fs
^ " "
^ realVhostFile));
- OS.FileSys.mkDir realLogDir)
+ if Posix.FileSys.access (realLogDir, []) then
+ ()
+ else
+ OS.FileSys.mkDir realLogDir)
| _ =>
ignore (OS.Process.system (Config.cp
| _ =>
ignore (OS.Process.system (Config.cp
@@
-251,7
+283,7
@@
val () = Slave.registerFileHandler (fn fs =>
val () = Slave.registerPostHandler
(fn () =>
(if !vhostsChanged then
val () = Slave.registerPostHandler
(fn () =>
(if !vhostsChanged then
- Slave.shellF ([Config.Apache.reload],
+ Slave.shellF ([
if !logDeleted then Config.Apache.undown else
Config.Apache.reload],
fn cl => "Error reloading Apache with " ^ cl)
else
()))
fn cl => "Error reloading Apache with " ^ cl)
else
()))
@@
-261,6
+293,7
@@
fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFile
fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
val rewriteEnabled = ref false
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 currentVhost = ref ""
val currentVhostId = ref ""
@@
-288,6
+321,9
@@
fun registerAliaser f =
aliaser := (fn x => (old x; f x))
end
aliaser := (fn x => (old x; f x))
end
+fun suexec_flag (EApp ((EVar "suexec_flag", _), e), _) = Env.bool e
+ | suexec_flag _ = NONE
+
val () = Env.containerV_one "vhost"
("host", Env.string)
(fn (env, host) =>
val () = Env.containerV_one "vhost"
("host", Env.string)
(fn (env, host) =>
@@
-299,6
+335,7
@@
val () = Env.containerV_one "vhost"
val group = Env.env Env.string (env, "Group")
val docroot = Env.env Env.string (env, "DocumentRoot")
val sadmin = Env.env Env.string (env, "ServerAdmin")
val group = Env.env Env.string (env, "Group")
val docroot = Env.env Env.string (env, "DocumentRoot")
val sadmin = Env.env Env.string (env, "ServerAdmin")
+ val suexec = Env.env suexec_flag (env, "SuExec")
val fullHost = host ^ "." ^ Domain.currentDomain ()
val vhostId = fullHost ^ (if ssl then ".ssl" else "")
val fullHost = host ^ "." ^ Domain.currentDomain ()
val vhostId = fullHost ^ (if ssl then ".ssl" else "")
@@
-308,12
+345,15
@@
val () = Env.containerV_one "vhost"
currentVhostId := vhostId;
rewriteEnabled := false;
currentVhostId := vhostId;
rewriteEnabled := false;
+ localRewriteEnabled := false;
vhostFiles := map (fn node =>
let
val file = Domain.domainFile {node = node,
name = confFile}
in
vhostFiles := map (fn node =>
let
val file = Domain.domainFile {node = node,
name = confFile}
in
- TextIO.output (file, "<VirtualHost ");
+ TextIO.output (file, "# Owner: ");
+ TextIO.output (file, user);
+ TextIO.output (file, "\n<VirtualHost ");
TextIO.output (file, Domain.nodeIp node);
TextIO.output (file, ":");
TextIO.output (file, if ssl then
TextIO.output (file, Domain.nodeIp node);
TextIO.output (file, ":");
TextIO.output (file, if ssl then
@@
-344,10
+384,13
@@
val () = Env.containerV_one "vhost"
nodes;
write "\tServerName ";
write fullHost;
nodes;
write "\tServerName ";
write fullHost;
- write "\n\tSuexecUserGroup ";
- write user;
- write " ";
- write group;
+ if suexec then
+ (write "\n\tSuexecUserGroup ";
+ write user;
+ write " ";
+ write group)
+ else
+ ();
write "\n\tDocumentRoot ";
write docroot;
write "\n\tServerAdmin ";
write "\n\tDocumentRoot ";
write docroot;
write "\n\tServerAdmin ";
@@
-359,24
+402,38
@@
val () = Env.containerV_one "vhost"
write "</VirtualHost>\n";
app (TextIO.closeOut o #2) (!vhostFiles)))
write "</VirtualHost>\n";
app (TextIO.closeOut o #2) (!vhostFiles)))
+val inLocal = ref false
+
val () = Env.container_one "location"
("prefix", Env.string)
(fn prefix =>
(write "\t<Location ";
write prefix;
val () = Env.container_one "location"
("prefix", Env.string)
(fn prefix =>
(write "\t<Location ";
write prefix;
- write ">\n"),
- fn () => write "\t</Location>\n")
+ write ">\n";
+ inLocal := true),
+ fn () => (write "\t</Location>\n";
+ inLocal := false;
+ localRewriteEnabled := false))
val () = Env.container_one "directory"
("directory", Env.string)
(fn directory =>
(write "\t<Directory ";
write directory;
val () = Env.container_one "directory"
("directory", Env.string)
(fn directory =>
(write "\t<Directory ";
write directory;
- write ">\n"),
- fn () => write "\t</Directory>\n")
+ write ">\n";
+ inLocal := true),
+ fn () => (write "\t</Directory>\n";
+ inLocal := false;
+ localRewriteEnabled := false))
fun checkRewrite () =
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";
()
else
(write "\tRewriteEngine on\n";
@@
-702,4
+759,7
@@
val () = Env.action_one "readmeName"
write name;
write "\n"))
write name;
write "\n"))
+val () = Domain.registerResetLocal (fn () =>
+ ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+
end
end