changeset 167:2be573fec9a6

Unurlifying a datatype; longjmp-based error signaling mechanism
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 15:25:42 -0400
parents a991431b77eb
children 25b169416ea8
files include/lacweb.h include/types.h src/c/driver.c src/c/lacweb.c src/cjr_print.sml src/monoize.sml
diffstat 6 files changed, 142 insertions(+), 21 deletions(-) [+]
line wrap: on
line diff
--- a/include/lacweb.h	Tue Jul 29 14:28:44 2008 -0400
+++ b/include/lacweb.h	Tue Jul 29 15:25:42 2008 -0400
@@ -9,6 +9,13 @@
 lw_context lw_init(size_t page_len, size_t heap_len);
 void lw_free(lw_context);
 void lw_reset(lw_context);
+void lw_reset_keep_request(lw_context);
+void lw_reset_keep_error_message(lw_context);
+failure_kind lw_begin(lw_context, char *path);
+
+void lw_error(lw_context, failure_kind, const char *fmt, ...);
+char *lw_error_message(lw_context);
+
 void *lw_malloc(lw_context, size_t);
 int lw_send(lw_context, int sock);
 
--- a/include/types.h	Tue Jul 29 14:28:44 2008 -0400
+++ b/include/types.h	Tue Jul 29 15:25:42 2008 -0400
@@ -12,3 +12,6 @@
 
 typedef lw_Basis_string lw_Basis_xhtml;
 typedef lw_Basis_string lw_Basis_page;
+
+
+typedef enum { SUCCESS, FATAL, BOUNDED_RETRY, UNLIMITED_RETRY } failure_kind;
--- a/src/c/driver.c	Tue Jul 29 14:28:44 2008 -0400
+++ b/src/c/driver.c	Tue Jul 29 15:25:42 2008 -0400
@@ -13,8 +13,6 @@
 int lw_backlog = 10;
 int lw_bufsize = 1024;
 
