From d5754b53e4f119674b9d8a0bdf40bf92f6007d12 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 6 Aug 2006 22:11:40 +0000
Subject: [PATCH] URL handling

---
 lib/alias.dtl          |  2 +-
 lib/domain.dtl         |  3 +++
 lib/urls.dtl           | 11 +++++++++++
 src/domain.sml         |  3 +++
 src/plugins/apache.sml | 28 ++++++++++++++++++++++++++++
 tests/testApache.dtl   |  4 ++++
 6 files changed, 50 insertions(+), 1 deletion(-)
 create mode 100644 lib/urls.dtl

diff --git a/lib/alias.dtl b/lib/alias.dtl
index b7ccae4..8fe2246 100644
--- a/lib/alias.dtl
+++ b/lib/alias.dtl
@@ -32,7 +32,7 @@ extern val aliasPrim : aliasSource -> aliasTarget -> [Domain] {MailNodes: [node]
 {{Request redirection of all mail from the source to the target, specifying on
   which nodes this redirection should be applied.}}
 
-val alias = \user -> \email -> aliasPrim (userSource user) (addressTarget email);
+val emailAlias = \user -> \email -> aliasPrim (userSource user) (addressTarget email);
 {{Redirect mail for the user at the current domain to the e-mail address.}}
 val aliasMulti = \user -> \emails -> aliasPrim (userSource user) (addressesTarget emails);
 {{Redirect mail for the user at the current domain to all of the e-mail
diff --git a/lib/domain.dtl b/lib/domain.dtl
index 62256ed..0ab7716 100644
--- a/lib/domain.dtl
+++ b/lib/domain.dtl
@@ -3,6 +3,9 @@
 extern type no_spaces;
 {{Any string with no space characters}}
 
+extern type no_newlines;
+{{Any string with no newline characters}}
+
 extern type ip;
 {{An IP address}}
 
diff --git a/lib/urls.dtl b/lib/urls.dtl
new file mode 100644
index 0000000..89bac62
--- /dev/null
+++ b/lib/urls.dtl
@@ -0,0 +1,11 @@
+{{Basic Apache URL handling}}
+
+extern val alias : location -> your_path -> [Vhost];
+{{All requests for the location should be served from the path.}}
+
+extern val scriptAlias : location -> your_path -> [Vhost];
+{{Like <tt>alias</tt>, for Apache's <tt>ScriptAlias</tt>}}
+
+extern val errorDocument : no_spaces -> no_newlines -> [^Vhost];
+{{The first argument specifies an HTTP error code, which should be handled using
+  the second argument, which is either a URL or a string to display.}}
diff --git a/src/domain.sml b/src/domain.sml
index 91d8005..71d448d 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -74,6 +74,9 @@ fun yourPath path =
 val _ = Env.type_one "no_spaces"
 		     Env.string
 		     (CharVector.all (fn ch => not (Char.isSpace ch)))
+val _ = Env.type_one "no_newlines"
+		     Env.string
+		     (CharVector.all (fn ch => ch <> #"\n" andalso ch <> #"\r"))
 
 val _ = Env.type_one "ip"
 	Env.string
diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 878204b..4ea8f22 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -303,4 +303,32 @@ val () = Env.action_three "rewriteCond"
 				 write "]");
 	      write "\n"))
 
+val () = Env.action_two "alias"
+	 ("from", Env.string, "to", Env.string)
+	 (fn (from, to) =>
+	     (write "\tAlias\t";
+	      write from;
+	      write " ";
+	      write to;
+	      write "\n"))
+
+val () = Env.action_two "scriptAlias"
+	 ("from", Env.string, "to", Env.string)
+	 (fn (from, to) =>
+	     (write "\tScriptAlias\t";
+	      write from;
+	      write " ";
+	      write to;
+	      write "\n"))
+
+val () = Env.action_two "errorDocument"
+	 ("code", Env.string, "handler", Env.string)
+	 (fn (code, handler) =>
+	     (write "\tErrorDocument\t";
+	      write code;
+	      write " ";
+	      write handler;
+	      write "\n"))
+
+
 end
diff --git a/tests/testApache.dtl b/tests/testApache.dtl
index 7e57594..c8438ff 100644
--- a/tests/testApache.dtl
+++ b/tests/testApache.dtl
@@ -25,6 +25,9 @@ domain "hcoop.net" with
 		proxyPass "/proxyLand" "http://localhost:1234/otherProxyLand";
 		proxyPassReverse "/proxyLand" "http://localhost:1234/otherProxyLand";
 
+		scriptAlias "/cgi-bin/that-script" "/home/adamc/cgi/here-it-is";
+		errorDocument "404" "I just couldn't find it.";
+
 		directory "/home/adamc/thisPlace" with
 			rewriteRule "A" "B" [];
 		end
@@ -32,5 +35,6 @@ domain "hcoop.net" with
 
 	vhost "lists" with
 		proxyPass "/mailman" "http://hcoop.net/cgi-bin/mailman";
+		alias "/doc/mailman" "/home/adamc/mailman"
 	end
 end
-- 
2.20.1