From b096303256418167cb3d9f05e95ee13ef063dc20 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 22 Nov 2007 17:29:46 +0000
Subject: [PATCH] Add end_in_slash and use it to fix moinMoin; do extra
 reduction during evaluation

---
 lib/domain.dtl   |  2 ++
 lib/web_apps.dtl |  2 +-
 src/domain.sml   | 12 ++++++++++++
 src/eval.sml     |  2 +-
 4 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/lib/domain.dtl b/lib/domain.dtl
index 2b17089..3d9b088 100644
--- a/lib/domain.dtl
+++ b/lib/domain.dtl
@@ -43,6 +43,8 @@ extern type your_path;
 {{A filesystem path that you're allowed to write to.
   The set of permitted values is generated from a set of roots by closing it
   under the subdirectory relation.}}
+extern val end_in_slash : your_path -> your_path;
+{{Add a slash at the end of a path, if there isn't one already.}}
 
 extern type readable_path;
 {{Like [your_path], but also includes some paths that everyone is allowed to
diff --git a/lib/web_apps.dtl b/lib/web_apps.dtl
index db84444..f17e8e8 100644
--- a/lib/web_apps.dtl
+++ b/lib/web_apps.dtl
@@ -22,7 +22,7 @@ val addMoinMoin = begin
   script <- Script;
 
   alias htdocs "/usr/share/moin/htdocs";
-  scriptAlias prefix script
+  scriptAlias prefix (end_in_slash script)
 end;
 {{Add a MoinMoin wiki to a vhost.}}
 
diff --git a/src/domain.sml b/src/domain.sml
index 0b3a0f5..f8464f2 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -202,10 +202,22 @@ val _ = Env.registerFunction ("dns_node_to_node",
 val _ = Env.registerFunction ("mail_node_to_node",
 			      fn [e] => SOME e
 			       | _ => NONE)
+
+
 open Ast
 
 val dl = ErrorMsg.dummyLoc
 
+val _ = Env.registerFunction ("end_in_slash",
+			      fn [(EString "", _)] => SOME (EString "/", dl)
+			       | [(EString s, _)] =>
+				 SOME (EString (if String.sub (s, size s - 1) = #"/" then
+						    s
+						else
+						    s ^ "/"), dl)
+			       | _ => NONE)
+
+
 val nsD = (EString Config.defaultNs, dl)
 val serialD = (EVar "serialAuto", dl)
 val refD = (EInt Config.defaultRefresh, dl)
diff --git a/src/eval.sml b/src/eval.sml
index 8789eac..1fec487 100644
--- a/src/eval.sml
+++ b/src/eval.sml
@@ -102,7 +102,7 @@ fun exec' evs (eAll as (e, _)) =
 	in
 	    case Env.action prim of
 		NONE => raise Fail "Unbound primitive action"
-	      | SOME action => action (evs, args)
+	      | SOME action => action (evs, List.map (Reduce.reduceExp Env.empty) args)
 	end
 
 fun exec evs e =
-- 
2.20.1