diff options
| author |  Adam Chlipala <adamc@csail.mit.edu> | 2019-04-15 16:20:12 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@csail.mit.edu> | 2019-04-15 16:20:12 -0400 |
| commit | a19e53017364ceddbba557fb363ca26b273f89da (patch) | |
| tree | 7045f1d0231c7ccad224b04e23e52409dde74603 /src/monoize.sml | |
| parent | fb0d4f6c8492cc08bbf50609daa2cda1dc53a796 (diff) | |
Catch clashing rewritten URL prefixes
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 32 |
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 *) |