summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@csail.mit.edu>2019-04-15 16:20:12 -0400
committerGravatar Adam Chlipala <adamc@csail.mit.edu>2019-04-15 16:20:12 -0400
commita19e53017364ceddbba557fb363ca26b273f89da (patch)
tree7045f1d0231c7ccad224b04e23e52409dde74603 /src/monoize.sml
parentfb0d4f6c8492cc08bbf50609daa2cda1dc53a796 (diff)
Catch clashing rewritten URL prefixes
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml32
1 files changed, 32 insertions, 0 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 48001a13..97ad1505 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -50,6 +50,36 @@ structure RM = BinaryMapFn(struct
(L'.TRecord r2, E.dummySpan))
end)
+local
+ val url_prefixes = ref []
+in
+
+fun reset () = url_prefixes := []
+
+fun addPrefix prefix =
+ let
+ fun isPrefix s1 s2 =
+ String.isPrefix s1 s2
+ andalso (size s1 = size s2
+ orelse String.sub (s2, size s1) = #"/")
+ in
+ if List.exists (fn prefix' =>
+ let
+ fun tryOne prefix' prefix =
+ isPrefix prefix' prefix
+ andalso (ErrorMsg.error ("Conflicting URL prefixes for page handlers: \"" ^ prefix' ^ "\" is a prefix of \"" ^ prefix ^ "\".");
+ true)
+ in
+ tryOne prefix' prefix
+ orelse tryOne prefix prefix'
+ end) (!url_prefixes) then
+ ()
+ else
+ url_prefixes := prefix :: !url_prefixes
+ end
+
+end
+
val nextPvar = MonoFooify.nextPvar
val pvars = ref (RM.empty : (int * (string * int * L'.typ) list) RM.map)
val pvarDefs = MonoFooify.pvarDefs
@@ -4233,6 +4263,7 @@ fun monoDecl (env, fm) (all as (d, loc)) =
| L.DExport (ek, n, b) =>
let
val (_, t, _, s) = Env.lookupENamed env n
+ val () = addPrefix s
fun unwind (t, args) =
case #1 t of
@@ -4392,6 +4423,7 @@ datatype expungable = Client | Channel
fun monoize env file =
let
+ val () = reset ()
val () = pvars := RM.empty
(* Calculate which exported functions need cookie signature protection *)