changeset 1407:7d963b8019e6

Some fixes for tasks and onError handlers
author Adam Chlipala <adam@chlipala.net>
date Thu, 20 Jan 2011 15:11:45 -0500
parents e8bea46f8eda
children 56ba9c442a2d
files src/c/urweb.c src/cjr_print.sml src/elaborate.sml
diffstat 3 files changed, 38 insertions(+), 31 deletions(-) [+]
line wrap: on
line diff
--- a/src/c/urweb.c	Thu Jan 20 12:50:42 2011 -0500
+++ b/src/c/urweb.c	Thu Jan 20 15:11:45 2011 -0500
@@ -728,22 +728,6 @@
   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 @@
   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");
+}
--- a/src/cjr_print.sml	Thu Jan 20 12:50:42 2011 -0500
+++ b/src/cjr_print.sml	Thu Jan 20 15:11:45 2011 -0500
@@ -2991,6 +2991,20 @@
              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 @@
              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,
 
--- a/src/elaborate.sml	Thu Jan 20 12:50:42 2011 -0500
+++ b/src/elaborate.sml	Thu Jan 20 15:11:45 2011 -0500
@@ -4012,7 +4012,8 @@
                          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)