# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1240757159 14400
# Node ID 43553c93dd8cf00c5297865930dde762664e11f5
# Parent  f7e2026dd5ae0807984fc6b455666dea5e744543
Reading blobs from the database

diff -r f7e2026dd5ae -r 43553c93dd8c include/urweb.h
--- a/include/urweb.h	Sun Apr 26 09:02:17 2009 -0400
+++ b/include/urweb.h	Sun Apr 26 10:45:59 2009 -0400
@@ -22,6 +22,7 @@
 
 failure_kind uw_begin_init(uw_context);
 void uw_set_headers(uw_context, char *headers);
+void uw_headers_moved(uw_context ctx, char *headers);
 failure_kind uw_begin(uw_context, char *path);
 void uw_login(uw_context);
 void uw_commit(uw_context);
@@ -106,6 +107,7 @@
 uw_Basis_string uw_Basis_strcat(uw_context, const char *, const char *);
 uw_Basis_string uw_strdup(uw_context, const char *);
 uw_Basis_string uw_maybe_strdup(uw_context, const char *);
+char *uw_memdup(uw_context, const char *, size_t);
 
 uw_Basis_string uw_Basis_sqlifyInt(uw_context, uw_Basis_int);
 uw_Basis_string uw_Basis_sqlifyFloat(uw_context, uw_Basis_float);
@@ -141,6 +143,7 @@
 uw_Basis_float uw_Basis_stringToFloat_error(uw_context, uw_Basis_string);
 uw_Basis_bool uw_Basis_stringToBool_error(uw_context, uw_Basis_string);
 uw_Basis_time uw_Basis_stringToTime_error(uw_context, uw_Basis_string);
+uw_Basis_blob uw_Basis_stringToBlob_error(uw_context, uw_Basis_string, size_t);
 uw_Basis_channel uw_Basis_stringToChannel_error(uw_context, uw_Basis_string);
 uw_Basis_client uw_Basis_stringToClient_error(uw_context, uw_Basis_string);
 
