# HG changeset patch # User Adam Chlipala # Date 1241302815 14400 # Node ID c125df6fabfc267f5fdfa2258a90547a20bfdb7b # Parent efceae06df17c3ba8fa2c2245685594ad0c88596 Runtime URL and MIME type filtering diff -r efceae06df17 -r c125df6fabfc CHANGELOG --- a/CHANGELOG Sat May 02 13:37:52 2009 -0400 +++ b/CHANGELOG Sat May 02 18:20:15 2009 -0400 @@ -4,7 +4,7 @@ - Reimplement constructor class resolution to be more general and Prolog-like - SQL table constraints -- URLs, with configurable gatekeeper function Basis.bless +- URLs - Client-side error handling callbacks - CSS - Signing cookie values cryptographically to thwart cross site request forgery diff -r efceae06df17 -r c125df6fabfc include/urweb.h --- a/include/urweb.h Sat May 02 13:37:52 2009 -0400 +++ b/include/urweb.h Sat May 02 18:20:15 2009 -0400 @@ -169,6 +169,9 @@ uw_Basis_string uw_Basis_bless(uw_context, uw_Basis_string); uw_Basis_string uw_Basis_blessMime(uw_context, uw_Basis_string); +uw_Basis_string uw_Basis_checkUrl(uw_context, uw_Basis_string); +uw_Basis_string uw_Basis_checkMime(uw_context, uw_Basis_string); + uw_Basis_string uw_unnull(uw_Basis_string); uw_Basis_string uw_Basis_makeSigString(uw_context, uw_Basis_string); uw_Basis_string uw_Basis_sigString(uw_context, uw_unit); diff -r efceae06df17 -r c125df6fabfc lib/ur/basis.urs --- a/lib/ur/basis.urs Sat May 02 13:37:52 2009 -0400 +++ b/lib/ur/basis.urs Sat May 02 18:20:15 2009 -0400 @@ -514,6 +514,7 @@ type url val bless : string -> url +val checkUrl : string -> option url val dyn : use ::: {Type} -> bind ::: {Type} -> unit -> tag [Signal = signal (xml body use bind)] body [] use bind @@ -600,6 +601,7 @@ type mimeType val blessMime : string -> mimeType +val checkMime : string -> option mimeType val returnBlob : t ::: Type -> blob -> mimeType -> transaction t val blobSize : blob -> int diff -r efceae06df17 -r c125df6fabfc src/c/urweb.c --- a/src/c/urweb.c Sat May 02 13:37:52 2009 -0400 +++ b/src/c/urweb.c Sat May 02 18:20:15 2009 -0400 @@ -2437,18 +2437,49 @@ 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; - - 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 (!mime_format(s)) + uw_error(ctx, FATAL, "MIME type \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, 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 -r efceae06df17 -r c125df6fabfc src/cjr_print.sml --- a/src/cjr_print.sml Sat May 02 13:37:52 2009 -0400 +++ b/src/cjr_print.sml Sat May 02 18:20:15 2009 -0400 @@ -3176,6 +3176,34 @@ 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 ", newline, @@ -3218,6 +3246,12 @@ 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 -r efceae06df17 -r c125df6fabfc src/settings.sig --- a/src/settings.sig Sat May 02 13:37:52 2009 -0400 +++ b/src/settings.sig Sat May 02 18:20:15 2009 -0400 @@ -78,9 +78,11 @@ (* 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 -r efceae06df17 -r c125df6fabfc src/settings.sml --- a/src/settings.sml Sat May 02 13:37:52 2009 -0400 +++ b/src/settings.sml Sat May 02 18:20:15 2009 -0400 @@ -197,6 +197,9 @@ 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) = diff -r efceae06df17 -r c125df6fabfc tests/url.ur --- a/tests/url.ur Sat May 02 13:37:52 2009 -0400 +++ b/tests/url.ur Sat May 02 18:20:15 2009 -0400 @@ -1,12 +1,11 @@ -val url = "http://www.yahoo.com/" - fun readersChoice r = return - Your pick, boss + {case checkUrl r.Url of + None => I can't do that, Dave. + | Some url => Your pick, boss} fun main () : transaction page = return - Google! - Yahoo!
+ Learn
diff -r efceae06df17 -r c125df6fabfc tests/url.urp --- a/tests/url.urp Sat May 02 13:37:52 2009 -0400 +++ b/tests/url.urp Sat May 02 18:20:15 2009 -0400 @@ -1,4 +1,5 @@ debug -allow url http://* +deny url http://en.wikipedia.org/wiki/Perl +allow url http://en.wikipedia.org/* url