changeset 736:796e42c93c48

Cookie signatures for RPCs
author Adam Chlipala <adamc@hcoop.net>
date Thu, 23 Apr 2009 16:13:02 -0400
parents 5ccb67665d05
children d049d31a1966
files CHANGELOG include/urweb.h lib/js/urweb.js src/c/urweb.c src/cjr_print.sml src/jscomp.sml src/mono.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sml tests/cookieJsec.ur tests/cookieJsec.urp tests/cookieJsec.urs
diffstat 14 files changed, 110 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGELOG	Thu Apr 23 14:10:10 2009 -0400
+++ b/CHANGELOG	Thu Apr 23 16:13:02 2009 -0400
@@ -5,6 +5,9 @@
 - Reimplement constructor class resolution to be more general and Prolog-like
 - SQL table constraints
 - URLs, with configurable gatekeeper function Basis.bless
+- Client-side error handling callbacks
+- CSS
+- Signing cookie values cryptographically to thwart cross site request forgery
 
 ========
 20090405
--- a/include/urweb.h	Thu Apr 23 14:10:10 2009 -0400
+++ b/include/urweb.h	Thu Apr 23 16:13:02 2009 -0400
@@ -55,6 +55,7 @@
 uw_Basis_string uw_Basis_maybe_onload(uw_context, uw_Basis_string);
 
 void uw_set_needs_push(uw_context, int);
+void uw_set_needs_sig(uw_context, int);
 
 char *uw_Basis_htmlifyInt(uw_context, uw_Basis_int);
 char *uw_Basis_htmlifyFloat(uw_context, uw_Basis_float);
--- a/lib/js/urweb.js	Thu Apr 23 14:10:10 2009 -0400
+++ b/lib/js/urweb.js	Thu Apr 23 16:13:02 2009 -0400
@@ -353,7 +353,9 @@
   }
 }
 
-function requestUri(xhr, uri) {
+var sig = null;
+
+function requestUri(xhr, uri, needsSig) {
   xhr.open("GET", uri, true);
 
   if (client_id != null) {
@@ -361,10 +363,17 @@
     xhr.setRequestHeader("UrWeb-Pass", client_pass.toString());
   }
 
+  if (needsSig) {
+    if (sig == null)
+      whine("Missing cookie signature!");
+
+    xhr.setRequestHeader("UrWeb-Sig", sig);
+  }
+
   xhr.send(null);
 }
 
-function rc(uri, parse, k) {
+function rc(uri, parse, k, needsSig) {
   uri = flattenLocal(uri);
   var xhr = getXHR();
 
@@ -389,7 +398,7 @@
     }
   };
 
-  requestUri(xhr, uri);
+  requestUri(xhr, uri, needsSig);
 }
 
 function path_join(s1, s2) {
@@ -438,7 +447,7 @@
   var connect = function () {
     xhr.onreadystatechange = orsc;
     tid = window.setTimeout(onTimeout, timeout * 500);
-    requestUri(xhr, uri);
+    requestUri(xhr, uri, false);
   }
 
   orsc = function() {
@@ -490,8 +499,8 @@
       }
       else {
         try {
-          servError("Error querying remote server for messages: " + xhr.status);
-        } catch (e) { servError("Error querying remote server for messages"); }
+          servErr("Error querying remote server for messages: " + xhr.status);
+        } catch (e) { servErr("Error querying remote server for messages"); }
       }
     }
   };
--- a/src/c/urweb.c	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/c/urweb.c	Thu Apr 23 16:13:02 2009 -0400
@@ -300,7 +300,7 @@
 
   const char *script_header, *url_prefix;
 
-  int needs_push;
+  int needs_push, needs_sig;
 
   size_t n_deltas, used_deltas;
   delta *deltas;
@@ -336,6 +336,7 @@
   ctx->script_header = "";
   ctx->url_prefix = "/";
   ctx->needs_push = 0;
+  ctx->needs_sig = 0;
   
   ctx->error_message[0] = 0;
 
@@ -589,6 +590,10 @@
   ctx->needs_push = n;
 }
 
+void uw_set_needs_sig(uw_context ctx, int n) {
+  ctx->needs_sig = n;
+}
+
 
 static void buf_check_ctx(uw_context ctx, buf *b, size_t extra, const char *desc) {
   if (b->back - b->front < extra) {
@@ -717,16 +722,30 @@
   }
 }
 
