X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/563e77927eb5faaae4571bd2b0811de590368581..58f4ce3bac23ceef3d84ab97144d1b4b50f27606:/src/plugins/apache.sml diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 0b0b11d..f6017dd 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 @@ -68,18 +69,22 @@ val _ = Env.type_one "proxy_target" fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets in case String.fields (fn ch => ch = #":") s of - "http" :: "//localhost" :: rest => + "http" :: host :: rest => let val rest = String.concatWith ":" rest in - 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 () - | SOME n => n > 1024 orelse default ()) - | _ => default () + 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 () + | SOME n => n > 1024 orelse default ()) + | _ => default () + else + default () end | _ => default () end) @@ -113,10 +118,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) @@ -154,7 +167,7 @@ val defaults = [("WebPlaces", (fn () => (EVar "true", dl))), ("PhpVersion", (TBase "php_version", dl), - (fn () => (EVar "php4", dl)))] + (fn () => (EVar "php5", dl)))] val () = app Defaults.registerDefault defaults @@ -202,6 +215,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 "*" @@ -241,6 +255,19 @@ 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 () => ()) @@ -422,6 +449,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 @@ -457,8 +486,7 @@ fun vhostPost () = (!post (); write "\n"; app (TextIO.closeOut o #2) (!vhostFiles)) -val php_version = fn (EVar "php4", _) => SOME 4 - | (EVar "php5", _) => SOME 5 +val php_version = fn (EVar "php5", _) => SOME 5 | _ => NONE fun vhostBody (env, makeFullHost) = @@ -483,6 +511,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, @@ -585,7 +615,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) @@ -596,7 +627,8 @@ 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) @@ -605,7 +637,8 @@ val () = Env.container_one "filesMatch" write prefix; write "\">\n"), fn () => (write "\t\n"; - localRewriteEnabled := false)) + localRewriteEnabled := false; + localExpiresEnabled := false)) fun checkRewrite () = if !inLocal then @@ -620,6 +653,19 @@ 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) => @@ -632,6 +678,24 @@ val () = Env.action_three "localProxyRewrite" 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) => @@ -852,6 +916,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") @@ -1070,6 +1141,16 @@ val () = Env.action_two "addOutputFilter" 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/*")))