Add apache header support

diff --git a/src/env.sig b/src/env.sig
index 6668c5e..87ad9b5 100644 (file)
--- a/src/env.sig
+++ b/src/env.sig
@@ -77,6 +77,9 @@ signature ENV = sig
     val action_four : string
                       -> string * 'a arg * string * 'b arg * string * 'c arg * string * 'd arg
                       -> ('a * 'b * 'c * 'd -> unit) -> unit
+    val action_five : string
+                      -> string * 'a arg * string * 'b arg * string * 'c arg * string * 'd arg * string * 'e arg
+                      -> ('a * 'b * 'c * 'd * 'e -> 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 be8438a..ef6b69e 100644 (file)
--- a/src/env.sml
+++ b/src/env.sml
@@ -160,6 +160,18 @@ fun four func (name1, arg1, name2, arg2, name3, arg3, name4, arg4) f (_, [e1, e2
                                                  SM.empty))
   | four func _ _ (_, es) = badArgs (func, es)
 
+fun five func (name1, arg1, name2, arg2, name3, arg3, name4, arg4, name5, arg5)
+  f (_, [e1, e2, e3, e4, e5]) =
+    (case (arg1 e1, arg2 e2, arg3 e3, arg4 e4, arg5 e5) of
+        (NONE, _, _, _, _) => badArg (func, name1, e1)
+       | (_, NONE, _, _, _) => badArg (func, name2, e2)
+       | (_, _, NONE, _, _) => badArg (func, name3, e3)
+       | (_, _, _, NONE, _) => badArg (func, name4, e4)
+       | (_, _, _, _, NONE) => badArg (func, name5, e5)
+       | (SOME v1, SOME v2, SOME v3, SOME v4, SOME v5) => (f (v1, v2, v3, v4, v5);
+                                                 SM.empty))
+  | five func _ _ (_, es) = badArgs (func, es)
+
 fun noneV func f (evs, []) = (f evs;
                              SM.empty)
   | noneV func _ (_, es) = badArgs (func, es)
@@ -201,6 +213,7 @@ 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 action_five name args f = registerAction (name, five 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 813051c..5407f95 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -676,6 +676,37 @@ val () = Env.action_four "expiresByType"
              write inter;
              write "\"\n"))
 
+val header_type = fn (EVar "set", _) => SOME "set"
+                    | (EVar "append", _) => SOME "append"
+                    | (EVar "merge", _) => SOME "merge"
+                    | (EVar "add", _) => SOME "add"
+                    | (EVar "unset", _) => SOME "unset"
+                    | (EVar "echo", _) => SOME "echo"
+                    | (EVar "edit", _) => SOME "edit"
+                    | _ => NONE
+
+val () = Env.action_five "header"
+        ("action", header_type, "name", Env.string, "value", Env.string,
+     "replacement", Env.string, "early_env", Env.string)
+        (fn (action, name, value, replacement, early_env) =>
+                 (write "\tHeader\t";
+                  write action;
+                  write "\t";
+                  write name;
+                  write "\t";
+                  write value;
+               if (not (((length replacement) = 0) orelse (null replacement))) then
+                 (write "\t";
+                  write replacement)
+               else
+                 ();
+               if (not (((length early_env) = 0) orelse (null early_env))) then
+                 (write "\t";
+                  write early_env)
+               else
+                 ();
+                  write "\n"))
+
 val () = Env.action_two "proxyPass"
         ("from", Env.string, "to", Env.string)
         (fn (from, to) =>