summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--include/urweb.h3
-rw-r--r--src/c/driver.c16
-rw-r--r--src/c/urweb.c40
-rw-r--r--src/cjr_print.sml8
-rw-r--r--src/compiler.sig3
-rw-r--r--src/compiler.sml11
-rw-r--r--tests/blob.ur25
7 files changed, 90 insertions, 16 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 4df7caef..716c3bc6 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -22,6 +22,7 @@ void uw_reset_keep_error_message(uw_context);
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_time uw_Basis_unurlifyTime(uw_context, char **);
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_int uw_Basis_stringToInt_error(uw_context, uw_Basis_string);
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 --git a/src/c/driver.c b/src/c/driver.c
index 63a7d224..2f84184f 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -148,7 +148,7 @@ 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;
+ size_t buf_size = 2;
char *buf = malloc(buf_size);
while (1) {
@@ -167,7 +167,7 @@ static void *worker(void *data) {
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 @@ static void *worker(void *data) {
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 @@ static void *worker(void *data) {
}
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 --git a/src/c/urweb.c b/src/c/urweb.c
index 28364f2c..22b8a902 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -443,6 +443,11 @@ void uw_set_headers(uw_context ctx, char *headers) {
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 @@ uw_Basis_string uw_maybe_strdup(uw_context ctx, uw_Basis_string s1) {
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_time uw_Basis_stringToTime_error(uw_context ctx, uw_Basis_string s) {
}
}
+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 --git a/src/cjr_print.sml b/src/cjr_print.sml
index 3f7ec1e1..1447d9e5 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -434,6 +434,12 @@ fun p_getcol wontLeakStrings env (tAll as (t, loc)) i =
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 @@ fun notLeaky env allowHeapAllocated =
| 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 --git a/src/compiler.sig b/src/compiler.sig
index e685ffe5..d00f111e 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -40,7 +40,8 @@ signature COMPILER = sig
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 --git a/src/compiler.sml b/src/compiler.sml
index cf54c3cf..99954958 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -605,7 +605,7 @@ val sqlify = {
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 @@ fun compileC {cname, oname, ename, libs, profile} =
(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 @@ fun compile job =
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 --git a/tests/blob.ur b/tests/blob.ur
index 2d58faae..ec683068 100644
--- a/tests/blob.ur
+++ b/tests/blob.ur
@@ -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>