From 2882ee37fded46346977da456ae793f3e6a3bfac Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 6 Aug 2006 21:49:23 +0000
Subject: [PATCH] Location and Directory

---
 lib/apache.dtl         | 10 ++++++++++
 lib/mod_rewrite.dtl    |  6 +++---
 src/plugins/apache.sml | 28 ++++++++++++++++++++++++++++
 src/tycheck.sml        |  2 ++
 tests/testApache.dtl   |  8 ++++++++
 5 files changed, 51 insertions(+), 3 deletions(-)

diff --git a/lib/apache.dtl b/lib/apache.dtl
index 43dd928..70edc96 100644
--- a/lib/apache.dtl
+++ b/lib/apache.dtl
@@ -15,3 +15,13 @@ extern val vhost : host -> Vhost => [Domain]
   user and group dynamic content generators should be run as, the filesystem
   path to the static content root, and the e-mail address to which error pages
   should direct visitors.}}
+
+context Location;
+
+extern type location;
+{{A valid URI prefix}}
+
+extern val location : location -> ^Vhost & Location => [Vhost & !Location];
+extern val directory : your_path -> ^Vhost & Location => [Vhost & !Location];
+{{Set some configuration specific to a URI prefix or filesystem directory,
+  respectively.}}
diff --git a/lib/mod_rewrite.dtl b/lib/mod_rewrite.dtl
index a7c363e..c0b939c 100644
--- a/lib/mod_rewrite.dtl
+++ b/lib/mod_rewrite.dtl
@@ -46,18 +46,18 @@ extern type mod_rewrite_cond_flag;
 extern val cond_nocase : mod_rewrite_cond_flag;
 extern val ornext : mod_rewrite_cond_flag;
 
-extern val rewriteRule : no_spaces -> no_spaces -> [mod_rewrite_flag] -> [Vhost];
+extern val rewriteRule : no_spaces -> no_spaces -> [mod_rewrite_flag] -> [^Vhost];
 {{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_rewrite.html#rewriterule">Apache
   documentation for <tt>RewriteRule</tt></a>.}}
 
-extern val rewriteCond: no_spaces -> no_spaces -> [mod_rewrite_cond_flag] -> [Vhost];
+extern val rewriteCond: no_spaces -> no_spaces -> [mod_rewrite_cond_flag] -> [^Vhost];
 {{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_rewrite.html#rewritecond">Apache
   documentation for <tt>RewriteCond</tt></a>.}}
 
 extern type proxy_port;
 {{A port number above 1024}}
 
-extern val localProxyRewrite : no_spaces -> no_spaces -> proxy_port -> [Vhost];
+extern val localProxyRewrite : no_spaces -> no_spaces -> proxy_port -> [^Vhost];
 {{All requests matching the regular expression in the first argument are
   redirected to another HTTPD running on localhost at the given port, generating
   the new URI by substituting variables in the second argument as per Apache
diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index a959023..878204b 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -47,6 +47,18 @@ val _ = Env.type_one "rewrite_arg"
 	Env.string
 	(CharVector.all Char.isAlphaNum)
 
+fun validLocation s =
+    size s > 0 andalso size s < 1000 andalso CharVector.all
+						 (fn ch => Char.isAlphaNum ch
+							   orelse ch = #"-"
+							   orelse ch = #"_"
+							   orelse ch = #"."
+							   orelse ch = #"/") s
+
+val _ = Env.type_one "location"
+	Env.string
+	validLocation
+
 val dl = ErrorMsg.dummyLoc
 
 val _ = Main.registerDefault ("WebNodes",
@@ -204,6 +216,22 @@ val () = Env.containerV_one "vhost"
 	  fn () => (write "</VirtualHost>\n";
 		    app TextIO.closeOut (!vhostFiles)))
 
+val () = Env.container_one "location"
+	 ("prefix", Env.string)
+	 (fn prefix =>
+	     (write "\t<Location ";
+	      write prefix;
+	      write ">\n"),
+	  fn () => write "\t</Location>\n")
+
+val () = Env.container_one "directory"
+	 ("directory", Env.string)
+	 (fn directory =>
+	     (write "\t<Directory ";
+	      write directory;
+	      write ">\n"),
+	  fn () => write "\t</Directory>\n")
+
 fun checkRewrite () =
     if !rewriteEnabled then
 	()
diff --git a/src/tycheck.sml b/src/tycheck.sml
index 6d58e43..152eaf7 100644
--- a/src/tycheck.sml
+++ b/src/tycheck.sml
@@ -170,6 +170,8 @@ fun predImplies (p1All as (p1, _), p2All as (p2, _)) =
       | (_, CPrefix p2) => predImplies (p1All, p2)
 
       | (CNot p1, CNot p2) => predImplies (p2, p1)
+      | (CRoot, CNot (CConst _, _)) => true
+      | (CConst s1, CNot (CConst s2, _)) => s1 <> s2
 
       | _ => false
 
diff --git a/tests/testApache.dtl b/tests/testApache.dtl
index 13cbed3..7e57594 100644
--- a/tests/testApache.dtl
+++ b/tests/testApache.dtl
@@ -15,11 +15,19 @@ domain "hcoop.net" with
 		localProxyRewrite "^/(.*)$" "$1" 6666;
 		rewriteCond "hi" "there" [ornext];
 		rewriteRule "^/foo.html" "/bar.html" [redirectWith redir300, nosubreq];
+
+		location "/theMorgue" with
+			rewriteRule "A" "B" [];
+		end
 	end;
 
 	vhost "proxy" with
 		proxyPass "/proxyLand" "http://localhost:1234/otherProxyLand";
 		proxyPassReverse "/proxyLand" "http://localhost:1234/otherProxyLand";
+
+		directory "/home/adamc/thisPlace" with
+			rewriteRule "A" "B" [];
+		end
 	end;
 
 	vhost "lists" with
-- 
2.20.1