summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-01-20 15:11:45 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2011-01-20 15:11:45 -0500
commit599e3a956aff1a82c527c76c09f8b9ac9df690d1 (patch)
tree008aed8a59eeb1194b399bb244f7ab66101291c4 /src
parent69773c9b902b0ebc39ddd21c977e97947ba8dda2 (diff)
Some fixes for tasks and onError handlers
Diffstat (limited to 'src')
-rw-r--r--src/c/urweb.c38
-rw-r--r--src/cjr_print.sml28
-rw-r--r--src/elaborate.sml3
3 files changed, 38 insertions, 31 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 382c9d77..12934509 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -728,22 +728,6 @@ failure_kind uw_begin(uw_context ctx, char *path) {
return r;
}
-failure_kind uw_begin_onError(uw_context ctx, char *msg) {
- int r = setjmp(ctx->jmp_buf);
-
- if (ctx->app->on_error) {
- if (r == 0) {
- if (ctx->app->db_begin(ctx))
- uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN");
-
- ctx->app->on_error(ctx, msg);
- }
-
- return r;
- } else
- uw_error(ctx, FATAL, "Tried to run nonexistent onError handler");
-}
-
uw_Basis_client uw_Basis_self(uw_context ctx) {
if (ctx->client == NULL)
uw_error(ctx, FATAL, "Call to Basis.self() from page that has only server-side code");
@@ -3747,3 +3731,25 @@ uw_Basis_time *uw_Basis_readUtc(uw_context ctx, uw_Basis_string s) {
else
return NULL;
}
+
+static const char begin_xhtml[] = "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">";
+
+failure_kind uw_begin_onError(uw_context ctx, char *msg) {
+ int r = setjmp(ctx->jmp_buf);
+
+ if (ctx->app->on_error) {
+ if (r == 0) {
+ if (ctx->app->db_begin(ctx))
+ uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN");
+
+ uw_write_header(ctx, "HTTP/1.1 500 Internal Server Error\r\n");
+ uw_write_header(ctx, "Content-type: text/html\r\n\r\n");
+ uw_write(ctx, begin_xhtml);
+ ctx->app->on_error(ctx, msg);
+ uw_write(ctx, "</html>");
+ }
+
+ return r;
+ } else
+ uw_error(ctx, FATAL, "Tried to run nonexistent onError handler");
+}
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 8aba232d..fffeadcc 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2991,6 +2991,20 @@ fun p_file env (ds, ps) =
newline,
newline,
+ string "static const char begin_xhtml[] = \"<?xml version=\\\"1.0\\\" encoding=\\\"utf-8\\\" ?>\\n<!DOCTYPE html PUBLIC \\\"-//W3C//DTD XHTML 1.0 Transitional//EN\\\" \\\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\\\">\\n<html xmlns=\\\"http://www.w3.org/1999/xhtml\\\" xml:lang=\\\"en\\\" lang=\\\"en\\\">\";",
+ newline,
+ newline,
+
+ p_list_sep newline (fn x => x) pds,
+ newline,
+ newline,
+ string "static int uw_input_num(const char *name) {",
+ newline,
+ makeSwitch (fnums, 0),
+ string "}",
+ newline,
+ newline,
+
box (ListUtil.mapi (fn (i, (_, x1, x2, e)) =>
box [string "static void uw_periodic",
string (Int.toString i),
@@ -3021,20 +3035,6 @@ fun p_file env (ds, ps) =
newline,
newline,
- string "static const char begin_xhtml[] = \"<?xml version=\\\"1.0\\\" encoding=\\\"utf-8\\\" ?>\\n<!DOCTYPE html PUBLIC \\\"-//W3C//DTD XHTML 1.0 Transitional//EN\\\" \\\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\\\">\\n<html xmlns=\\\"http://www.w3.org/1999/xhtml\\\" xml:lang=\\\"en\\\" lang=\\\"en\\\">\";",
- newline,
- newline,
-
- p_list_sep newline (fn x => x) pds,
- newline,
- newline,
- string "static int uw_input_num(const char *name) {",
- newline,
- makeSwitch (fnums, 0),
- string "}",
- newline,
- newline,
-
makeChecker ("uw_check_url", Settings.getUrlRules ()),
newline,
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 2da34725..61a0b1c0 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -4012,7 +4012,8 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
val xpage = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc), page), loc)
val func = (L'.TFun ((L'.CModProj (!basis_r, [], "xbody"), loc), xpage), loc)
in
- unifyCons env loc t func;
+ (unifyCons env loc t func
+ handle CUnify _ => ErrorMsg.error "onError handler has wrong type.");
([(L'.DOnError (n, ms, s), loc)], (env, denv, gs))
end)