X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/666ed6742b4d1431e46e396209e4b3ddcc0321c4..621629dc64ea614907eb1f9b77e3288d8dbd299f:/src/plugins/apache.sml
diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 300ffa4..e160745 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -1,5 +1,6 @@
(* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006-2007, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala
+ * Copyright (c) 2013 Clinton Ebadi
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
@@ -61,22 +62,34 @@ val _ = Env.type_one "proxy_port"
Env.int
(fn n => n > 1024)
+fun validProxyTarget default s =
+ case String.fields (fn ch => ch = #":") s of
+ "http" :: host :: rest =>
+ let
+ val rest = String.concatWith ":" rest
+ in
+ if List.exists (fn h' => host = h') (map (fn h => String.concat ["//", h]) Config.Apache.proxyHosts)
+ then
+ CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
+ andalso ch <> #"\"" andalso ch <> #"'") rest
+ andalso case String.fields (fn ch => ch = #"/") rest of
+ port :: _ =>
+ (case Int.fromString port of
+ NONE => default s
+ | SOME n => n > 1024 orelse default s)
+ | _ => default s
+ else
+ default s
+ end
+ | _ => default s
+
val _ = Env.type_one "proxy_target"
Env.string
- (fn s =>
- let
- fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets
- in
- case String.fields (fn ch => ch = #":") s of
- ["http", "//localhost", rest] =>
- (case String.fields (fn ch => ch = #"/") rest of
- port :: _ =>
- (case Int.fromString port of
- NONE => default ()
- | SOME n => n > 1024 orelse default ())
- | _ => default ())
- | _ => default ()
- end)
+ (validProxyTarget (fn s => List.exists (fn s' => s = s') (Config.Apache.proxyTargets @ ["!"])))
+
+val _ = Env.type_one "proxy_reverse_target"
+ Env.string
+ (validProxyTarget (fn s => List.exists (fn s' => s = s') Config.Apache.proxyTargets))
val _ = Env.type_one "rewrite_arg"
Env.string
@@ -107,10 +120,18 @@ fun validCert s = Acl.query {user = Domain.getUser (),
class = "cert",
value = s}
+fun validCaCert s = Acl.query {user = Domain.getUser (),
+ class = "cacert",
+ value = s}
+
val _ = Env.type_one "ssl_cert_path"
Env.string
validCert
+val _ = Env.type_one "ssl_cacert_path"
+ Env.string
+ validCaCert
+
fun ssl e = case e of
(EVar "no_ssl", _) => SOME NONE
| (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
@@ -125,29 +146,9 @@ val _ = Env.type_one "file_extension"
Env.string
validExtension
-val defaults = [("WebPlaces",
- (TList (TBase "web_place", dl), dl),
- (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
- ("SSL",
- (TBase "ssl", dl),
- (fn () => (EVar "no_ssl", dl))),
- ("User",
- (TBase "your_user", dl),
- (fn () => (EString (Domain.getUser ()), dl))),
- ("Group",
- (TBase "your_group", dl),
- (fn () => (EString "nogroup", dl))),
- ("DocumentRoot",
- (TBase "your_path", dl),
- (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
- ("ServerAdmin",
- (TBase "email", dl),
- (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
- ("SuExec",
- (TBase "suexec_flag", dl),
- (fn () => (EVar "true", dl)))]
-
-val () = app Defaults.registerDefault defaults
+val _ = Env.registerFunction ("defaultServerAdmin",
+ fn [] => SOME (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)
+ | _ => NONE)
val redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
@@ -193,6 +194,7 @@ val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
| (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
| (EVar "indexes", _) => SOME "Indexes"
| (EVar "followSymLinks", _) => SOME "FollowSymLinks"
+ | (EVar "multiViews", _) => SOME "MultiViews"
| _ => NONE
val autoindex_width = fn (EVar "autofit", _) => SOME "*"
@@ -232,12 +234,27 @@ val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
| _ => NONE
+val interval_base = fn (EVar "access", _) => SOME "access"
+ | (EVar "modification", _) => SOME "modification"
+ | _ => NONE
+
+val interval = fn (EVar "years", _) => SOME "years"
+ | (EVar "months", _) => SOME "months"
+ | (EVar "weeks", _) => SOME "weeks"
+ | (EVar "days", _) => SOME "days"
+ | (EVar "hours", _) => SOME "hours"
+ | (EVar "minutes", _) => SOME "minutes"
+ | (EVar "seconds", _) => SOME "seconds"
+ | _ => NONE
+
val vhostsChanged = ref false
val logDeleted = ref false
+val delayedLogMoves = ref (fn () => ())
val () = Slave.registerPreHandler
(fn () => (vhostsChanged := false;
- logDeleted := false))
+ logDeleted := false;
+ delayedLogMoves := (fn () => print "Executing delayed log moves/deletes.\n")))
fun findVhostUser fname =
let
@@ -330,18 +347,20 @@ val () = Slave.registerFileHandler (fn fs =>
Slave.Delete _ =>
let
val ldir = realLogDir oldUser
+ val dlm = !delayedLogMoves
in
if !logDeleted then
()
else
- (ignore (OS.Process.system (down ()));
+ ((*ignore (OS.Process.system (down ()));*)
ignore (OS.Process.system (fixperms ()));
logDeleted := true);
ignore (OS.Process.system (Config.rm
^ " -rf "
^ realVhostFile));
- Slave.moveDirCreate {from = ldir,
- to = backupLogs ()}
+ delayedLogMoves := (fn () => (dlm ();
+ Slave.moveDirCreate {from = ldir,
+ to = backupLogs ()}))
end
| Slave.Add =>
let
@@ -369,15 +388,18 @@ val () = Slave.registerFileHandler (fn fs =>
let
val old = realLogDir oldUser
val rld = realLogDir user
+
+ val dlm = !delayedLogMoves
in
if !logDeleted then
()
else
- (ignore (OS.Process.system (down ()));
+ ((*ignore (OS.Process.system (down ()));*)
logDeleted := true);
- ignore (OS.Process.system (Config.rm
- ^ " -rf "
- ^ realLogDir oldUser));
+ delayedLogMoves := (fn () => (dlm ();
+ ignore (OS.Process.system (Config.rm
+ ^ " -rf "
+ ^ realLogDir oldUser))));
if Posix.FileSys.access (rld, []) then
()
else
@@ -394,8 +416,9 @@ val () = Slave.registerFileHandler (fn fs =>
val () = Slave.registerPostHandler
(fn () =>
(if !vhostsChanged then
- Slave.shellF ([if !logDeleted then undown () else reload ()],
- fn cl => "Error reloading Apache with " ^ cl)
+ (Slave.shellF ([reload ()],
+ fn cl => "Error reloading Apache with " ^ cl);
+ if !logDeleted then !delayedLogMoves () else ())
else
()))
@@ -405,6 +428,8 @@ fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
val rewriteEnabled = ref false
val localRewriteEnabled = ref false
+val expiresEnabled = ref false
+val localExpiresEnabled = ref false
val currentVhost = ref ""
val currentVhostId = ref ""
val sslEnabled = ref false
@@ -440,6 +465,9 @@ fun vhostPost () = (!post ();
write "\n";
app (TextIO.closeOut o #2) (!vhostFiles))
+val php_version = fn (EVar "php5", _) => SOME 5
+ | _ => NONE
+
fun vhostBody (env, makeFullHost) =
let
val places = Env.env (Env.list webPlace) (env, "WebPlaces")
@@ -450,6 +478,7 @@ fun vhostBody (env, makeFullHost) =
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 php = Env.env php_version (env, "PhpVersion")
val fullHost = makeFullHost (Domain.currentDomain ())
val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
@@ -461,6 +490,8 @@ fun vhostBody (env, makeFullHost) =
rewriteEnabled := false;
localRewriteEnabled := false;
+ expiresEnabled := false;
+ localExpiresEnabled := false;
vhostFiles := map (fn (node, ip) =>
let
val file = Domain.domainFile {node = node,
@@ -497,6 +528,10 @@ fun vhostBody (env, makeFullHost) =
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))
@@ -515,6 +550,13 @@ fun vhostBody (env, makeFullHost) =
TextIO.output (file, user);
TextIO.output (file, "/DAVLock");
+ if php <> Config.Apache.defaultPhpVersion then
+ (TextIO.output (file, "\n\tAddHandler x-httpd-php");
+ TextIO.output (file, Int.toString php);
+ TextIO.output (file, " .php .phtml"))
+ else
+ ();
+
(ld, file)
end)
places;
@@ -552,7 +594,8 @@ val () = Env.container_one "location"
inLocal := true),
fn () => (write "\t\n";
inLocal := false;
- localRewriteEnabled := false))
+ localRewriteEnabled := false;
+ localExpiresEnabled := false))
val () = Env.container_one "directory"
("directory", Env.string)
@@ -563,7 +606,18 @@ val () = Env.container_one "directory"
inLocal := true),
fn () => (write "\t\n";
inLocal := false;
- localRewriteEnabled := false))
+ localRewriteEnabled := false;
+ localExpiresEnabled := false))
+
+val () = Env.container_one "filesMatch"
+ ("regexp", Env.string)
+ (fn prefix =>
+ (write "\t\n"),
+ fn () => (write "\t\n";
+ localRewriteEnabled := false;
+ localExpiresEnabled := false))
fun checkRewrite () =
if !inLocal then
@@ -578,18 +632,49 @@ fun checkRewrite () =
(write "\tRewriteEngine on\n";
rewriteEnabled := true)
+fun checkExpires () =
+ if !inLocal then
+ if !localExpiresEnabled then
+ ()
+ else
+ (write "\tExpiresActive on\n";
+ localExpiresEnabled := true)
+ else if !expiresEnabled then
+ ()
+ else
+ (write "\tExpiresActive on\n";
+ expiresEnabled := true)
+
val () = Env.action_three "localProxyRewrite"
("from", Env.string, "to", Env.string, "port", Env.int)
(fn (from, to, port) =>
(checkRewrite ();
- write "\tRewriteRule\t";
+ write "\tRewriteRule\t\"";
write from;
- write "\thttp://localhost:";
+ write "\"\thttp://localhost:";
write (Int.toString port);
write "/";
write to;
write " [P]\n"))
+val () = Env.action_four "expiresByType"
+ ("mime", Env.string, "base", interval_base, "num", Env.int, "inter", interval)
+ (fn (mime, base, num, inter) =>
+ (checkExpires ();
+ write "\tExpiresByType\t\"";
+ write mime;
+ write "\"\t\"";
+ write base;
+ write " plus ";
+ if num < 0 then
+ (write "-";
+ write (Int.toString (~num)))
+ else
+ write (Int.toString num);
+ write " ";
+ write inter;
+ write "\"\n"))
+
val () = Env.action_two "proxyPass"
("from", Env.string, "to", Env.string)
(fn (from, to) =>
@@ -612,10 +697,11 @@ val () = Env.action_three "rewriteRule"
("from", Env.string, "to", Env.string, "flags", Env.list flag)
(fn (from, to, flags) =>
(checkRewrite ();
- write "\tRewriteRule\t";
+ write "\tRewriteRule\t\"";
write from;
- write "\t";
+ write "\"\t\"";
write to;
+ write "\"";
case flags of
[] => ()
| flag::rest => (write " [";
@@ -629,10 +715,11 @@ val () = Env.action_three "rewriteCond"
("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
(fn (from, to, flags) =>
(checkRewrite ();
- write "\tRewriteCond\t";
+ write "\tRewriteCond\t\"";
write from;
- write "\t";
+ write "\"\t\"";
write to;
+ write "\"";
case flags of
[] => ()
| flag::rest => (write " [";
@@ -646,9 +733,9 @@ val () = Env.action_one "rewriteBase"
("prefix", Env.string)
(fn prefix =>
(checkRewrite ();
- write "\tRewriteBase\t";
+ write "\tRewriteBase\t\"";
write prefix;
- write "\n"))
+ write "\"\n"))
val () = Env.action_one "rewriteLogLevel"
("level", Env.int)
@@ -789,7 +876,7 @@ val () = Env.action_one "authType"
write "\n";
case ty of
"kerberos" =>
- write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
+ 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"
| _ => ())
else
print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
@@ -808,6 +895,13 @@ val () = Env.action_one "authUserFile"
write name;
write "\n"))
+val () = Env.action_one "authGroupFile"
+ ("file", Env.string)
+ (fn name =>
+ (write "\tAuthGroupFile ";
+ write name;
+ write "\n"))
+
val () = Env.action_none "requireValidUser"
(fn () => write "\tRequire valid-user\n")
@@ -914,6 +1008,17 @@ val () = Env.action_two "addDescription"
app (fn pat => (write " "; write pat)) pats;
write "\n"))
+val () = Env.action_two "addIcon"
+ ("icon", Env.string, "patterns", Env.list Env.string)
+ (fn (icon, pats) =>
+ case pats of
+ [] => ()
+ | _ => (write "\tAddIcon \"";
+ write icon;
+ write "\"";
+ app (fn pat => (write " "; write pat)) pats;
+ write "\n"))
+
val () = Env.action_one "indexOptions"
("options", Env.list autoindex_option)
(fn opts =>
@@ -927,6 +1032,15 @@ val () = Env.action_one "indexOptions"
(write "="; write arg)) arg)) opts;
write "\n"))
+val () = Env.action_one "indexIgnore"
+ ("patterns", Env.list Env.string)
+ (fn pats =>
+ case pats of
+ [] => ()
+ | _ => (write "\tIndexIgnore";
+ app (fn pat => (write " "; write pat)) pats;
+ write "\n"))
+
val () = Env.action_one "set_indexOptions"
("options", Env.list autoindex_option)
(fn opts =>
@@ -977,9 +1091,47 @@ val () = Env.action_one "diskCache"
(fn path => (write "\tCacheEnable disk \"";
write path;
write "\"\n"))
-
+
+val () = Env.action_one "phpVersion"
+ ("version", php_version)
+ (fn version => (write "\tAddHandler x-httpd-php";
+ write (Int.toString version);
+ write " .php .phtml\n"))
+
+val () = Env.action_two "addType"
+ ("mime type", Env.string, "extension", Env.string)
+ (fn (mt, ext) => (write "\tAddType ";
+ write mt;
+ write " ";
+ write ext;
+ write "\n"))
+
+val filter = fn (EVar "includes", _) => SOME "INCLUDES"
+ | (EVar "deflate", _) => SOME "DEFLATE"
+ | _ => NONE
+
+val () = Env.action_two "addOutputFilter"
+ ("filters", Env.list filter, "extensions", Env.list Env.string)
+ (fn (f :: fs, exts as (_ :: _)) =>
+ (write "\tAddOutputFilter ";
+ write f;
+ app (fn f => (write ";"; write f)) fs;
+ app (fn ext => (write " "; write ext)) exts;
+ write "\n")
+ | _ => ())
+
+val () = Env.action_one "sslCertificateChainFile"
+ ("ssl_cacert_path", Env.string)
+ (fn cacert =>
+ if !sslEnabled then
+ (write "\tSSLCertificateChainFile \"";
+ write cacert;
+ write "\"\n")
+ else
+ print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
+
val () = Domain.registerResetLocal (fn () =>
- ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+ ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
val () = Domain.registerDescriber (Domain.considerAll
[Domain.Extension {extension = "vhost",
@@ -987,4 +1139,27 @@ val () = Domain.registerDescriber (Domain.considerAll
Domain.Extension {extension = "vhost_ssl",
heading = fn host => "SSL web vhost " ^ host ^ ":"}])
+val () = Env.action_none "testNoHtaccess"
+ (fn path => write "\tAllowOverride None\n")
+
+fun writeWaklogUserFile () =
+ let
+ val users = Acl.users ()
+ val outf = TextIO.openOut Config.Apache.waklogUserFile
+ in
+ app (fn user => if String.isSuffix "_admin" user then
+ ()
+ else
+ (TextIO.output (outf, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
+ TextIO.output (outf, user);
+ TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
+ TextIO.output (outf, user);
+ TextIO.output (outf, "\n\n\n"))) users;
+ TextIO.closeOut outf
+ end
+
+val () = Domain.registerOnUsersChange writeWaklogUserFile
+
end