(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006-2009, Adam Chlipala
- * Copyright (c) 2013 Clinton Ebadi
+ * Copyright (c) 2013,2014,2015,2017,2018,2019 Clinton Ebadi
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
| _ => NONE)
fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
- SOME (node, Domain.nodeIp node)
- | webPlace (EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
- SOME (node, ip)
+ SOME (node, Domain.nodeIp node, Domain.nodeIpv6 node)
+ | webPlace (EApp ((EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _), (EString ipv6, _)), _) =
+ SOME (node, ip, ipv6)
| webPlace _ = NONE
fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
val _ = Env.registerFunction ("web_place_to_web_node",
- fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+ fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
| _ => NONE)
val _ = Env.registerFunction ("web_place_to_node",
- fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+ fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
| _ => NONE)
val _ = Env.registerFunction ("web_place_to_ip",
- fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (webPlace e)
- | _ => NONE)
+ fn [e] => Option.map (fn (_, ip, _) => (EString ip, dl)) (webPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_ipv6",
+ fn [e] => Option.map (fn (_, _, ipv6) => (EString ipv6, dl)) (webPlace e)
+ | _ => NONE)
val _ = Env.type_one "proxy_port"
Env.int
val _ = Env.type_one "rewrite_arg"
Env.string
- (CharVector.all Char.isAlphaNum)
+ (* #":" is permitted here, but really ought to be disallowed or escaped for E=VAR:VAL *)
+ (CharVector.all (fn ch => (Char.isGraph ch) andalso not (List.exists (fn c => ch = c) [ #"[", #"]", #",", #"\"", #"'", #"=", #"\\" ])))
val _ = Env.type_one "suexec_flag"
Env.bool
Slave.moveDirCreate {from = backupLogs (),
to = rld}
end
-
+
| _ =>
(ignore (OS.Process.system (Config.cp
^ " "
write "</VirtualHost>\n";
app (TextIO.closeOut o #2) (!vhostFiles))
-val php_version = fn (EVar "php5", _) => SOME 5
- | (EVar "fast_php", _) => SOME 6
- | _ => NONE
+val php_version = fn (EVar "php56", _) => SOME 56
+ | (EVar "php72", _) => SOME 72
+ | (EVar "php73", _) => SOME 73
+ | (EVar "php74", _) => SOME 74
+ | _ => NONE
fun vhostBody (env, makeFullHost) =
let
localRewriteEnabled := false;
expiresEnabled := false;
localExpiresEnabled := false;
- vhostFiles := map (fn (node, ip) =>
+ vhostFiles := map (fn (node, ip, ipv6) =>
let
val file = Domain.domainFile {node = node,
name = confFile}
TextIO.output (file, "# Owner: ");
TextIO.output (file, user);
TextIO.output (file, "\n<VirtualHost ");
+
TextIO.output (file, ip);
TextIO.output (file, ":");
TextIO.output (file, case ssl of
SOME _ => "443"
| NONE => "80");
+
+ TextIO.output (file, " [");
+ TextIO.output (file, ipv6);
+ TextIO.output (file, "]");
+ TextIO.output (file, ":");
+ TextIO.output (file, case ssl of
+ SOME _ => "443"
+ | NONE => "80");
+
TextIO.output (file, ">\n");
TextIO.output (file, "\tErrorLog ");
TextIO.output (file, ld);
TextIO.output (file, group))
else
(TextIO.output (file, "\n\tSuexecUserGroup ");
- TextIO.output (file, user);
- TextIO.output (file, " ");
- TextIO.output (file, group);
- TextIO.output (file, "\n\tsuPHP_UserGroup ");
TextIO.output (file, user);
TextIO.output (file, " ");
TextIO.output (file, group))
TextIO.output (file, user);
TextIO.output (file, "/DAVLock");
- if php = Config.Apache.defaultPhpVersion
- then
- ()
- else if php = 6
- then
- (* fastcgi php 5.6 since 6 doesn't exist *)
- (TextIO.output (file, "\n\tAddHandler fcgid-script .php .phtml");
- TextIO.output (file, "\n\tFcgidWrapper \"");
- TextIO.output (file, Config.Apache.fastCgiWrapperOf user);
- TextIO.output (file, " ");
- TextIO.output (file, Config.Apache.phpFastCgiWrapper);
- TextIO.output (file, "\""))
- else
- (TextIO.output (file, "\n\tAddHandler x-httpd-php");
- TextIO.output (file, Int.toString php);
- TextIO.output (file, " .php .phtml"));
+ TextIO.output (file, "\n\tAddHandler fcgid-script .php .phtml");
+ map (fn ext => (TextIO.output (file, "\n\tFcgidWrapper \"");
+ (* kerberos wrapper, simulates waklog+mod_cgi *)
+ if isWaklog node then
+ (TextIO.output (file, Config.Apache.fastCgiWrapperOf user);
+ TextIO.output (file, " "))
+ else
+ ();
+ TextIO.output (file, Config.Apache.phpFastCgiWrapper php);
+ TextIO.output (file, "\" ");
+ TextIO.output (file, ext)))
+ [".php", ".phtml"];
(ld, file)
end)
places;
write "\n";
!pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
- end
+ end
val () = Env.containerV_one "vhost"
("host", Env.string)
(write "\tExpiresActive on\n";
expiresEnabled := true)
-val () = Env.action_three "localProxyRewrite"
- ("from", Env.string, "to", Env.string, "port", Env.int)
- (fn (from, to, port) =>
+val () = Env.action_four "proxyRewrite"
+ ("from", Env.string, "to", Env.string, "tohost", Env.string, "flags", Env.list flag)
+ (fn (from, to, tohost, flags) =>
(checkRewrite ();
write "\tRewriteRule\t\"";
write from;
- write "\"\thttp://localhost:";
- write (Int.toString port);
- write "/";
+ write "\"\t\"";
+ write tohost;
+ write "/"; (* ensure rewrite rule can't change port *)
write to;
- write " [P]\n"))
+ write "\"";
+ write " [P";
+ case flags of
+ [] => ()
+ | flag::rest => (write ",";
+ write flag;
+ app (fn flag => (write ",";
+ write flag)) rest);
+
+ write "]\n"))
val () = Env.action_four "expiresByType"
("mime", Env.string, "base", interval_base, "num", Env.int, "inter", interval)
write prefix;
write "\"\n"))
+val _ = Env.type_one "mod_rewrite_trace_level"
+ Env.int
+ (fn n => n > 0 andalso n <= 8)
+
val () = Env.action_one "rewriteLogLevel"
("level", Env.int)
- (fn level =>
+ (fn 0 =>
(checkRewrite ();
- write "\tRewriteLog ";
- write' (fn x => x);
- write "/rewrite.log\n\tRewriteLogLevel ";
- write (Int.toString level);
- write "\n"))
+ write "\tLogLevel rewrite:warn\n")
+ | level =>
+ (checkRewrite ();
+ write "\tLogLevel rewrite:trace";
+ write (Int.toString level);
+ write "\n"))
val () = Env.action_two "alias"
("from", Env.string, "to", Env.string)
write to;
write "\n"))
+val () = Env.action_two "fastScriptAlias"
+ ("from", Env.string, "to", Env.string)
+ (fn (from, to) =>
+ let
+ (* mod_fcgid + kerberos limit this to working with
+ individual fcgi programs. assume the target path is a
+ file and any trailing `/' is just aliasing
+ syntax. Directory+File on the script is used to
+ activate fcgid instead of Location on the alias to
+ limit effects (alias+location also match in inverse
+ order causing pernicious side-effects *)
+ val fcgi_path = if String.sub (to, size to - 1) = #"/"
+ then
+ String.substring (to, 0, size to - 1)
+ else
+ to
+ val fcgi_dir = OS.Path.dir fcgi_path
+ val fcgi_file = OS.Path.file fcgi_path
+ in
+ write "\tAlias\t"; write from; write " "; write to; write "\n";
+
+ write "\t<Directory "; write fcgi_dir; write ">\n";
+ write "\t<Files "; write fcgi_file; write ">\n";
+ write "\tSetHandler fcgid-script\n";
+
+ (* FIXME: only set kerberos wrapper of waklog is on *)
+ (* won't be trivial, since we don't have access to node here *)
+ write "\tFcgidWrapper \"";
+ write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
+ write " ";
+ write fcgi_path;
+ write "\"\n";
+
+ write "\t</Files>\n\t</Directory>\n"
+ end)
+
val () = Env.action_two "errorDocument"
("code", Env.string, "handler", Env.string)
(fn (code, handler) =>
maybeQuote ();
write "\n"
end)
-
+
val () = Env.action_one "options"
("options", Env.list apache_option)
(fn opts =>
app (fn opt => (write " "; write opt)) opts;
write "\n"))
+val () = Env.action_one "directorySlash"
+ ("enable", Env.bool)
+ (fn enable =>
+ (write "\tDirectorySlash ";
+ if enable then write "On" else write "Off";
+ write "\n"))
+
val () = Env.action_one "serverAliasHost"
("host", Env.string)
(fn host =>
write ty;
write "\n";
case ty of
- "kerberos" =>
- write "\tKrbServiceName apache2\n\tKrb5Keytab /etc/keytabs/service/apache\n\tKrbMethodNegotiate on\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC on\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
+ "kerberos" =>
+ write "\tKrbServiceName HTTP\n\tKrb5Keytab /etc/keytabs/service/apache\n\tKrbMethodNegotiate on\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC on\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
| _ => ())
else
print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
| ch => str ch) value);
write "\"\n"))
+val () = Env.action_three "setEnvIf"
+ ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
+ (fn (attribute, match, envs) =>
+ case envs of
+ [] => (print "WARNING: Skipped setEnvIf, no environment variables provided.\n")
+ | envs =>
+ (write "\tSetEnvIf\t\"";
+ write attribute;
+ write "\"\t\"";
+ write match;
+ write "\"";
+ app (fn env => (write "\t"; write env)) envs;
+ write "\n"))
+
+val () = Env.action_three "setEnvIfNoCase"
+ ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
+ (fn (attribute, match, envs) =>
+ case envs of
+ [] => (print "WARNING: Skipped setEnvIfNoCase, no environment variables provided.\n")
+ | envs =>
+ (write "\tSetEnvIfNoCase\t\"";
+ write attribute;
+ write "\"\t\"";
+ write match;
+ write "\"";
+ app (fn env => (write "\t"; write env)) envs;
+ write "\n"))
+
val () = Env.action_one "diskCache"
("path", Env.string)
(fn path => (write "\tCacheEnable disk \"";
val () = Env.action_one "phpVersion"
("version", php_version)
- (fn version => (write "\tAddHandler x-httpd-php";
- write (Int.toString version);
- write " .php .phtml\n"))
+ (fn version => (write "\tAddHandler fcgid-script .php .phtml\n";
+ (* FIXME: only set kerberos wrapper of waklog is on *)
+ (* won't be trivial, since we don't have access to node here *)
+ write "\n\tFcgidWrapper \"";
+ write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
+ write " ";
+ write (Config.Apache.phpFastCgiWrapper version);
+ write "\" .php .phtml\n"))
val () = Env.action_two "addType"
("mime type", Env.string, "extension", Env.string)
HCoop / hcoop / domtool2.git / blobdiff