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