diff -r f7e2026dd5ae -r 43553c93dd8c src/c/driver.c
--- a/src/c/driver.c	Sun Apr 26 09:02:17 2009 -0400
+++ b/src/c/driver.c	Sun Apr 26 10:45:59 2009 -0400
@@ -148,7 +148,7 @@
 static void *worker(void *data) {
   int me = *(int *)data, retries_left = MAX_RETRIES;
   uw_context ctx = new_context();
-  size_t buf_size = 1;
+  size_t buf_size = 2;
   char *buf = malloc(buf_size);
 
   while (1) {
@@ -167,7 +167,7 @@
       unsigned retries_left = MAX_RETRIES;
       int r;
 
-      if (back - buf == buf_size) {
+      if (back - buf == buf_size - 1) {
         char *new_buf;
         buf_size *= 2;
         new_buf = realloc(buf, buf_size);
@@ -175,7 +175,7 @@
         buf = new_buf;
       }
 
-      r = recv(sock, back, buf_size - (back - buf), 0);
+      r = recv(sock, back, buf_size - 1 - (back - buf), 0);
 
       if (r < 0) {
         fprintf(stderr, "Recv failed\n");
@@ -235,15 +235,21 @@
           }
 
           while (back - after_headers < clen) {
-            if (back - buf == buf_size) {
+            if (back - buf == buf_size - 1) {
               char *new_buf;
               buf_size *= 2;
               new_buf = realloc(buf, buf_size);
+
               back = new_buf + (back - buf);
+              headers = new_buf + (headers - buf);
+              uw_headers_moved(ctx, headers);
+              after_headers = new_buf + (after_headers - buf);
+              s = new_buf + (s - buf);
+
               buf = new_buf;
             }
 
-            r = recv(sock, back, buf_size - (back - buf), 0);
+            r = recv(sock, back, buf_size - 1 - (back - buf), 0);
 
             if (r < 0) {
               fprintf(stderr, "Recv failed\n");
diff -r f7e2026dd5ae -r 43553c93dd8c src/c/urweb.c
--- a/src/c/urweb.c	Sun Apr 26 09:02:17 2009 -0400
+++ b/src/c/urweb.c	Sun Apr 26 10:45:59 2009 -0400
@@ -443,6 +443,11 @@
   ctx->headers_end = s;
 }
 
+void uw_headers_moved(uw_context ctx, char *headers) {
+  ctx->headers_end = headers + (ctx->headers_end - ctx->headers);
+  ctx->headers = headers;
+}
+
 int uw_db_begin(uw_context);
 
 __attribute__((noreturn)) void uw_error(uw_context ctx, failure_kind fk, const char *fmt, ...) {
@@ -1481,6 +1486,11 @@
     return NULL;
 }
 
+char *uw_memdup(uw_context ctx, const char *p, size_t len) {
+  char *r = uw_malloc(ctx, len);
+  memcpy(r, p, len);
+  return r;
+}
 
 char *uw_Basis_sqlifyInt(uw_context ctx, uw_Basis_int n) {
   int len;
@@ -1896,6 +1906,36 @@
   }
 }
 
+uw_Basis_blob uw_Basis_stringToBlob_error(uw_context ctx, uw_Basis_string s, size_t len) {
+  char *r = ctx->heap.front;
+  uw_Basis_blob b = {len, r};
+
+  uw_check_heap(ctx, len);
+
+  while (*s) {
+    if (s[0] == '\\') {
+      if (s[1] == '\\') {
+        *r++ = '\\';
+        s += 2;
+      } else if (isdigit(s[1]) && isdigit(s[2]) && isdigit(s[3])) {
+        *r++ = (s[1] - '0') * 8 * 8 + ((s[2] - '0') * 8) + (s[3] - '0');
+        s += 4;
+      }
+      else {
+        *r++ = '\\';
+        ++s;
+      }
+    } else {
+      *r++ = s[0];
+      ++s;
+    }
+  }
+
+  b.size = r - ctx->heap.front;
+  ctx->heap.front = r;
+  return b;
+}
+
 uw_Basis_string uw_Basis_get_cookie(uw_context ctx, uw_Basis_string c) {
   int len = strlen(c);
   char *s = ctx->headers, *p = ctx->outHeaders.start;
diff -r f7e2026dd5ae -r 43553c93dd8c src/cjr_print.sml
--- a/src/cjr_print.sml	Sun Apr 26 09:02:17 2009 -0400
+++ b/src/cjr_print.sml	Sun Apr 26 10:45:59 2009 -0400
@@ -434,6 +434,12 @@
                            newline,
                            string "})"],
              string ")"]
+
+      | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, PQgetvalue(res, i, ",
+                                       string (Int.toString i),
+                                       string "), PQgetlength(res, i, ",
+                                       string (Int.toString i),
+                                       string "))"]
              
       | _ =>
         p_unsql wontLeakStrings env tAll
@@ -547,7 +553,7 @@
                                                   | SOME t => nl ok' t) cons
                  end)
               | TFfi ("Basis", "string") => false
-              | TFfi ("Basis", "blob") => false
+              | TFfi ("Basis", "blob") => allowHeapAllocated
               | TFfi _ => true
               | TOption t => allowHeapAllocated andalso nl ok t
     in
diff -r f7e2026dd5ae -r 43553c93dd8c src/compiler.sig
--- a/src/compiler.sig	Sun Apr 26 09:02:17 2009 -0400
+++ b/src/compiler.sig	Sun Apr 26 10:45:59 2009 -0400
@@ -40,7 +40,8 @@
          timeout : int
     }
     val compile : string -> unit
-    val compileC : {cname : string, oname : string, ename : string, libs : string, profile : bool} -> unit
+    val compileC : {cname : string, oname : string, ename : string, libs : string,
+                    profile : bool, debug : bool} -> unit
 
     type ('src, 'dst) phase
     type ('src, 'dst) transform
diff -r f7e2026dd5ae -r 43553c93dd8c src/compiler.sml
--- a/src/compiler.sml	Sun Apr 26 09:02:17 2009 -0400
+++ b/src/compiler.sml	Sun Apr 26 10:45:59 2009 -0400
@@ -605,7 +605,7 @@
 
 val toSqlify = transform sqlify "sqlify" o toMono_opt2
 
-fun compileC {cname, oname, ename, libs, profile} =
+fun compileC {cname, oname, ename, libs, profile, debug} =
     let
         val urweb_o = clibFile "urweb.o"
         val driver_o = clibFile "driver.o"
@@ -618,6 +618,12 @@
                 (compile ^ " -pg", link ^ " -pg")
             else
                 (compile, link)
+
+        val (compile, link) =
+            if debug then
+                (compile ^ " -g", link ^ " -g")
+            else
+                (compile, link)
     in
         if not (OS.Process.isSuccess (OS.Process.system compile)) then
             print "C compilation failed\n"
@@ -682,7 +688,8 @@
                         TextIO.closeOut outf
                     end;
 
-                compileC {cname = cname, oname = oname, ename = ename, libs = libs, profile = #profile job};
+                compileC {cname = cname, oname = oname, ename = ename, libs = libs,
+                          profile = #profile job, debug = #debug job};
                 
                 cleanup ()
             end
diff -r f7e2026dd5ae -r 43553c93dd8c tests/blob.ur
--- a/tests/blob.ur	Sun Apr 26 09:02:17 2009 -0400
+++ b/tests/blob.ur	Sun Apr 26 10:45:59 2009 -0400
@@ -1,16 +1,27 @@
 sequence s
 table t : { Id : int, Nam : option string, Data : blob, Desc : string, Typ : string }
 
+fun view id =
+    r <- oneRow (SELECT t.Data, t.Typ FROM t WHERE t.Id = {[id]});
+    returnBlob r.T.Data (blessMime r.T.Typ)
+
 fun save r =
     id <- nextval s;
     dml (INSERT INTO t (Id, Nam, Data, Desc, Typ)
          VALUES ({[id]}, {[fileName r.Data]}, {[fileData r.Data]}, {[r.Desc]}, {[fileMimeType r.Data]}));
     main ()
 
-and main () = return <xml><body>
-  <form>
-    <textbox{#Desc}/>
-    <upload{#Data}/>
-    <submit action={save}/>
-  </form>
-</body></xml>
+and main () =
+    ls <- queryX (SELECT t.Id, t.Desc FROM t ORDER BY t.Desc)
+          (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Desc]}</a></li></xml>);
+    return <xml><body>
+      {ls}
+
+      <br/>
+
+      <form>
+        <textbox{#Desc}/>
+        <upload{#Data}/>
+        <submit action={save}/>
+      </form>
+    </body></xml>