Initial support for blobs and upload

11 files changed, 454 insertions, 68 deletions

diff --git a/include/types.h b/include/types.h
index c80653d3..0cb81cb5 100644
--- a/include/types.h
+++ b/include/types.h
@@ -4,6 +4,10 @@ typedef long long uw_Basis_int;
 typedef double uw_Basis_float;
 typedef char* uw_Basis_string;
 typedef time_t uw_Basis_time;
+typedef struct {
+  size_t size;
+  char *data;
+} uw_Basis_blob;
 
 struct __uws_0 {
 };
@@ -24,6 +28,15 @@ typedef struct {
   unsigned cli, chn;
 } uw_Basis_channel;
 
+typedef struct uw_Basis_file {
+  uw_Basis_string name;
+  uw_Basis_blob data;
+} uw_Basis_file;
+
+typedef struct uw_Basis_files {
+  size_t size;
+  uw_Basis_file *files;
+} uw_Basis_files;
 
 typedef enum { SUCCESS, FATAL, BOUNDED_RETRY, UNLIMITED_RETRY } failure_kind;
 
diff --git a/include/urweb.h b/include/urweb.h
index 99ae3e69..4244aa6d 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -39,10 +39,13 @@ void uw_memstats(uw_context);
 
 int uw_send(uw_context, int sock);
 
-void uw_set_input(uw_context, char *name, char *value);
+void uw_set_input(uw_context, const char *name, char *value);
 char *uw_get_input(uw_context, int name);
 char *uw_get_optional_input(uw_context, int name);
 
+void uw_set_file_input(uw_context, char *name, uw_Basis_files fs);
+uw_Basis_files uw_get_file_input(uw_context, int name);
+
 void uw_write(uw_context, const char*);
 
 uw_Basis_int uw_Basis_new_client_source(uw_context, uw_Basis_string);
@@ -101,14 +104,15 @@ uw_Basis_bool uw_Basis_unurlifyBool(uw_context, char **);
 uw_Basis_time uw_Basis_unurlifyTime(uw_context, char **);
 
 uw_Basis_string uw_Basis_strcat(uw_context, const char *, const char *);
-uw_Basis_string uw_Basis_strdup(uw_context, const char *);
-uw_Basis_string uw_Basis_maybe_strdup(uw_context, const char *);
+uw_Basis_string uw_strdup(uw_context, const char *);
+uw_Basis_string uw_maybe_strdup(uw_context, const char *);
 
 uw_Basis_string uw_Basis_sqlifyInt(uw_context, uw_Basis_int);
 uw_Basis_string uw_Basis_sqlifyFloat(uw_context, uw_Basis_float);
 uw_Basis_string uw_Basis_sqlifyString(uw_context, uw_Basis_string);
 uw_Basis_string uw_Basis_sqlifyBool(uw_context, uw_Basis_bool);
 uw_Basis_string uw_Basis_sqlifyTime(uw_context, uw_Basis_time);
+uw_Basis_string uw_Basis_sqlifyBlob(uw_context, uw_Basis_blob);
 uw_Basis_string uw_Basis_sqlifyChannel(uw_context, uw_Basis_channel);
 uw_Basis_string uw_Basis_sqlifyClient(uw_context, uw_Basis_client);
 
@@ -157,3 +161,8 @@ uw_Basis_string uw_Basis_bless(uw_context, uw_Basis_string);
 uw_Basis_string uw_unnull(uw_Basis_string);
 uw_Basis_string uw_Basis_makeSigString(uw_context, uw_Basis_string);
 uw_Basis_string uw_Basis_sigString(uw_context, uw_unit);
+
+uw_Basis_string uw_Basis_fileName(uw_context, uw_Basis_file);
+uw_Basis_blob uw_Basis_fileData(uw_context, uw_Basis_file);
+uw_Basis_int uw_Basis_numFiles(uw_context, uw_Basis_files);
+uw_Basis_file uw_Basis_fileNum(uw_context, uw_Basis_files, uw_Basis_int);
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 99ac50fe..ce969a37 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -2,6 +2,7 @@ type int
 type float
 type string
 type time
