From: Adam Chlipala Date: Tue, 14 Apr 2009 14:07:25 +0000 (+0000) Subject: Some mod_expires support X-Git-Tag: release_2010-11-19~11 X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/fb09779a844e6ebb2388d68ef1170c816b6bc07c Some mod_expires support --- diff --git a/lib/mod_expires.dtl b/lib/mod_expires.dtl new file mode 100644 index 0000000..649fca4 --- /dev/null +++ b/lib/mod_expires.dtl @@ -0,0 +1,20 @@ +{{Support for Apache's mod_expires}} + +extern type mime_type; + +extern type interval_base; +extern val access : interval_base; +extern val modification : interval_base; + +extern type interval; +extern val years : interval; +extern val months : interval; +extern val weeks : interval; +extern val days : interval; +extern val hours : interval; +extern val minutes : interval; +extern val seconds : interval; + +extern val expiresByType : mime_type -> interval_base -> int -> interval -> [^Vhost]; +{{See + Apache documentation.}} diff --git a/src/domain.sml b/src/domain.sml index 63b039c..ffa03c4 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -235,6 +235,10 @@ val _ = Env.type_one "node" Env.string validNode +val _ = Env.type_one "mime_type" + Env.string + (CharVector.exists (fn ch => ch = #"/")) + val _ = Env.registerFunction ("your_ip_to_ip", fn [e] => SOME e | _ => NONE) diff --git a/src/env.sig b/src/env.sig index 0a50620..8e5962c 100644 --- a/src/env.sig +++ b/src/env.sig @@ -73,6 +73,9 @@ signature ENV = sig val action_three : string -> string * 'a arg * string * 'b arg * string * 'c arg -> ('a * 'b * 'c -> unit) -> unit + val action_four : string + -> string * 'a arg * string * 'b arg * string * 'c arg * string * 'd arg + -> ('a * 'b * 'c * 'd -> unit) -> unit val actionV_none : string -> (env_vars -> unit) -> unit val actionV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) -> unit diff --git a/src/env.sml b/src/env.sml index ef710c1..8ebcaf4 100644 --- a/src/env.sml +++ b/src/env.sml @@ -149,6 +149,16 @@ fun three func (name1, arg1, name2, arg2, name3, arg3) f (_, [e1, e2, e3]) = SM.empty)) | three func _ _ (_, es) = badArgs (func, es) +fun four func (name1, arg1, name2, arg2, name3, arg3, name4, arg4) f (_, [e1, e2, e3, e4]) = + (case (arg1 e1, arg2 e2, arg3 e3, arg4 e4) of + (NONE, _, _, _) => badArg (func, name1, e1) + | (_, NONE, _, _) => badArg (func, name2, e2) + | (_, _, NONE, _) => badArg (func, name3, e3) + | (_, _, _, NONE) => badArg (func, name4, e4) + | (SOME v1, SOME v2, SOME v3, SOME v4) => (f (v1, v2, v3, v4); + SM.empty)) + | four func _ _ (_, es) = badArgs (func, es) + fun noneV func f (evs, []) = (f evs; SM.empty) | noneV func _ (_, es) = badArgs (func, es) @@ -189,6 +199,7 @@ fun action_none name f = registerAction (name, none name f) fun action_one name args f = registerAction (name, one name args f) fun action_two name args f = registerAction (name, two name args f) fun action_three name args f = registerAction (name, three name args f) +fun action_four name args f = registerAction (name, four name args f) fun actionV_none name f = registerAction (name, fn (env, _) => (f env; env)) fun actionV_one name args f = registerAction (name, oneV name args f) diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 0b0b11d..adc579e 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -1,5 +1,5 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) - * Copyright (c) 2006-2007, Adam Chlipala + * Copyright (c) 2006-2009, Adam Chlipala * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -241,6 +241,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 +435,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 @@ -483,6 +498,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 +602,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 +614,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 +624,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 +640,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 +665,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) =>