Mercurial > urweb
diff src/settings.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 | c125df6fabfc |
line wrap: on
line diff
--- a/src/settings.sml Sat May 02 13:23:07 2009 -0400 +++ b/src/settings.sml Sat May 02 13:37:52 2009 -0400 @@ -191,4 +191,38 @@ rew (!rewrites) end +val url = ref ([] : rule list) +val mime = ref ([] : rule list) + +fun setUrlRules ls = url := ls +fun setMimeRules ls = mime := ls + +fun check f rules s = + let + fun chk (ls : rule list) = + case ls of + [] => false + | rule :: ls => + let + val matches = + case #kind rule of + Exact => #pattern rule = s + | Prefix => String.isPrefix (#pattern rule) s + in + if matches then + case #action rule of + Allow => true + | Deny => false + else + chk ls + end + in + f s andalso chk (!rules) + end + +val checkUrl = check (fn _ => true) url +val checkMime = check + (CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #".")) + mime + end