Add end_in_slash and use it to fix moinMoin; do extra reduction during evaluation

diff --git a/lib/domain.dtl b/lib/domain.dtl
index 2b17089..3d9b088 100644 (file)
--- 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.}}
 {{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
 
 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 (file)
--- 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";
   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.}}
 
 end;
 {{Add a MoinMoin wiki to a vhost.}}
 

diff --git a/src/domain.sml b/src/domain.sml
index 0b3a0f5..f8464f2 100644 (file)
--- 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)
 val _ = Env.registerFunction ("mail_node_to_node",
                              fn [e] => SOME e
                               | _ => NONE)

+
+

 open Ast
 
 val dl = ErrorMsg.dummyLoc
 
 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)
 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 (file)
--- 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"
        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 =
        end
 
 fun exec evs e =