Mercurial > urweb
changeset 1847:8958b580d026
Change Name_js to skip code snippets that depend on the CSRF-protection signature
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Mon, 01 Apr 2013 10:13:49 -0400 |
| parents | bcae365efa85 |
| children | e15234fbb163 |
| files | Makefile.am Makefile.in src/jscomp.sml src/mono_util.sig src/mono_util.sml src/name_js.sml |
| diffstat | 6 files changed, 55 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/Makefile.am Tue Mar 19 19:10:31 2013 -0400 +++ b/Makefile.am Mon Apr 01 10:13:49 2013 -0400 @@ -17,7 +17,7 @@ .PHONY: smlnj mlton package reauto -smlnj: src/urweb.cm +smlnj: src/urweb.cm xml/entities.sml mlton: bin/urweb clean-local:
--- a/Makefile.in Tue Mar 19 19:10:31 2013 -0400 +++ b/Makefile.in Mon Apr 01 10:13:49 2013 -0400 @@ -745,7 +745,7 @@ .PHONY: smlnj mlton package reauto -smlnj: src/urweb.cm +smlnj: src/urweb.cm xml/entities.sml mlton: bin/urweb clean-local:
--- a/src/jscomp.sml Tue Mar 19 19:10:31 2013 -0400 +++ b/src/jscomp.sml Mon Apr 01 10:13:49 2013 -0400 @@ -507,13 +507,14 @@ 0 => s | _ => jsifyStringMulti (n - 1, jsifyString s) - fun deStrcat level (all as (e, _)) = + fun deStrcat level (all as (e, loc)) = case e of EPrim (Prim.String s) => jsifyStringMulti (level, s) | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2 | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\"" - | _ => (Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)]; - raise Fail "Jscomp: deStrcat") + | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code"; + Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)]; + "") val quoteExp = quoteExp loc in
--- a/src/mono_util.sig Tue Mar 19 19:10:31 2013 -0400 +++ b/src/mono_util.sig Mon Apr 01 10:13:49 2013 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008, Adam Chlipala +(* Copyright (c) 2008, 2013, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -117,6 +117,10 @@ decl : 'context * Mono.decl' * 'state -> Mono.decl' * 'state, bind : 'context * binder -> 'context} -> 'context -> 'state -> Mono.decl -> Mono.decl * 'state + + val exists : {typ : Mono.typ' -> bool, + exp : Mono.exp' -> bool, + decl : Mono.decl' -> bool} -> Mono.decl -> bool end structure File : sig
--- a/src/mono_util.sml Tue Mar 19 19:10:31 2013 -0400 +++ b/src/mono_util.sml Mon Apr 01 10:13:49 2013 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008, Adam Chlipala +(* Copyright (c) 2008, 2013, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -654,6 +654,25 @@ S.Continue v => v | S.Return _ => raise Fail "MonoUtil.Decl.foldMapB: Impossible" +fun exists {typ, exp, decl} k = + case mapfold {typ = fn c => fn () => + if typ c then + S.Return () + else + S.Continue (c, ()), + exp = fn e => fn () => + if exp e then + S.Return () + else + S.Continue (e, ()), + decl = fn d => fn () => + if decl d then + S.Return () + else + S.Continue (d, ())} k () of + S.Return _ => true + | S.Continue _ => false + end structure File = struct
--- a/src/name_js.sml Tue Mar 19 19:10:31 2013 -0400 +++ b/src/name_js.sml Mon Apr 01 10:13:49 2013 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2012, Adam Chlipala +(* Copyright (c) 2012-2013, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -72,6 +72,28 @@ fun rewrite file = let + fun isTricky' dontName e = + case e of + ENamed n => IS.member (dontName, n) + | EFfiApp ("Basis", "sigString", _) => true + | _ => false + + fun isTricky dontName = U.Decl.exists {typ = fn _ => false, + exp = isTricky' dontName, + decl = fn _ => false} + + fun isTrickyE dontName = U.Exp.exists {typ = fn _ => false, + exp = isTricky' dontName} + + val dontName = foldl (fn (d, dontName) => + if isTricky dontName d then + case #1 d of + DVal (_, n, _, _, _) => IS.add (dontName, n) + | DValRec vis => foldl (fn ((_, n, _, _, _), dontName) => IS.add (dontName, n)) dontName vis + | _ => dontName + else + dontName) IS.empty (#1 file) + val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) => let val (d, (nextName, newDs)) = @@ -96,7 +118,7 @@ EApp (e, arg) => isTrulySimple arg andalso isAlreadySimple e | _ => isTrulySimple e in - if isAlreadySimple e' then + if isAlreadySimple e' orelse isTrickyE dontName e' then (e, st) else let