+extern uw_Basis_string uw_cookie_sig(uw_context);
+
 const char *uw_Basis_get_settings(uw_context ctx, uw_unit u) {
-  if (ctx->client == NULL)
-    return "";
-  else {
-    char *r = uw_malloc(ctx, 59 + 3 * INTS_MAX + strlen(ctx->url_prefix));
-    sprintf(r, "client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;listener();",
+  if (ctx->client == NULL) {
+    if (ctx->needs_sig) {
+      char *sig = uw_cookie_sig(ctx);
+      char *r = uw_malloc(ctx, strlen(sig) + 8);
+      sprintf(r, "sig=\"%s\";", sig);
+      return r;
+    }
+    else
+      return "";
+  } else {
+    char *sig = ctx->needs_sig ? uw_cookie_sig(ctx) : "";
+    char *r = uw_malloc(ctx, 59 + 3 * INTS_MAX + strlen(ctx->url_prefix)
+                        + (ctx->needs_sig ? strlen(sig) + 7 : 0));
+    sprintf(r, "client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;%s%s%slistener();",
             ctx->client->id,
             ctx->client->pass,
             ctx->url_prefix,
-            ctx->timeout);
+            ctx->timeout,
+            ctx->needs_sig ? "sig=\"" : "",
+            sig,
+            ctx->needs_sig ? "\";" : "");
     return r;
   }
 }
@@ -1998,8 +2017,6 @@
   return r;
 }
 
-extern uw_Basis_string uw_cookie_sig(uw_context);
-
 uw_Basis_string uw_Basis_sigString(uw_context ctx, uw_unit u) {
   return uw_cookie_sig(ctx);
 }
--- a/src/cjr_print.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/cjr_print.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -2497,6 +2497,13 @@
                                     string (!Monoize.urlPrefix),
                                     string "\");",
                                     newline]),
+                     string "uw_set_needs_sig(ctx, ",
+                     string (if couldWrite ek then
+                                 "1"
+                             else
+                                 "0"),
+                     string ");",
+                     newline,
                      string "uw_login(ctx);",
                      newline,
                      box [string "{",
--- a/src/jscomp.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/jscomp.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -113,7 +113,7 @@
       | ESignalReturn e => varDepth e
       | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
       | ESignalSource e => varDepth e
-      | EServerCall (e, ek, _) => Int.max (varDepth e, varDepth ek)
+      | EServerCall (e, ek, _, _) => Int.max (varDepth e, varDepth ek)
       | ERecv (e, ek, _) => Int.max (varDepth e, varDepth ek)
       | ESleep (e, ek) => Int.max (varDepth e, varDepth ek)
 
@@ -156,7 +156,7 @@
               | ESignalReturn e => cu inner e
               | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2
               | ESignalSource e => cu inner e
-              | EServerCall (e, ek, _) => cu inner e andalso cu inner ek
+              | EServerCall (e, ek, _, _) => cu inner e andalso cu inner ek
               | ERecv (e, ek, _) => cu inner e andalso cu inner ek
               | ESleep (e, ek) => cu inner e andalso cu inner ek
     in
@@ -956,7 +956,7 @@
                                  st)
                             end
 
-                          | EServerCall (e, ek, t) =>
+                          | EServerCall (e, ek, t, eff) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                                 val (ek, st) = jsE inner (ek, st)
@@ -967,7 +967,11 @@
                                          str ("), function(s){var t=s.split(\"/\");var i=0;return "
                                               ^ unurl ^ "},"),
                                          ek,
-                                         str ")"],
+                                         str (","
+                                              ^ (case eff of
+                                                     ReadCookieWrite => "true"
+                                                   | _ => "false")
+                                              ^ ")")],
                                  st)
                             end
 
--- a/src/mono.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/mono.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -62,6 +62,9 @@
        | Script
        | Source of typ
 
+datatype effect = datatype Export.effect
+datatype export_kind = datatype Export.export_kind
+
 datatype exp' =
          EPrim of Prim.t
        | ERel of int
@@ -109,15 +112,12 @@
        | ESignalBind of exp * exp
        | ESignalSource of exp
 
