Runtime URL and MIME type filtering

4 files changed, 77 insertions, 7 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index cc02b3d1..1f256681 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -2437,18 +2437,49 @@ failure_kind uw_initialize(uw_context ctx) {
   return r;
 }
 
+extern int uw_check_url(const char *);
+extern int uw_check_mime(const char *);
+
 uw_Basis_string uw_Basis_bless(uw_context ctx, uw_Basis_string s) {
-  return s;
+  if (uw_check_url(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed URL %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkUrl(uw_context ctx, uw_Basis_string s) {
+  if (uw_check_url(s))
+    return s;
+  else
+    return NULL;
+}
+
+int mime_format(const char *s) {
+  for (; *s; ++s)
+    if (!isalnum(*s) && *s != '/' && *s != '-' && *s != '.')
+      return 0;
+
+  return 1;
 }
 
 uw_Basis_string uw_Basis_blessMime(uw_context ctx, uw_Basis_string s) {
-  char *s2;
+  if (!mime_format(s))
+    uw_error(ctx, FATAL, "MIME type \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
 
-  for (s2 = s; *s2; ++s2)
-    if (!isalnum(*s2) && *s2 != '/' && *s2 != '-' && *s2 != '.')
-      uw_error(ctx, FATAL, "MIME type \"%s\" contains invalid character %c\n", s, *s2);
-  
-  return s;
+  if (uw_check_mime(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed MIME type %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkMime(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    return NULL;
+
+  if (uw_check_mime(s))
+    return s;
+  else
+    return NULL;
 }
 
 uw_Basis_string uw_unnull(uw_Basis_string s) {
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 3a124ff4..cb92588d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3176,6 +3176,34 @@ fun p_file env (ds, ps) =
                                                               acc,
                                                               string "))"]))
                          NONE cookies
+
+        fun makeChecker (name, rules : Settings.rule list) =
+            box [string "int ",
+                 string name,
+                 string "(const char *s) {",
+                 newline,
+                 box [p_list_sep (box [])
+                      (fn rule =>
+                          box [string "if (!str",
+                               case #kind rule of
+                                   Settings.Exact => box [string "cmp(s, \"",
+                                                          string (String.toString (#pattern rule)),
+                                                          string "\"))"]
+                                 | Settings.Prefix => box [string "ncmp(s, \"",
+                                                           string (String.toString (#pattern rule)),
+                                                           string "\", ",
+                                                           string (Int.toString (size (#pattern rule))),
+                                                           string "))"],
+                               string " return ",
+                               string (case #action rule of
+                                           Settings.Allow => "1"
+                                         | Settings.Deny => "0"),
+                               string ";",
+                               newline]) rules,
+                      string "return 0;",
+                      newline],
+                 string "}",
+                 newline]
     in
         box [string "#include <stdio.h>",
              newline,
@@ -3218,6 +3246,12 @@ fun p_file env (ds, ps) =
              string "}",
              newline,
              newline,
+
+             makeChecker ("uw_check_url", Settings.getUrlRules ()),
+             newline,
+
+             makeChecker ("uw_check_mime", Settings.getMimeRules ()),
+             newline,
              
              string "extern void uw_sign(const char *in, char *out);",
              newline,
diff --git a/src/settings.sig b/src/settings.sig
index f750c14a..dd812ac4 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -78,9 +78,11 @@ signature SETTINGS = sig
 
     (* Validating URLs and MIME types *)
     val setUrlRules : rule list -> unit
+    val getUrlRules : unit -> rule list
     val checkUrl : string -> bool
 
     val setMimeRules : rule list -> unit
+    val getMimeRules : unit -> rule list
     val checkMime : string -> bool
 
 end
diff --git a/src/settings.sml b/src/settings.sml
index e7020615..24971eff 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -197,6 +197,9 @@ val mime = ref ([] : rule list)
 fun setUrlRules ls = url := ls
 fun setMimeRules ls = mime := ls
 
+fun getUrlRules () = !url
+fun getMimeRules () = !mime
+
 fun check f rules s =
     let
         fun chk (ls : rule list) =