Mercurial > urweb
diff src/compiler.sml @ 769:efceae06df17
allow/deny working in Mono_opt
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 02 May 2009 13:37:52 -0400 |
parents | 3b7e46790fa7 |
children | d20d6afc1206 |
line wrap: on
line diff
--- a/src/compiler.sml Sat May 02 13:23:07 2009 -0400 +++ b/src/compiler.sml Sat May 02 13:37:52 2009 -0400 @@ -51,7 +51,9 @@ clientOnly : Settings.ffi list, serverOnly : Settings.ffi list, jsFuncs : (Settings.ffi * string) list, - rewrites : Settings.rewrite list + rewrites : Settings.rewrite list, + filterUrl : Settings.rule list, + filterMime : Settings.rule list } type ('src, 'dst) phase = { @@ -314,6 +316,8 @@ val serverOnly = ref [] val jsFuncs = ref [] val rewrites = ref [] + val url = ref [] + val mime = ref [] val libs = ref [] fun finish sources = @@ -337,6 +341,8 @@ serverOnly = rev (!serverOnly), jsFuncs = rev (!jsFuncs), rewrites = rev (!rewrites), + filterUrl = rev (!url), + filterMime = rev (!mime), sources = sources } @@ -372,6 +378,8 @@ serverOnly = #serverOnly old @ #serverOnly new, jsFuncs = #jsFuncs old @ #jsFuncs new, rewrites = #rewrites old @ #rewrites new, + filterUrl = #filterUrl old @ #filterUrl new, + filterMime = #filterMime old @ #filterMime new, sources = #sources old @ #sources new } in @@ -397,6 +405,19 @@ else (Settings.Exact, s) + fun parseFkind s = + case s of + "url" => url + | "mime" => mime + | _ => (ErrorMsg.error "Bad filter kind"; + url) + + fun parsePattern s = + if size s > 0 andalso String.sub (s, size s - 1) = #"*" then + (Settings.Prefix, String.substring (s, 0, size s - 1)) + else + (Settings.Exact, s) + fun read () = case TextIO.inputLine inf of NONE => finish [] @@ -475,6 +496,26 @@ | [pkind, from] => doit (pkind, from, "") | _ => ErrorMsg.error "Bad 'rewrite' syntax" end + | "allow" => + (case String.tokens Char.isSpace arg of + [fkind, pattern] => + let + val fkind = parseFkind fkind + val (kind, pattern) = parsePattern pattern + in + fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind + end + | _ => ErrorMsg.error "Bad 'allow' syntax") + | "deny" => + (case String.tokens Char.isSpace arg of + [fkind, pattern] => + let + val fkind = parseFkind fkind + val (kind, pattern) = parsePattern pattern + in + fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind + end + | _ => ErrorMsg.error "Bad 'deny' syntax") | "library" => libs := relify arg :: !libs | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); read () @@ -493,6 +534,8 @@ Settings.setServerOnly (#serverOnly job); Settings.setJsFuncs (#jsFuncs job); Settings.setRewriteRules (#rewrites job); + Settings.setUrlRules (#filterUrl job); + Settings.setMimeRules (#filterMime job); job end