+type blob
 
 type unit = {}
 
@@ -134,6 +135,7 @@ val sql_int : sql_injectable_prim int
 val sql_float : sql_injectable_prim float
 val sql_string : sql_injectable_prim string
 val sql_time : sql_injectable_prim time
+val sql_blob : sql_injectable_prim blob
 val sql_channel : t ::: Type -> sql_injectable_prim (channel t)
 val sql_client : sql_injectable_prim client
 
@@ -512,6 +514,16 @@ val textarea : formTag string [] [Rows = int, Cols = int]
 
 val checkbox : formTag bool [] [Checked = bool]
 
+type file
+val fileName : file -> option string
+val fileData : file -> blob
+
+type files
+val numFiles : files -> int
+val fileNum : files -> int -> file
+
+val upload : formTag files [] [Value = string, Size = int]
+
 con radio = [Body, Radio]
 val radio : formTag string radio []
 val radioOption : unit -> tag [Value = string] radio [] [] []
diff --git a/src/c/driver.c b/src/c/driver.c
index f7456ed9..fa4f474b 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -1,5 +1,6 @@
-#include <stdio.h>
+#define _GNU_SOURCE
 
+#include <stdio.h>
 #include <string.h>
 #include <stdlib.h>
 #include <sys/types.h>
@@ -147,9 +148,11 @@ void uw_sign(const char *in, char *out) {
 static void *worker(void *data) {
   int me = *(int *)data, retries_left = MAX_RETRIES;
   uw_context ctx = new_context();
+  size_t buf_size = 1;
+  char *buf = malloc(buf_size);
 
   while (1) {
-    char buf[uw_bufsize+1], *back = buf, *s, *post;
+    char *back = buf, *s, *post;
     int sock, dont_close = 0;
 
     pthread_mutex_lock(&queue_mutex);
@@ -162,7 +165,17 @@ static void *worker(void *data) {
 
     while (1) {
       unsigned retries_left = MAX_RETRIES;
-      int r = recv(sock, back, uw_bufsize - (back - buf), 0);
+      int r;
+
+      if (back - buf == buf_size) {
+        char *new_buf;
+        buf_size *= 2;
+        new_buf = realloc(buf, buf_size);
+        back = new_buf + (back - buf);
+        buf = new_buf;
+      }
+
+      r = recv(sock, back, buf_size - (back - buf), 0);
 
       if (r < 0) {
         fprintf(stderr, "Recv failed\n");
@@ -182,8 +195,12 @@ static void *worker(void *data) {
       if (s = strstr(buf, "\r\n\r\n")) {
         failure_kind fk;
         int is_post = 0;
+        char *boundary = NULL;
+        size_t boundary_len;
         char *cmd, *path, *headers, path_copy[uw_bufsize+1], *inputs, *after_headers;
 
+        //printf("All: %s\n", buf);
+
         s[2] = 0;
         after_headers = s + 4;
 
@@ -196,7 +213,7 @@ static void *worker(void *data) {
         headers = s + 2;
         cmd = s = buf;
 
-        printf("Read: %s\n", buf);
+        //printf("Read: %s\n", buf);
       
         if (!strsep(&s, " ")) {
           fprintf(stderr, "No first space in HTTP command\n");
@@ -208,17 +225,25 @@ static void *worker(void *data) {
         if (!strcmp(cmd, "POST")) {
           char *clen_s = uw_Basis_requestHeader(ctx, "Content-length");
           if (!clen_s) {
-            printf("No Content-length with POST\n");
+            fprintf(stderr, "No Content-length with POST\n");
             goto done;
           }
           int clen = atoi(clen_s);
           if (clen < 0) {
-            printf("Negative Content-length with POST\n");
+            fprintf(stderr, "Negative Content-length with POST\n");
             goto done;
           }
 
           while (back - after_headers < clen) {
-            r = recv(sock, back, uw_bufsize - (back - buf), 0);
+            if (back - buf == buf_size) {
+              char *new_buf;
+              buf_size *= 2;
+              new_buf = realloc(buf, buf_size);
+              back = new_buf + (back - buf);
+              buf = new_buf;
+            }
+
+            r = recv(sock, back, buf_size - (back - buf), 0);
 
             if (r < 0) {
               fprintf(stderr, "Recv failed\n");
@@ -235,6 +260,19 @@ static void *worker(void *data) {
           }
 
           is_post = 1;
+
+          clen_s = uw_Basis_requestHeader(ctx, "Content-type");
+          if (clen_s && !strncasecmp(clen_s, "multipart/form-data", 19)) {
+            if (strncasecmp(clen_s + 19, "; boundary=", 11)) {
+              fprintf(stderr, "Bad multipart boundary spec");
+              break;
+            }
+
+            boundary = clen_s + 28;
+            boundary[0] = '-';
+            boundary[1] = '-';
+            boundary_len = strlen(boundary);
+          }
         } else if (strcmp(cmd, "GET")) {
           fprintf(stderr, "Not ready for non-GET/POST command: %s\n", cmd);
           break;
@@ -262,26 +300,134 @@ static void *worker(void *data) {
           break;
         }
 
-        if (is_post)
-          inputs = after_headers;
-        else if (inputs = strchr(path, '?'))
-          *inputs++ = 0;
-        if (inputs) {
-          char *name, *value;
-
-          while (*inputs) {
-            name = inputs;
-            if (inputs = strchr(inputs, '&'))
-              *inputs++ = 0;
-            else
-              inputs = strchr(name, 0);
-
-            if (value = strchr(name, '=')) {
-              *value++ = 0;
-              uw_set_input(ctx, name, value);
+        if (boundary) {
+          char *part = after_headers, *after_sub_headers, *header, *after_header;
+          size_t part_len;
+
+          part = strstr(part, boundary);
+          if (!part) {
+            fprintf(stderr, "Missing first multipart boundary\n");
+            break;
+          }
+          part += boundary_len;
+
+          while (1) {
+            char *name = NULL, *filename = NULL, *type = NULL;
+
+            if (part[0] == '-' && part[1] == '-')
+              break;
+
+            if (*part != '\r') {
+              fprintf(stderr, "No \\r after multipart boundary\n");
+              goto done;
+            }
+            ++part;
+            if (*part != '\n') {
+              fprintf(stderr, "No \\n after multipart boundary\n");
+              goto done;
+            }
+            ++part;
+            
+            if (!(after_sub_headers = strstr(part, "\r\n\r\n"))) {
+              fprintf(stderr, "Missing end of headers after multipart boundary\n");
+              goto done;
+            }
+            after_sub_headers[2] = 0;
+            after_sub_headers += 4;
+
+            for (header = part; after_header = strstr(header, "\r\n"); header = after_header + 2) {
+              char *colon, *after_colon;
+
+              *after_header = 0;
+              if (!(colon = strchr(header, ':'))) {
+                fprintf(stderr, "Missing colon in multipart sub-header\n");
+                goto done;
+              }
+              *colon++ = 0;
+              if (*colon++ != ' ') {
+                fprintf(stderr, "No space after colon in multipart sub-header\n");
+                goto done;
+              }
+
+              if (!strcasecmp(header, "Content-Disposition")) {
+                if (strncmp(colon, "form-data; ", 11)) {
+                  fprintf(stderr, "Multipart data is not \"form-data\"\n");
+                  goto done;
+                }
+
+                for (colon += 11; after_colon = strchr(colon, '='); colon = after_colon) {
+                  char *data;
+                  after_colon[0] = 0;
+                  if (after_colon[1] != '"') {
+                    fprintf(stderr, "Disposition setting is missing initial quote\n");
+                    goto done;
+                  }
+                  data = after_colon+2;
+                  if (!(after_colon = strchr(data, '"'))) {
+                    fprintf(stderr, "Disposition setting is missing final quote\n");
+                    goto done;
+                  }
+                  after_colon[0] = 0;
+                  ++after_colon;
+                  if (after_colon[0] == ';' && after_colon[1] == ' ')
+                    after_colon += 2;
+
+                  if (!strcasecmp(colon, "name"))
+                    name = data;
+                  else if (!strcasecmp(colon, "filename"))
+                    filename = data;
+                }
+              } else if (!strcasecmp(header, "Content-Type")) {
+                type = colon;
+              }
+            }
+
+            part = memmem(after_sub_headers, back - after_sub_headers, boundary, boundary_len);
+            if (!part) {
+              fprintf(stderr, "Missing boundary after multipart payload\n");
+              goto done;
+            }
+            part[-2] = 0;
+            part_len = part - after_sub_headers - 2;
+            part[0] = 0;
+            part += boundary_len;
+
+            if (filename) {
+              uw_Basis_file *f = malloc(sizeof(uw_Basis_file));
+              uw_Basis_files fs = { 1, f };
+
+              f->name = filename;
+              f->data.size = part_len;
+              f->data.data = after_sub_headers;
+
+              uw_set_file_input(ctx, name, fs);
+            } else
+              uw_set_input(ctx, name, after_sub_headers);
+          }
+        }
+        else {
+          if (is_post)
+            inputs = after_headers;
+          else if (inputs = strchr(path, '?'))
+            *inputs++ = 0;
+
+          if (inputs) {
+            char *name, *value;
+
+            while (*inputs) {
+              name = inputs;
+              if (inputs = strchr(inputs, '&'))
+                *inputs++ = 0;
+              else
+                inputs = strchr(name, 0);
+
+              if (value = strchr(name, '=')) {
+                *value++ = 0;
+                uw_set_input(ctx, name, value);
+              }
+              else
+                uw_set_input(ctx, name, "");
             }
-            else
-              uw_set_input(ctx, name, "");
           }
         }
 
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 6266e12d..99564605 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -282,11 +282,23 @@ typedef struct {
   buf msgs;
 } delta;
 
+typedef enum {
+  UNSET, NORMAL, FILES
+} input_kind;
+
+typedef struct {
+  input_kind kind;
+  union {
+    char *normal;
+    uw_Basis_files files;
+  } data;
+} input;
+
 struct uw_context {
   char *headers, *headers_end;
 
   buf outHeaders, page, heap, script;
-  char **inputs;
+  input *inputs;
 
   int source_count;
 
@@ -325,7 +337,7 @@ uw_context uw_init() {
   buf_init(&ctx->script, 1);
   ctx->script.start[0] = 0;
 
-  ctx->inputs = calloc(uw_inputs_len, sizeof(char *));
+  ctx->inputs = calloc(uw_inputs_len, sizeof(input));
 
   ctx->db = NULL;
 
@@ -398,7 +410,7 @@ void uw_reset_keep_request(uw_context ctx) {
 
 void uw_reset(uw_context ctx) {
   uw_reset_keep_request(ctx);
-  memset(ctx->inputs, 0, uw_inputs_len * sizeof(char *));
+  memset(ctx->inputs, 0, uw_inputs_len * sizeof(input));
 }
 
 void uw_db_init(uw_context);
@@ -544,9 +556,9 @@ char *uw_error_message(uw_context ctx) {
   return ctx->error_message;
 }
 
-int uw_input_num(char*);
+extern int uw_input_num(const char*);
 
-void uw_set_input(uw_context ctx, char *name, char *value) {
+void uw_set_input(uw_context ctx, const char *name, char *value) {
   int n = uw_input_num(name);
 
   if (n < 0)
@@ -555,9 +567,8 @@ void uw_set_input(uw_context ctx, char *name, char *value) {
   if (n >= uw_inputs_len)
     uw_error(ctx, FATAL, "For input name %s, index %d is out of range", name, n);
 
-  ctx->inputs[n] = value;
-
-  //printf("[%d] %s = %s\n", n, name, value);
+  ctx->inputs[n].kind = NORMAL;
+  ctx->inputs[n].data.normal = value;
 }
 
 char *uw_get_input(uw_context ctx, int n) {
@@ -565,8 +576,17 @@ char *uw_get_input(uw_context ctx, int n) {
     uw_error(ctx, FATAL, "Negative input index %d", n);
   if (n >= uw_inputs_len)
     uw_error(ctx, FATAL, "Out-of-bounds input index %d", n);
-  //printf("[%d] = %s\n", n, ctx->inputs[n]);
-  return ctx->inputs[n];
+
+  switch (ctx->inputs[n].kind) {
+  case UNSET:
+    return NULL;
+  case FILES:
+    uw_error(ctx, FATAL, "Tried to read a files form input as normal");
+  case NORMAL:
+    return ctx->inputs[n].data.normal;
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
 }
 
 char *uw_get_optional_input(uw_context ctx, int n) {
@@ -574,8 +594,51 @@ char *uw_get_optional_input(uw_context ctx, int n) {
     uw_error(ctx, FATAL, "Negative input index %d", n);
   if (n >= uw_inputs_len)
     uw_error(ctx, FATAL, "Out-of-bounds input index %d", n);
-  //printf("[%d] = %s\n", n, ctx->inputs[n]);
-  return (ctx->inputs[n] == NULL ? "" : ctx->inputs[n]);
+
+  switch (ctx->inputs[n].kind) {
+  case UNSET:
+    return "";
+  case FILES:
+    uw_error(ctx, FATAL, "Tried to read a files form input as normal");
+  case NORMAL:
+    return ctx->inputs[n].data.normal;
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+void uw_set_file_input(uw_context ctx, const char *name, uw_Basis_files fs) {
+  int n = uw_input_num(name);
+
+  if (n < 0)
+    uw_error(ctx, FATAL, "Bad file input name %s", name);
+
+  if (n >= uw_inputs_len)
+    uw_error(ctx, FATAL, "For file input name %s, index %d is out of range", name, n);
+
+  ctx->inputs[n].kind = FILES;
+  ctx->inputs[n].data.files = fs;
+}
+
+uw_Basis_files uw_get_file_input(uw_context ctx, int n) {
+  if (n < 0)
+    uw_error(ctx, FATAL, "Negative file input index %d", n);
+  if (n >= uw_inputs_len)
+    uw_error(ctx, FATAL, "Out-of-bounds file input index %d", n);
+
+  switch (ctx->inputs[n].kind) {
+  case UNSET:
+    {
+      uw_Basis_files fs = {};
+      return fs;
+    }
+  case FILES:
+    return ctx->inputs[n].data.files;
+  case NORMAL:
+    uw_error(ctx, FATAL, "Tried to read a normal form input as files");
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
 }
 
 void uw_set_script_header(uw_context ctx, const char *s) {
@@ -1393,7 +1456,7 @@ uw_Basis_string uw_Basis_strcat(uw_context ctx, uw_Basis_string s1, uw_Basis_str
   return s;
 }
 
-uw_Basis_string uw_Basis_strdup(uw_context ctx, uw_Basis_string s1) {
+uw_Basis_string uw_strdup(uw_context ctx, uw_Basis_string s1) {
   int len = strlen(s1) + 1;
   char *s;
 
@@ -1407,9 +1470,9 @@ uw_Basis_string uw_Basis_strdup(uw_context ctx, uw_Basis_string s1) {
   return s;
 }
 
-uw_Basis_string uw_Basis_maybe_strdup(uw_context ctx, uw_Basis_string s1) {
+uw_Basis_string uw_maybe_strdup(uw_context ctx, uw_Basis_string s1) {
   if (s1)
-    return uw_Basis_strdup(ctx, s1);
+    return uw_strdup(ctx, s1);
   else
     return NULL;
 }
@@ -1477,7 +1540,7 @@ uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
       if (isprint(c))
         *s2++ = c;
       else {
-        sprintf(s2, "\\%3o", c);
+        sprintf(s2, "\\%03o", c);
         s2 += 4;
       }
     }
@@ -1488,6 +1551,43 @@ uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
   return r;
 }
 
+uw_Basis_string uw_Basis_sqlifyBlob(uw_context ctx, uw_Basis_blob b) {
+  char *r, *s2;
+  size_t i;
+
+  uw_check_heap(ctx, b.size * 5 + 11);
+
+  r = s2 = ctx->heap.front;
+  *s2++ = 'E';
+  *s2++ = '\'';
+
+  for (i = 0; i < b.size; ++i) {
+    char c = b.data[i];
+
+    switch (c) {
+    case '\'':
+      strcpy(s2, "\\'");
+      s2 += 2;
+      break;
+    case '\\':
+      strcpy(s2, "\\\\\\\\");
+      s2 += 4;
+      break;
+    default:
+      if (isprint(c))
+        *s2++ = c;
+      else {
+        sprintf(s2, "\\\\%03o", c);
+        s2 += 5;
+      }
+    }
+  }
+
+  strcpy(s2, "'::bytea");
+  ctx->heap.front = s2 + 9;
+  return r;
+}
+
 char *uw_Basis_sqlifyChannel(uw_context ctx, uw_Basis_channel chn) {
   int len;
   char *r;
@@ -2020,3 +2120,22 @@ uw_Basis_string uw_Basis_makeSigString(uw_context ctx, uw_Basis_string sig) {
 uw_Basis_string uw_Basis_sigString(uw_context ctx, uw_unit u) {
   return uw_cookie_sig(ctx);
 }
+
+uw_Basis_string uw_Basis_fileName(uw_context ctx, uw_Basis_file f) {
+  return f.name;
+}
+
+uw_Basis_blob uw_Basis_fileData(uw_context ctx, uw_Basis_file f) {
+  return f.data;
+}
+
+uw_Basis_int uw_Basis_numFiles(uw_context ctx, uw_Basis_files fs) {
+  return fs.size;
+}
+
+uw_Basis_file uw_Basis_fileNum(uw_context ctx, uw_Basis_files fs, uw_Basis_int n) {
+  if (n < 0 || n >= fs.size)
+    uw_error(ctx, FATAL, "Files index out of bounds");
+  else
+    return fs.files[n];
+}
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 69332b49..8450c467 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -400,7 +400,7 @@ fun p_unsql wontLeakStrings env (tAll as (t, loc)) e =
         if wontLeakStrings then
             e
         else
-            box [string "uw_Basis_strdup(ctx, ", e, string ")"]
+            box [string "uw_strdup(ctx, ", e, string ")"]
       | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
       | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
       | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
@@ -447,10 +447,20 @@ datatype sql_type =
        | String
        | Bool
        | Time
+       | Blob
        | Channel
        | Client
        | Nullable of sql_type
 
+fun isBlob Blob = true
+  | isBlob (Nullable t) = isBlob t
+  | isBlob _ = false
+
+fun isFiles (t : typ) =
+    case #1 t of
+        TFfi ("Basis", "files") => true
+      | _ => false
+
 fun p_sql_type' t =
     case t of
         Int => "uw_Basis_int"
@@ -458,6 +468,7 @@ fun p_sql_type' t =
       | String => "uw_Basis_string"
       | Bool => "uw_Basis_bool"
       | Time => "uw_Basis_time"
+      | Blob => "uw_Basis_blob"
       | Channel => "uw_Basis_channel"
       | Client => "uw_Basis_client"
       | Nullable String => "uw_Basis_string"
@@ -475,6 +486,7 @@ fun getPargs (e, _) =
       | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)]
       | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)]
       | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)]
+      | EFfiApp ("Basis", "sqlifyBlob", [e]) => [(e, Blob)]
       | EFfiApp ("Basis", "sqlifyChannel", [e]) => [(e, Channel)]
       | EFfiApp ("Basis", "sqlifyClient", [e]) => [(e, Client)]
 
@@ -501,6 +513,7 @@ fun p_ensql t e =
       | String => e
       | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
       | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
+      | Blob => box [e, string ".data"]
       | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
       | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
       | Nullable String => e
@@ -534,6 +547,7 @@ fun notLeaky env allowHeapAllocated =
                                                   | SOME t => nl ok' t) cons
                  end)
               | TFfi ("Basis", "string") => false
+              | TFfi ("Basis", "blob") => false
               | TFfi _ => true
               | TOption t => allowHeapAllocated andalso nl ok t
     in
@@ -1478,6 +1492,19 @@ fun p_exp' par env (e, loc) =
                               newline,
                               newline,
 
+                              string "const int paramFormats[] = { ",
+                              p_list_sep (box [string ",", space])
+                              (fn (_, t) => if isBlob t then string "1" else string "0") ets,
+                              string " };",
+                              newline,
+                              string "const int paramLengths[] = { ",
+                              p_list_sepi (box [string ",", space])
+                              (fn i => fn (_, Blob) => string ("arg" ^ Int.toString (i + 1) ^ ".size")
+                                        | (_, Nullable Blob) => string ("arg" ^ Int.toString (i + 1)
+                                                                        ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
+                                        | _ => string "0") ets,
+                              string " };",
+                              newline,
                               string "const char *paramValues[] = { ",
                               p_list_sepi (box [string ",", space])
                               (fn i => fn (_, t) => p_ensql t (box [string "arg",
@@ -1495,7 +1522,7 @@ fun p_exp' par env (e, loc) =
                                     string (Int.toString n),
                                     string "\", ",
                                     string (Int.toString (length (getPargs query))),
-                                    string ", paramValues, NULL, NULL, 0);"],
+                                    string ", paramValues, paramLengths, paramFormats, 0);"],
                  newline,
                  newline,
 
@@ -1790,7 +1817,7 @@ fun p_exp' par env (e, loc) =
         in
             box [string "({",
                  newline,
-                 string "uw_Basis_string request = uw_Basis_maybe_strdup(ctx, ",
+                 string "uw_Basis_string request = uw_maybe_strdup(ctx, ",
                  p_exp env e,
                  string ");",
                  newline,
@@ -2173,6 +2200,7 @@ fun p_sqltype'' env (tAll as (t, loc)) =
       | TFfi ("Basis", "string") => "text"
       | TFfi ("Basis", "bool") => "bool"
       | TFfi ("Basis", "time") => "timestamp"
+      | TFfi ("Basis", "blob") => "bytea"
       | TFfi ("Basis", "channel") => "int8"
       | TFfi ("Basis", "client") => "int4"
       | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
@@ -2382,26 +2410,37 @@ fun p_file env (ds, ps) =
                                                                    (TFfi ("Basis", "bool"), _) => "optional_"
                                                                  | _ => ""
                                                    in
-                                                       box [string "request = uw_get_",
-                                                            string f,
-                                                            string "input(ctx, ",
-                                                            string (Int.toString n),
-                                                            string ");",
-                                                            newline,
-                                                            string "if (request == NULL)",
-                                                            newline,
-                                                            box [string "uw_error(ctx, FATAL, \"Missing input ",
-                                                                 string x,
-                                                                 string "\");"],
-                                                            newline,
-                                                            string "uw_input_",
-                                                            p_ident x,
-                                                            space,
-                                                            string "=",
-                                                            space,
-                                                            unurlify env t,
-                                                            string ";",
-                                                            newline]
+                                                       if isFiles t then
+                                                           box [string "uw_input_",
+                                                                p_ident x,
+                                                                space,
+                                                                string "=",
+                                                                space,
+                                                                string "uw_get_file_input(ctx, ",
+                                                                string (Int.toString n),
+                                                                string ");",
+                                                                newline]
+                                                       else
+                                                           box [string "request = uw_get_",
+                                                                string f,
+                                                                string "input(ctx, ",
+                                                                string (Int.toString n),
+                                                                string ");",
+                                                                newline,
+                                                                string "if (request == NULL)",
+                                                                newline,
+                                                                box [string "uw_error(ctx, FATAL, \"Missing input ",
+                                                                     string x,
+                                                                     string "\");"],
+                                                                newline,
+                                                                string "uw_input_",
+                                                                p_ident x,
+                                                                space,
+                                                                string "=",
+                                                                space,
+                                                                unurlify env t,
+                                                                string ";",
+                                                                newline]
                                                    end) xts),
                                       string "struct __uws_",
                                       string (Int.toString i),
diff --git a/src/marshalcheck.sml b/src/marshalcheck.sml
index c48fd14f..3d517779 100644
--- a/src/marshalcheck.sml
+++ b/src/marshalcheck.sml
@@ -57,6 +57,7 @@ val clientToServer = [("Basis", "int"),
                       ("Basis", "float"),
                       ("Basis", "string"),
                       ("Basis", "time"),
+                      ("Basis", "files"),
                       ("Basis", "unit"),
                       ("Basis", "option"),
                       ("Basis", "bool")]
diff --git a/src/monoize.sml b/src/monoize.sml
index 62a46277..8ccb84fc 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1663,6 +1663,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
                        (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc),
              fm)
+          | L.EFfi ("Basis", "sql_blob") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "blob"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyBlob", [(L'.ERel 0, loc)]), loc)), loc),
+             fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) =>
             ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc),
                        (L'.EFfiApp ("Basis", "sqlifyChannel", [(L'.ERel 0, loc)]), loc)), loc),
@@ -2339,6 +2343,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                raise Fail "No name passed to ltextarea tag"))
 
                   | "checkbox" => input "checkbox"
+                  | "upload" => input "file"
 
                   | "radio" =>
                     (case targs of
@@ -2475,6 +2480,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                          fm)
                     end
 
+                val hasUpload = CoreUtil.Exp.exists {kind = fn _ => false,
+                                                     con = fn _ => false,
+                                                     exp = fn e =>
+                                                              case e of
+                                                                  L.EFfi ("Basis", "upload") => true
+                                                                | _ => false} xml
+
                 val (xml, fm) = monoExp (env, st, fm) xml
 
                 val xml =
@@ -2514,6 +2526,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                         end
                     else
                         xml
+
+                val action = if hasUpload then
+                                 (L'.EStrcat (action,
+                                              (L'.EPrim (Prim.String " enctype=\"multipart/form-data\""), loc)), loc)
+                             else
+                                 action
+
             in
                 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc),
                                            (L'.EStrcat (action,
diff --git a/tests/blob.ur b/tests/blob.ur
new file mode 100644
index 00000000..a62eefc1
--- /dev/null
+++ b/tests/blob.ur
@@ -0,0 +1,22 @@
+sequence s
+table t : { Id : int, Nam : option string, Data : blob, Desc : string }
+
+fun save r =
+    if numFiles r.Data <> 1 then
+        error <xml>Please submit exactly one file.</xml>
+    else
+        let
+            val f = fileNum r.Data 0
+        in
+            id <- nextval s;
+            dml (INSERT INTO t (Id, Nam, Data, Desc) VALUES ({[id]}, {[fileName f]}, {[fileData f]}, {[r.Desc]}));
+            main ()
+        end
+
+and main () = return <xml><body>
+  <form>
+    <textbox{#Desc}/>
+    <upload{#Data}/>
+    <submit action={save}/>
+  </form>
+</body></xml>
diff --git a/tests/blob.urp b/tests/blob.urp
new file mode 100644
index 00000000..2c6be994
--- /dev/null
+++ b/tests/blob.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=blob
+sql blob.sql
+
+blob
diff --git a/tests/blob.urs b/tests/blob.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/blob.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page