-       | EServerCall of exp * exp * typ
+       | EServerCall of exp * exp * typ * effect
        | ERecv of exp * exp * typ
        | ESleep of exp * exp
 
 withtype exp = exp' located
 
-datatype effect = datatype Export.effect
-datatype export_kind = datatype Export.export_kind
-
 datatype decl' =
          DDatatype of string * int * (string * int * typ option) list
        | DVal of string * int * typ * exp * string
--- a/src/mono_print.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/mono_print.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -308,11 +308,11 @@
                                 p_exp env e,
                                 string ")"]
 
-      | EServerCall (n, e, _) => box [string "Server(",
-                                          p_exp env n,
-                                          string ")[",
-                                          p_exp env e,
-                                          string "]"]
+      | EServerCall (n, e, _, _) => box [string "Server(",
+                                         p_exp env n,
+                                         string ")[",
+                                         p_exp env e,
+                                         string "]"]
       | ERecv (n, e, _) => box [string "Recv(",
                                 p_exp env n,
                                 string ")[",
--- a/src/mono_reduce.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/mono_reduce.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -371,7 +371,7 @@
                       | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
                       | ESignalSource e => summarize d e
 
-                      | EServerCall (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
+                      | EServerCall (e, ek, _, _) => summarize d e @ summarize d ek @ [Unsure]
                       | ERecv (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
                       | ESleep (e, ek) => summarize d e @ summarize d ek @ [Unsure]
             in
--- a/src/mono_util.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/mono_util.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -354,14 +354,14 @@
                      fn e' =>
                         (ESignalSource e', loc))
 
-              | EServerCall (s, ek, t) =>
+              | EServerCall (s, ek, t, eff) =>
                 S.bind2 (mfe ctx s,
                          fn s' =>
                             S.bind2 (mfe ctx ek,
                                   fn ek' =>
                                      S.map2 (mft t,
                                           fn t' =>
-                                             (EServerCall (s', ek', t'), loc))))
+                                             (EServerCall (s', ek', t', eff), loc))))
               | ERecv (s, ek, t) =>
                 S.bind2 (mfe ctx s,
                       fn s' =>
--- a/src/monoize.sml	Thu Apr 23 14:10:10 2009 -0400
+++ b/src/monoize.sml	Thu Apr 23 16:13:02 2009 -0400
@@ -2668,7 +2668,11 @@
                                                                   (L'.ERel 0, loc)), loc),
                                                         (L'.ERecord [], loc)), loc)), loc)), loc)
                 val ek = (L'.EApp (ekf, ek), loc)
-                val e = (L'.EServerCall (call, ek, t), loc)
+                val eff = if IS.member (!readCookie, n) then
+                              L'.ReadCookieWrite
+                          else
+                              L'.ReadOnly
+                val e = (L'.EServerCall (call, ek, t, eff), loc)
                 val e = liftExpInExp 0 e
                 val unit = (L'.TRecord [], loc)
                 val e = (L'.EAbs ("_", unit, unit, e), loc)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cookieJsec.ur	Thu Apr 23 16:13:02 2009 -0400
@@ -0,0 +1,27 @@
+table t : {Id : int}
+
+cookie c : int
+
+fun setter r =
+    setCookie c (readError r.Id);
+    return <xml>Done</xml>
+
+fun writer () =
+    ido <- getCookie c;
+    case ido of
+        None => error <xml>No cookie</xml>
+      | Some id => dml (INSERT INTO t (Id) VALUES ({[id]}))
+
+fun preWriter () = return <xml><body onload={onConnectFail (alert "RPC error")}>
+  <button onclick={writer ()} value="Write to database"/>
+
+  <a link={main ()}>Back</a>
+</body></xml>
+
+and main () = return <xml><body>
+  <form>
+    <textbox{#Id}/> <submit value="Get cookie" action={setter}/>
+  </form>
+
+  <form><submit action={preWriter} value="Prepare to write to database"/></form>
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cookieJsec.urp	Thu Apr 23 16:13:02 2009 -0400
@@ -0,0 +1,5 @@
+debug
+database dbname=cookiejsec
+sql cookieJsec.sql
+
+cookieJsec
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cookieJsec.urs	Thu Apr 23 16:13:02 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page