# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1260476436 18000
# Node ID 740b85ef4352ff3b7ac3ab827800897ad5105568
# Parent  217eb87dde31d7c115110e4012a9e727501ebc70
Basis.currentUrl, plus redirect debugging

diff -r 217eb87dde31 -r 740b85ef4352 include/urweb.h
--- a/include/urweb.h	Thu Dec 10 13:32:09 2009 -0500
+++ b/include/urweb.h	Thu Dec 10 15:20:36 2009 -0500
@@ -248,4 +248,7 @@
 uw_Basis_char uw_Basis_tolower(uw_context, uw_Basis_char);
 uw_Basis_char uw_Basis_toupper(uw_context, uw_Basis_char);
 
+uw_Basis_string uw_Basis_currentUrl(uw_context);
+void uw_set_currentUrl(uw_context, char *);
+
 #endif
diff -r 217eb87dde31 -r 740b85ef4352 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Thu Dec 10 13:32:09 2009 -0500
+++ b/lib/ur/basis.urs	Thu Dec 10 15:20:36 2009 -0500
@@ -565,6 +565,7 @@
 val checkUrl : string -> option url
 val url : transaction page -> url
 val redirect : t ::: Type -> url -> transaction t
+val currentUrl : transaction url
 
 val dyn : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> [ctx ~ body] => unit
           -> tag [Signal = signal (xml (body ++ ctx) use bind)] (body ++ ctx) [] use bind
diff -r 217eb87dde31 -r 740b85ef4352 src/c/request.c
--- a/src/c/request.c	Thu Dec 10 13:32:09 2009 -0500
+++ b/src/c/request.c	Thu Dec 10 15:20:36 2009 -0500
@@ -169,6 +169,8 @@
   size_t boundary_len;
   char *inputs;
 
+  uw_set_currentUrl(ctx, path);
+
   if (!strcmp(method, "POST")) {
     char *clen_s = uw_Basis_requestHeader(ctx, "Content-length");
     if (!clen_s) {
diff -r 217eb87dde31 -r 740b85ef4352 src/c/urweb.c
--- a/src/c/urweb.c	Thu Dec 10 13:32:09 2009 -0500
+++ b/src/c/urweb.c	Thu Dec 10 15:20:36 2009 -0500
@@ -384,6 +384,8 @@
   global *globals;
   size_t n_globals;
 
+  char *current_url;
+
   char error_message[ERROR_BUF_LEN];
 };
 
@@ -437,6 +439,8 @@
   ctx->globals = malloc(0);
   ctx->n_globals = 0;
 
+  ctx->current_url = "";
+
   return ctx;
 }
 
@@ -3048,7 +3052,7 @@
   buf_check(&ctx->outHeaders, INTS_MAX);
   sprintf(ctx->outHeaders.front, "%d%n", b.size, &len);
   ctx->outHeaders.front += len;
-  uw_write_header(ctx, "\r\n");  
+  uw_write_header(ctx, "\r\n");
 
   buf_append(&ctx->page, b.data, b.size);
 
@@ -3063,12 +3067,30 @@
 __attribute__((noreturn)) void uw_redirect(uw_context ctx, uw_Basis_string url) {
   cleanup *cl;
   int len;
+  char *s;
 
   ctx->returning_indirectly = 1;
+  buf_reset(&ctx->page);
+  buf_check(&ctx->page, buf_used(&ctx->outHeaders)+1);
+  memcpy(ctx->page.start, ctx->outHeaders.start, buf_used(&ctx->outHeaders));
+  ctx->page.start[buf_used(&ctx->outHeaders)] = 0;
   buf_reset(&ctx->outHeaders);
-  buf_reset(&ctx->page);
 
   uw_write_header(ctx, on_redirect);
+
+  s = strchr(ctx->page.start, '\n');
+  if (s) {
+    char *s2;
+    for (++s; s2 = strchr(s, '\n'); s = s2+1) {
+      *s2 = 0;
+      printf("Line: %s\n", s);
+      if (!strncmp(s, "Set-Cookie: ", 12)) {
+        uw_write_header(ctx, s);
+        uw_write_header(ctx, "\n");
+      }
+    }
+  }
+
   uw_write_header(ctx, "Location: ");
   uw_write_header(ctx, url);
   uw_write_header(ctx, "\r\n\r\n");
@@ -3228,3 +3250,11 @@
 uw_Basis_char uw_Basis_toupper(uw_context ctx, uw_Basis_char c) {
   return toupper(c);
 }
+
+uw_Basis_string uw_Basis_currentUrl(uw_context ctx) {
+  return ctx->current_url;
+}
+
+void uw_set_currentUrl(uw_context ctx, char *s) {
+  ctx->current_url = s;
+}