Expand valid proxyHosts

[hcoop/domtool2.git] / src / plugins / apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index d97ac8b..3b535c3 100644 (file)
--- 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
@@ -68,18 +68,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)
@@ -241,6 +245,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 +439,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 +502,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 +606,8 @@ val () = Env.container_one "location"
              inLocal := true),
          fn () => (write "\t</Location>\n";
                    inLocal := false;
-                   localRewriteEnabled := false))
+                   localRewriteEnabled := false;
+                   localExpiresEnabled := false))
 
 val () = Env.container_one "directory"
         ("directory", Env.string)
@@ -596,7 +618,8 @@ val () = Env.container_one "directory"
              inLocal := true),
          fn () => (write "\t</Directory>\n";
                    inLocal := false;
-                   localRewriteEnabled := false))
+                   localRewriteEnabled := false;
+                   localExpiresEnabled := false))
 
 val () = Env.container_one "filesMatch"
         ("regexp", Env.string)
@@ -605,7 +628,8 @@ val () = Env.container_one "filesMatch"
              write prefix;
              write "\">\n"),
          fn () => (write "\t</FilesMatch>\n";
-                   localRewriteEnabled := false))
+                   localRewriteEnabled := false;
+                   localExpiresEnabled := false))
 
 fun checkRewrite () =
     if !inLocal then
@@ -620,6 +644,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 +669,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) =>
@@ -1082,4 +1137,24 @@ val () = Domain.registerDescriber (Domain.considerAll
 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, "<Location /~");
+                            TextIO.output (outf, user);
+                            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</Location>\n\n"))) users;
+       TextIO.closeOut outf
+    end
+
+val () = Domain.registerOnUsersChange writeWaklogUserFile
+
 end