summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-06 14:03:50 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-06 14:03:50 -0500
commit27e3c3ba965513dcb3e447cccf6e77ce8c63e90d (patch)
tree9e9881243ec7e26be8817357bfc5aa2ede51802a
parent5e95ccda9544c96b519d2cf6b32967f4b1ef990a (diff)
Cookies work across pages
-rw-r--r--include/urweb.h6
-rw-r--r--src/c/driver.c2
-rw-r--r--src/c/urweb.c4
-rw-r--r--src/monoize.sml5
-rw-r--r--tests/cookie.ur18
5 files changed, 27 insertions, 8 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 2330a0b4..7db66ed4 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -6,7 +6,7 @@ int uw_really_send(int sock, void *buf, ssize_t len);
extern uw_unit uw_unit_v;
-uw_context uw_init(size_t page_len, size_t heap_len);
+uw_context uw_init(size_t outHeaders_len, size_t page_len, size_t heap_len);
void uw_set_db(uw_context, void*);
void *uw_get_db(uw_context);
void uw_free(uw_context);
@@ -101,5 +101,5 @@ uw_Basis_string uw_Basis_requestHeader(uw_context, uw_Basis_string);
void uw_write_header(uw_context, uw_Basis_string);
-uw_Basis_string uw_Basis_get_cookie(uw_context, uw_Basis_string);
-uw_unit uw_Basis_set_cookie(uw_context, uw_Basis_string, uw_Basis_string);
+uw_Basis_string uw_Basis_get_cookie(uw_context, uw_Basis_string c);
+uw_unit uw_Basis_set_cookie(uw_context, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v);
diff --git a/src/c/driver.c b/src/c/driver.c
index d884c025..1eef9742 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -71,7 +71,7 @@ static int try_rollback(uw_context ctx) {
static void *worker(void *data) {
int me = *(int *)data, retries_left = MAX_RETRIES;
- uw_context ctx = uw_init(1024, 0);
+ uw_context ctx = uw_init(0, 1024, 0);
while (1) {
failure_kind fk = uw_begin_init(ctx);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index cc21c558..638fbb16 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1152,11 +1152,13 @@ uw_Basis_string uw_Basis_get_cookie(uw_context ctx, uw_Basis_string c) {
}
}
-uw_unit uw_Basis_set_cookie(uw_context ctx, uw_Basis_string c, uw_Basis_string v) {
+uw_unit uw_Basis_set_cookie(uw_context ctx, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v) {
uw_write_header(ctx, "Set-Cookie: ");
uw_write_header(ctx, c);
uw_write_header(ctx, "=");
uw_write_header(ctx, v);
+ uw_write_header(ctx, "; path=");
+ uw_write_header(ctx, prefix);
uw_write_header(ctx, "\r\n");
return uw_unit_v;
diff --git a/src/monoize.sml b/src/monoize.sml
index 20677816..c4c296bd 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -971,7 +971,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((L'.EAbs ("c", s, (L'.TFun (t, (L'.TFun (un, un), loc)), loc),
(L'.EAbs ("v", t, (L'.TFun (un, un), loc),
(L'.EAbs ("_", un, un,
- (L'.EFfiApp ("Basis", "set_cookie", [(L'.ERel 2, loc), e]), loc)),
+ (L'.EFfiApp ("Basis", "set_cookie", [(L'.EPrim (Prim.String (!urlPrefix)),
+ loc),
+ (L'.ERel 2, loc),
+ e]), loc)),
loc)), loc)), loc),
fm)
end
diff --git a/tests/cookie.ur b/tests/cookie.ur
index cb4f8854..bef45a4f 100644
--- a/tests/cookie.ur
+++ b/tests/cookie.ur
@@ -1,8 +1,22 @@
cookie c : string
-fun main () : transaction page =
- setCookie c "Hi";
+fun other () =
so <- getCookie c;
case so of
None => return <xml>No cookie</xml>
| Some s => return <xml>Cookie: {[s]}</xml>
+
+structure M = struct
+ fun aux () =
+ setCookie c "Hi";
+ so <- getCookie c;
+ case so of
+ None => return <xml>No cookie</xml>
+ | Some s => return <xml><body>Cookie: {[s]}<br/>
+ <a link={other ()}>Other</a></body></xml>
+end
+
+fun main () : transaction page = return <xml><body>
+ <a link={other ()}>Other</a><br/>
+ <a link={M.aux ()}>Aux</a><br/>
+</body></xml>