-void lw_handle(lw_context, char*);
-
 typedef struct node {
   int fd;
   struct node *next;
@@ -51,6 +49,8 @@
 static pthread_mutex_t queue_mutex = PTHREAD_MUTEX_INITIALIZER;
 static pthread_cond_t queue_cond = PTHREAD_COND_INITIALIZER;
 
+#define MAX_RETRIES 5
+
 static void *worker(void *data) {
   int me = *(int *)data;
   lw_context ctx = lw_init(1024, 1024);
@@ -68,6 +68,7 @@
     printf("Handling connection with thread #%d.\n", me);
 
     while (1) {
+      unsigned retries_left = MAX_RETRIES;
       int r = recv(sock, back, lw_bufsize - (back - buf), 0);
 
       if (r < 0) {
@@ -138,11 +139,58 @@
 
         printf("Serving URI %s....\n", path);
 
-        lw_write (ctx, "HTTP/1.1 200 OK\r\n");
-        lw_write(ctx, "Content-type: text/html\r\n\r\n");
-        lw_write(ctx, "<html>");
-        lw_handle(ctx, path);
-        lw_write(ctx, "</html>");
+        while (1) {
+          failure_kind fk;
+
+          lw_write(ctx, "HTTP/1.1 200 OK\r\n");
+          lw_write(ctx, "Content-type: text/html\r\n\r\n");
+          lw_write(ctx, "<html>");
+
+          fk = lw_begin(ctx, path);
+          if (fk == SUCCESS) {
+            lw_write(ctx, "</html>");
+            break;
+          } else if (fk == BOUNDED_RETRY) {
+            if (retries_left) {
+              printf("Error triggers bounded retry: %s\n", lw_error_message(ctx));
+              --retries_left;
+            }
+            else {
+              printf("Fatal error (out of retries): %s\n", lw_error_message(ctx));
+
+              lw_reset_keep_error_message(ctx);
+              lw_write(ctx, "HTTP/1.1 500 Internal Server Error\n\r");
+              lw_write(ctx, "Content-type: text/plain\r\n\r\n");
+              lw_write(ctx, "Fatal error (out of retries): ");
+              lw_write(ctx, lw_error_message(ctx));
+              lw_write(ctx, "\n");
+            }
+          } else if (fk == UNLIMITED_RETRY)
+            printf("Error triggers unlimited retry: %s\n", lw_error_message(ctx));
+          else if (fk == FATAL) {
+            printf("Fatal error: %s\n", lw_error_message(ctx));
+
+            lw_reset_keep_error_message(ctx);
+            lw_write(ctx, "HTTP/1.1 500 Internal Server Error\n\r");
+            lw_write(ctx, "Content-type: text/plain\r\n\r\n");
+            lw_write(ctx, "Fatal error: ");
+            lw_write(ctx, lw_error_message(ctx));
+            lw_write(ctx, "\n");
+
+            break;
+          } else {
+            printf("Unknown lw_handle return code!\n");
+
+            lw_reset_keep_request(ctx);
+            lw_write(ctx, "HTTP/1.1 500 Internal Server Error\n\r");
+            lw_write(ctx, "Content-type: text/plain\r\n\r\n");
+            lw_write(ctx, "Unknown lw_handle return code!\n");
+
+            break;
+          }
+
+          lw_reset_keep_request(ctx);
+        }
 
         lw_send(ctx, sock);
 
--- a/src/c/lacweb.c	Tue Jul 29 14:28:44 2008 -0400
+++ b/src/c/lacweb.c	Tue Jul 29 15:25:42 2008 -0400
@@ -3,15 +3,24 @@
 #include <string.h>
 #include <ctype.h>
 #include <assert.h>
+#include <setjmp.h>
+#include <stdarg.h>
 
 #include "types.h"
 
 lw_unit lw_unit_v = {};
 
+#define ERROR_BUF_LEN 1024
+
 struct lw_context {
   char *page, *page_front, *page_back;
   char *heap, *heap_front, *heap_back;
   char **inputs;
+
+  jmp_buf jmp_buf;
+
+  failure_kind failure_kind;
+  char error_message[ERROR_BUF_LEN];
 };
 
 extern int lw_inputs_len;
@@ -27,6 +36,9 @@
 
   ctx->inputs = calloc(lw_inputs_len, sizeof(char *));
 
+  ctx->failure_kind = SUCCESS;
+  ctx->error_message[0] = 0;
+
   return ctx;
 }
 
@@ -37,12 +49,49 @@
   free(ctx);
 }
 
-void lw_reset(lw_context ctx) {
+void lw_reset_keep_request(lw_context ctx) {
   ctx->page_front = ctx->page;
   ctx->heap_front = ctx->heap;
+
+  ctx->failure_kind = SUCCESS;
+  ctx->error_message[0] = 0;
+}
+
+void lw_reset_keep_error_message(lw_context ctx) {
+  ctx->page_front = ctx->page;
+  ctx->heap_front = ctx->heap;
+
+  ctx->failure_kind = SUCCESS;
+}
+
+void lw_reset(lw_context ctx) {
+  lw_reset_keep_request(ctx);
   memset(ctx->inputs, 0, lw_inputs_len * sizeof(char *));
 }
 
+void lw_handle(lw_context, char *);
+
+failure_kind lw_begin(lw_context ctx, char *path) {
+  if (!setjmp(ctx->jmp_buf))
+    lw_handle(ctx, path);
+
+  return ctx->failure_kind;
+}
+
+void lw_error(lw_context ctx, failure_kind fk, const char *fmt, ...) {
+  va_list ap;
+  va_start(ap, fmt);
+
+  ctx->failure_kind = fk;
+  vsnprintf(ctx->error_message, ERROR_BUF_LEN, fmt, ap);
+
+  longjmp(ctx->jmp_buf, 1);
+}
+
+char *lw_error_message(lw_context ctx) {
+  return ctx->error_message;
+}
+
 int lw_input_num(char*);
 
 void lw_set_input(lw_context ctx, char *name, char *value) {
--- a/src/cjr_print.sml	Tue Jul 29 14:28:44 2008 -0400
+++ b/src/cjr_print.sml	Tue Jul 29 15:25:42 2008 -0400
@@ -211,7 +211,7 @@
                  newline,
                  string "struct",
                  space,
-                 string ("_lwd_" ^ x ^ "_" ^ Int.toString n),
+                 string ("__lwd_" ^ x ^ "_" ^ Int.toString n),
                  space,
                  string "{",
                  newline,
@@ -451,34 +451,48 @@
 
                     fun doEm xncs =
                         case xncs of
-                            [] => string "Uh oh"
-                          | (x, n, to) :: rest =>
-                            box [string "(!strcmp(request, \"",
-                                 string x,
-                                 string "\") ? ({",
+                            [] => string ("(lw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL)")
+                          | (x', n, to) :: rest =>
+                            box [string "((!strncmp(request, \"",
+                                 string x',
+                                 string "\", ",
+                                 string (Int.toString (size x')),
+                                 string ") && (request[",
+                                 string (Int.toString (size x')),
+                                 string "] == 0 || request[",
+                                 string (Int.toString (size x')),
+                                 string "] == '/')) ? ({",
                                  newline,
+                                 string "struct",
+                                 space,
                                  string ("__lwd_" ^ x ^ "_" ^ Int.toString i),
                                  space,
-                                 string "__lw_tmp;",
+                                 string "*__lw_tmp = lw_malloc(ctx, sizeof(struct __lwd_",
+                                 string x,
+                                 string "_",
+                                 string (Int.toString i),
+                                 string "));",
                                  newline,
-                                 string "__lw_tmp.tag",
+                                 string "__lw_tmp->tag",
                                  space,
                                  string "=",
                                  space,
-                                 string ("__lwc_" ^ x ^ "_" ^ Int.toString n),
+                                 string ("__lwc_" ^ x' ^ "_" ^ Int.toString n),
                                  string ";",
                                  newline,
                                  string "request",
                                  space,
                                  string "+=",
                                  space,
-                                 string (Int.toString (size x)),
+                                 string (Int.toString (size x')),
                                  string ";",
                                  newline,
+                                 string "if (request[0] == '/') ++request;",
+                                 newline,
                                  case to of
                                      NONE => box []
-                                   | SOME t => box [string "__lw_tmp.data.",
-                                                    string x,
+                                   | SOME t => box [string "__lw_tmp->data.",
+                                                    string x',
                                                     space,
                                                     string "=",
                                                     space,
--- a/src/monoize.sml	Tue Jul 29 14:28:44 2008 -0400
+++ b/src/monoize.sml	Tue Jul 29 15:25:42 2008 -0400
@@ -115,7 +115,7 @@
                   | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", name ^ "ifyFloat", [e]), loc)
                   | L'.TRecord [] => (L'.EPrim (Prim.String ""), loc)
 
-                  | L'.TNamed _ => (L'.EPrim (Prim.String ""), loc)
+                  | L'.TNamed _ => (L'.EPrim (Prim.String "A"), loc)
 
                   | _ => (E.errorAt loc "Don't know how to encode attribute type";
                           Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)];