summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-05-03 15:38:49 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-05-03 15:38:49 -0400
commite57a588744ec72e443d69d2e47b4a9a199613745 (patch)
tree09387818d6f755a3b5eec66ad560cbe707f348dd
parent92df298250032469bab59565aa4e23a86b4a6e9a (diff)
cookieSec demo
-rw-r--r--demo/cookieSec.ur39
-rw-r--r--demo/cookieSec.urp4
-rw-r--r--demo/cookieSec.urs1
-rw-r--r--demo/prose6
-rw-r--r--src/cjr_print.sml15
-rw-r--r--src/settings.sml4
6 files changed, 60 insertions, 9 deletions
diff --git a/demo/cookieSec.ur b/demo/cookieSec.ur
new file mode 100644
index 00000000..447d38ad
--- /dev/null
+++ b/demo/cookieSec.ur
@@ -0,0 +1,39 @@
+cookie username : string
+
+table lastVisit : { User : string, When : time }
+ PRIMARY KEY User
+
+fun main () =
+ userO <- getCookie username;
+
+ list <- queryX (SELECT * FROM lastVisit)
+ (fn r => <xml><tr><td>{[r.LastVisit.User]}</td> <td>{[r.LastVisit.When]}</td></tr></xml>);
+
+ return <xml><body>
+ Cookie: {[userO]}<br/>
+
+ <table>
+ <tr><th>User</th> <th>Last Visit</th></tr>
+ {list}
+ </table>
+
+ <h2>Set cookie value</h2>
+ <form><textbox{#User}/> <submit action={set}/></form>
+
+ <h2>Record your visit</h2>
+ <form><submit action={imHere}/></form>
+ </body></xml>
+
+and set r =
+ setCookie username r.User;
+ main ()
+
+and imHere () =
+ userO <- getCookie username;
+ case userO of
+ None => return <xml>You don't have a cookie set!</xml>
+ | Some user =>
+ dml (DELETE FROM lastVisit WHERE User = {[user]});
+ dml (INSERT INTO lastVisit (User, When) VALUES ({[user]}, CURRENT_TIMESTAMP));
+ main ()
+
diff --git a/demo/cookieSec.urp b/demo/cookieSec.urp
new file mode 100644
index 00000000..74755510
--- /dev/null
+++ b/demo/cookieSec.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql cookieSec.sql
+
+cookieSec
diff --git a/demo/cookieSec.urs b/demo/cookieSec.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/demo/cookieSec.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/prose b/demo/prose
index aa12af6e..3646bfb9 100644
--- a/demo/prose
+++ b/demo/prose
@@ -143,6 +143,12 @@ view.urp
<p>SQL views are also supported with a special declaration form, analogous to <tt>table</tt>. A multi-parameter type class <tt>fieldsOf</tt> is used to characterize places where both tables and views are allowed. For instance, the polymorphic function <tt>list</tt> shown here lists the contents of any table or view containing just a single <tt>int</tt> column named <tt>A</tt>.</p>
+cookieSec.urp
+
+<p>Ur/Web guarantees that compiled applications are immune to certain kinds of <a href="http://www.owasp.org/index.php/Top_10_2007-A5">cross site request forgery</a>. For instance, a "phisher" might send many e-mails linking to a form that he has set up to look like your web site. The form is connected to your web site, where it might, say, transfer money from your bank account to the phisher's account. The phisher doesn't know your username, but, if that username is stored in a cookie, it will be sent automatically by your browser. Ur/Web automatically signs cookie values cryptographically, with the signature included as a POST parameter and not part of a cookie, to prevent such attacks.</p>
+
+<p>This demo shows a simple mock-up of a situation where such an attack is often possible with traditional web frameworks. You can set an arbitrary username for yourself in a cookie, and you can modify the database in a way that depends on the current cookie value. Try getting the latter action to succeed without first setting your desired username in the cookie. This should be roughly as impossible as cracking the particular cryptographic hash function that is used.</p>
+
sum.urp
<p>Metaprogramming is one of the most important facilities of Ur. This example shows how to write a function that is able to sum up the fields of records of integers, no matter which set of fields the particular record has.</p>
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index cb92588d..4828996c 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2421,20 +2421,20 @@ fun p_file env (ds, ps) =
E.declBinds env d))
env ds
- fun flatFields (t : typ) =
+ fun flatFields always (t : typ) =
case #1 t of
TRecord i =>
let
val xts = E.lookupStruct env i
in
- SOME (map #1 xts :: List.concat (List.mapPartial (flatFields o #2) xts))
+ SOME ((always @ map #1 xts) :: List.concat (List.mapPartial (flatFields [] o #2) xts))
end
| TList (_, i) =>
let
val ts = E.lookupStruct env i
in
case ts of
- [("1", t'), ("2", _)] => flatFields t'
+ [("1", t'), ("2", _)] => flatFields [] t'
| _ => raise Fail "CjrPrint: Bad struct for TList"
end
| _ => NONE
@@ -2448,12 +2448,11 @@ fun p_file env (ds, ps) =
(TRecord i, loc) =>
let
val xts = E.lookupStruct env i
- val xts = case eff of
- ReadCookieWrite =>
- (sigName xts, (TRecord 0, ErrorMsg.dummySpan)) :: xts
- | _ => xts
+ val extra = case eff of
+ ReadCookieWrite => [sigName xts]
+ | _ => []
in
- case flatFields (TRecord i, loc) of
+ case flatFields extra (TRecord i, loc) of
NONE => raise Fail "CjrPrint: flatFields impossible"
| SOME fields' => List.revAppend (fields', fields)
end
diff --git a/src/settings.sml b/src/settings.sml
index 24971eff..d04720c8 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -77,7 +77,9 @@ val clientToServer = ref clientToServerBase
fun setClientToServer ls = clientToServer := S.addList (clientToServerBase, ls)
fun mayClientToServer x = S.member (!clientToServer, x)
-val effectfulBase = basis ["set_cookie",
+val effectfulBase = basis ["dml",
+ "nextval",
+ "set_cookie",
"new_client_source",
"get_client_source",
"set_client_source",