X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/7a2b27f02337220163e8c561c386c4893d5b8a39..47163553073524f0828c5d7cf066c94f650197f5:/src/plugins/apache.sml
diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 78ea612..541b144 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)
@@ -47,6 +58,10 @@ val _ = Env.type_one "rewrite_arg"
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
@@ -59,15 +74,28 @@ val _ = Env.type_one "location"
Env.string
validLocation
+fun validCert s = Acl.query {user = Domain.getUser (),
+ class = "cert",
+ value = s}
+
+val _ = Env.type_one "ssl_cert_path"
+ Env.string
+ validCert
+
+fun ssl e = case e of
+ (EVar "no_ssl", _) => SOME NONE
+ | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
+ | _ => NONE
+
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),
- (fn () => (EVar "false", dl)))
+ (TBase "ssl", dl),
+ (fn () => (EVar "no_ssl", dl)))
val _ = Defaults.registerDefault ("User",
(TBase "your_user", dl),
@@ -79,12 +107,15 @@ val _ = Defaults.registerDefault ("Group",
val _ = Defaults.registerDefault ("DocumentRoot",
(TBase "your_path", dl),
- (fn () => (EString (Config.homeBase ^ "/" ^ Domain.getUser () ^ "/public_html"), dl)))
+ (fn () => (EString (Config.homeBase ^ "/" ^ Domain.getUser () ^ "/" ^ 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 redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
@@ -169,9 +200,11 @@ val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
| _ => NONE
val vhostsChanged = ref false
+val logDeleted = ref false
val () = Slave.registerPreHandler
- (fn () => vhostsChanged := false)
+ (fn () => (vhostsChanged := false;
+ logDeleted := false))
fun findVhostUser fname =
let
@@ -181,69 +214,118 @@ fun findVhostUser fname =
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
- end
+ end handle _ => NONE
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
- 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
+ orelse String.isSuffix ".vhost_ssl" (#file spl) then let
+ val realVhostFile = OS.Path.joinDirFile
+ {dir = Config.Apache.confDir,
+ file = #file spl}
+
+ val user = findVhostUser (#file fs)
+ val oldUser = findVhostUser realVhostFile
+ in
+ if (oldUser = NONE andalso #action fs <> Slave.Add)
+ orelse (user = NONE andalso #action fs <> Slave.Delete) then
+ print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
+ else
+ let
+ fun realLogDir user =
+ let
+ val realLogDir = OS.Path.joinDirFile
+ {dir = Config.homeBase,
+ file = valOf 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
+ if String.isSuffix ".vhost_ssl" (#file spl) then
+ realLogDir ^ ".ssl"
+ else
+ realLogDir
+ end
+ in
+ vhostsChanged := true;
+ case #action fs of
+ Slave.Delete =>
+ (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 "
+ ^ realLogDir oldUser)))
+ | Slave.Add =>
+ let
+ val rld = realLogDir user
+ in
+ ignore (OS.Process.system (Config.cp
+ ^ " "
+ ^ #file fs
+ ^ " "
+ ^ realVhostFile));
+ if Posix.FileSys.access (rld, []) then
+ ()
+ else
+ OS.FileSys.mkDir rld
+ end
+
+ | _ =>
+ (ignore (OS.Process.system (Config.cp
+ ^ " "
+ ^ #file fs
+ ^ " "
+ ^ realVhostFile));
+ if user <> oldUser then
+ let
+ val old = realLogDir oldUser
+ val rld = realLogDir user
+ in
+ if !logDeleted then
+ ()
+ else
+ (ignore (OS.Process.system Config.Apache.down);
+ logDeleted := true);
+ ignore (OS.Process.system (Config.rm
+ ^ " -rf "
+ ^ realLogDir oldUser));
+ if Posix.FileSys.access (rld, []) then
+ ()
+ else
+ OS.FileSys.mkDir rld
+ end
+ else
+ ())
+ end
+ end
else
()
end)
@@ -251,7 +333,7 @@ val () = Slave.registerFileHandler (fn fs =>
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
()))
@@ -261,6 +343,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
+val localRewriteEnabled = ref false
val currentVhost = ref ""
val currentVhostId = ref ""
@@ -294,32 +377,35 @@ val () = Env.containerV_one "vhost"
let
val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
- val ssl = Env.env Env.bool (env, "SSL")
+ val ssl = Env.env ssl (env, "SSL")
val user = Env.env Env.string (env, "User")
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 Env.bool (env, "SuExec")
val fullHost = host ^ "." ^ Domain.currentDomain ()
- val vhostId = fullHost ^ (if ssl then ".ssl" else "")
- val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost")
+ val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
+ val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
in
currentVhost := fullHost;
currentVhostId := vhostId;
rewriteEnabled := false;
+ localRewriteEnabled := false;
vhostFiles := map (fn node =>
let
val file = Domain.domainFile {node = node,
name = confFile}
in
- TextIO.output (file, " "443"
+ | NONE => "80");
TextIO.output (file, ">\n");
TextIO.output (file, "\tErrorLog ");
TextIO.output (file, Config.homeBase);
@@ -344,14 +430,22 @@ val () = Env.containerV_one "vhost"
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 sadmin;
+ case ssl of
+ SOME cert =>
+ (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
+ write cert)
+ | NONE => ();
write "\n";
!pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
end,
@@ -359,24 +453,38 @@ val () = Env.containerV_one "vhost"
write "\n";
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";
@@ -630,7 +738,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;
@@ -640,7 +748,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)
@@ -702,4 +810,7 @@ val () = Env.action_one "readmeName"
write name;
write "\n"))
+val () = Domain.registerResetLocal (fn () =>
+ ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+
end