On start-up, delete/nullify rows mentioning clients or channels

8 files changed, 265 insertions, 163 deletions

diff --git a/src/c/driver.c b/src/c/driver.c
index 14d08b57..52999da3 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -69,7 +69,7 @@ static int try_rollback(uw_context ctx) {
 
 static void *worker(void *data) {
   int me = *(int *)data, retries_left = MAX_RETRIES;
-  uw_context ctx = uw_init(0, 0, 1024, 0);
+  uw_context ctx = uw_init();
   
   while (1) {
     failure_kind fk = uw_begin_init(ctx);
@@ -278,7 +278,7 @@ static void *worker(void *data) {
 }
 
 static void *client_pruner(void *data) {
-  uw_context ctx = uw_init(0, 0, 0, 0);
+  uw_context ctx = uw_init();
   uw_db_init(ctx);
 
   while (1) {
@@ -296,6 +296,19 @@ static void sigint(int signum) {
   exit(0);
 }
 
+static void initialize() {
+  uw_context ctx = uw_init();
+
+  uw_db_init(ctx);
+  if (uw_initialize(ctx) != SUCCESS) {
+    printf("Failed to initialize database!\n");
+    uw_db_rollback(ctx);
+    exit(1);
+  }
+
+  uw_free(ctx);
+}
+
 int main(int argc, char *argv[]) {
   // The skeleton for this function comes from Beej's sockets tutorial.
   int sockfd;  // listen on sock_fd
@@ -342,6 +355,8 @@ int main(int argc, char *argv[]) {
     }
   }
 
+  initialize();
+
   names = calloc(nthreads, sizeof(int));
 
   sockfd = socket(PF_INET, SOCK_STREAM, 0); // do some error checking!
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 62d5be1b..1165c5d1 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -308,15 +308,15 @@ struct uw_context {
 
 extern int uw_inputs_len, uw_timeout;
 
-uw_context uw_init(size_t outHeaders_len, size_t script_len, size_t page_len, size_t heap_len) {
+uw_context uw_init() {
   uw_context ctx = malloc(sizeof(struct uw_context));
 
   ctx->headers = ctx->headers_end = NULL;
 
-  buf_init(&ctx->outHeaders, outHeaders_len);
-  buf_init(&ctx->page, page_len);
-  buf_init(&ctx->heap, heap_len);
-  buf_init(&ctx->script, script_len);
+  buf_init(&ctx->outHeaders, 0);
+  buf_init(&ctx->page, 0);
+  buf_init(&ctx->heap, 0);
+  buf_init(&ctx->script, 0);
   ctx->script.start[0] = 0;
 
   ctx->inputs = calloc(uw_inputs_len, sizeof(char *));
@@ -1931,3 +1931,19 @@ void uw_prune_clients(uw_context ctx) {
 
   pthread_mutex_unlock(&clients_mutex);
 }
+
+void uw_initializer(uw_context ctx);
+
+failure_kind uw_initialize(uw_context ctx) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (r == 0) {
+    if (uw_db_begin(ctx))
+      uw_error(ctx, FATAL, "Error running SQL BEGIN");
+    uw_initializer(ctx);
+    if (uw_db_commit(ctx))
+      uw_error(ctx, FATAL, "Error running SQL COMMIT");
+  }
+
+  return r;
+}
diff --git a/src/cjr.sml b/src/cjr.sml
index 948b345f..41bb6a4c 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -106,7 +106,7 @@ datatype decl' =
 
        | DTable of string * (string * typ) list
        | DSequence of string
-       | DDatabase of string * int
+       | DDatabase of {name : string, expunge : int, initialize : int}
        | DPreparedStatements of (string * int) list
 
        | DJavaScript of string
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 3b1705af..96f60887 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1937,128 +1937,138 @@ fun p_decl env (dAll as (d, _) : decl) =
                             string x,
                             string " */",
                             newline]
-      | DDatabase (s, n) => box [string "static void uw_db_validate(uw_context);",
-                                 newline,
-                                 string "static void uw_db_prepare(uw_context);",
-                                 newline,
-                                 newline,
-                                 string "void uw_db_init(uw_context ctx) {",
-                                 newline,
-                                 string "PGconn *conn = PQconnectdb(\"",
-                                 string (String.toString s),
-                                 string "\");",
-                                 newline,
-                                 string "if (conn == NULL) uw_error(ctx, BOUNDED_RETRY, ",
-                                 string "\"libpq can't allocate a connection.\");",
-                                 newline,
-                                 string "if (PQstatus(conn) != CONNECTION_OK) {",
-                                 newline,
-                                 box [string "char msg[1024];",
-                                      newline,
-                                      string "strncpy(msg, PQerrorMessage(conn), 1024);",
-                                      newline,
-                                      string "msg[1023] = 0;",
-                                      newline,
-                                      string "PQfinish(conn);",
-                                      newline,
-                                      string "uw_error(ctx, BOUNDED_RETRY, ",
-                                      string "\"Connection to Postgres server failed: %s\", msg);"],
-                                 newline,
-                                 string "}",
-                                 newline,
-                                 string "uw_set_db(ctx, conn);",
-                                 newline,
-                                 string "uw_db_validate(ctx);",
-                                 newline,
-                                 string "uw_db_prepare(ctx);",
-                                 newline,
-                                 string "}",
-                                 newline,
-                                 newline,
-                                 string "void uw_db_close(uw_context ctx) {",
-                                 newline,
-                                 string "PQfinish(uw_get_db(ctx));",
-                                 newline,
-                                 string "}",
-                                 newline,
-                                 newline,
+      | DDatabase {name, expunge, initialize} =>
+        box [string "static void uw_db_validate(uw_context);",
+             newline,
+             string "static void uw_db_prepare(uw_context);",
+             newline,
+             newline,
+             string "void uw_db_init(uw_context ctx) {",
+             newline,
+             string "PGconn *conn = PQconnectdb(\"",
+             string (String.toString name),
+             string "\");",
+             newline,
+             string "if (conn == NULL) uw_error(ctx, BOUNDED_RETRY, ",
+             string "\"libpq can't allocate a connection.\");",
+             newline,
+             string "if (PQstatus(conn) != CONNECTION_OK) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, BOUNDED_RETRY, ",
+                  string "\"Connection to Postgres server failed: %s\", msg);"],
+             newline,
+             string "}",
+             newline,
+             string "uw_set_db(ctx, conn);",
+             newline,
+             string "uw_db_validate(ctx);",
+             newline,
+             string "uw_db_prepare(ctx);",
+             newline,
+             string "}",
+             newline,
+             newline,
+             string "void uw_db_close(uw_context ctx) {",
+             newline,
+             string "PQfinish(uw_get_db(ctx));",
+             newline,
+             string "}",
+             newline,
+             newline,
 
-                                 string "int uw_db_begin(uw_context ctx) {",
-                                 newline,
-                                 string "PGconn *conn = uw_get_db(ctx);",
-                                 newline,
-                                 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
-                                 newline,
-                                 newline,
-                                 string "if (res == NULL) return 1;",
-                                 newline,
-                                 newline,
-                                 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-                                 box [string "PQclear(res);",
-                                      newline,
-                                      string "return 1;",
-                                      newline],
-                                 string "}",
-                                 newline,
-                                 string "return 0;",
-                                 newline,
-                                 string "}",
-                                 newline,
-                                 newline,
+             string "int uw_db_begin(uw_context ctx) {",
+             newline,
+             string "PGconn *conn = uw_get_db(ctx);",
+             newline,
+             string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
+             newline,
+             newline,
+             string "if (res == NULL) return 1;",
+             newline,
+             newline,
+             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+             box [string "PQclear(res);",
+                  newline,
+                  string "return 1;",
+                  newline],
+             string "}",
+             newline,
+             string "return 0;",
+             newline,
+             string "}",
+             newline,
+             newline,
 
-                                 string "int uw_db_commit(uw_context ctx) {",
-                                 newline,
-                                 string "PGconn *conn = uw_get_db(ctx);",
-                                 newline,
-                                 string "PGresult *res = PQexec(conn, \"COMMIT\");",
-                                 newline,
-                                 newline,
-                                 string "if (res == NULL) return 1;",
-                                 newline,
-                                 newline,
-                                 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-                                 box [string "PQclear(res);",
-                                      newline,
-                                      string "return 1;",
-                                      newline],
-                                 string "}",
-                                 newline,
-                                 string "return 0;",
-                                 newline,
-                                 string "}",
-                                 newline,
-                                 newline,
+             string "int uw_db_commit(uw_context ctx) {",
+             newline,
+             string "PGconn *conn = uw_get_db(ctx);",
+             newline,
+             string "PGresult *res = PQexec(conn, \"COMMIT\");",
+             newline,
+             newline,
+             string "if (res == NULL) return 1;",
+             newline,
+             newline,
+             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+             box [string "PQclear(res);",
+                  newline,
+                  string "return 1;",
+                  newline],
+             string "}",
+             newline,
+             string "return 0;",
+             newline,
+             string "}",
+             newline,
+             newline,
 
-                                 string "int uw_db_rollback(uw_context ctx) {",
-                                 newline,
-                                 string "PGconn *conn = uw_get_db(ctx);",
-                                 newline,
-                                 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
-                                 newline,
-                                 newline,
-                                 string "if (res == NULL) return 1;",
-                                 newline,
-                                 newline,
-                                 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-                                 box [string "PQclear(res);",
-                                      newline,
-                                      string "return 1;",
-                                      newline],
-                                 string "}",
-                                 newline,
-                                 string "return 0;",
-                                 newline,
-                                 string "}",
-                                 newline,
-                                 newline,
+             string "int uw_db_rollback(uw_context ctx) {",
+             newline,
+             string "PGconn *conn = uw_get_db(ctx);",
+             newline,
+             string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
+             newline,
+             newline,
+             string "if (res == NULL) return 1;",
+             newline,
+             newline,
+             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+             box [string "PQclear(res);",
+                  newline,
+                  string "return 1;",
+                  newline],
+             string "}",
+             newline,
+             string "return 0;",
+             newline,
+             string "}",
+             newline,
+             newline,
 
-                                 string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
-                                 newline,
-                                 box [p_enamed env n,
-                                      string "(ctx, cli);",
-                                      newline],
-                                 string "}",
-                                 newline]
+             string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
+             newline,
+             box [p_enamed env expunge,
+                  string "(ctx, cli);",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "void uw_initializer(uw_context ctx) {",
+             newline,
+             box [p_enamed env initialize,
+                  string "(ctx, uw_unit_v);",
+                  newline],
+             string "}",
+             newline]
 
       | DPreparedStatements [] =>
         box [string "static void uw_db_prepare(uw_context ctx) {",
@@ -2762,6 +2772,8 @@ fun p_file env (ds, ps) =
                       string "int uw_db_rollback(uw_context ctx) { return 0; };",
                       newline,
                       string "void uw_expunger(uw_context ctx, uw_Basis_client cli) { };",
+                      newline,
+                      string "void uw_initializer(uw_context ctx) { };",
                       newline]]
     end
 
diff --git a/src/mono.sml b/src/mono.sml
index 95c65fc9..f4bbc868 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -122,7 +122,7 @@ datatype decl' =
 
        | DTable of string * (string * typ) list
        | DSequence of string
-       | DDatabase of string * int
+       | DDatabase of {name : string, expunge : int, initialize : int}
 
        | DJavaScript of string
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 23b32a72..b30fa4e8 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -413,13 +413,16 @@ fun p_decl env (dAll as (d, _) : decl) =
       | DSequence s => box [string "(* SQL sequence ",
                             string s,
                             string "*)"]
-      | DDatabase (s, n) => box [string "database",
-                                 space,
-                                 string s,
-                                 space,
-                                 string "(",
-                                 p_enamed env n,
-                                 string ")"]
+      | DDatabase {name, expunge, initialize} => box [string "database",
+                                                      space,
+                                                      string name,
+                                                      space,
+                                                      string "(",
+                                                      p_enamed env expunge,
+                                                      string ",",
+                                                      space,
+                                                      p_enamed env initialize,
+                                                      string ")"]
       | DJavaScript s => box [string "JavaScript(",
                               string s,
                               string ")"]
diff --git a/src/mono_shake.sml b/src/mono_shake.sml
index 475c4895..343ec728 100644
--- a/src/mono_shake.sml
+++ b/src/mono_shake.sml
@@ -45,7 +45,7 @@ fun shake file =
     let
         val page_es = List.foldl
                           (fn ((DExport (_, _, n, _, _), _), page_es) => n :: page_es
-                            | ((DDatabase (_, n), _), page_es) => n :: page_es
+                            | ((DDatabase {expunge = n1, initialize = n2, ...}, _), page_es) => n1 :: n2 :: page_es
                             | (_, page_es) => page_es) [] file
 
         val (cdef, edef) = foldl (fn ((DDatatype (_, n, xncs), _), (cdef, edef)) =>
diff --git a/src/monoize.sml b/src/monoize.sml
index 361986d2..71672785 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2474,6 +2474,25 @@ fun monoize env file =
         val loc = E.dummySpan
         val client = (L'.TFfi ("Basis", "client"), loc)
         val unit = (L'.TRecord [], loc)
+
+        fun calcClientish xts =
+            foldl (fn ((x : L.con, t : L.con), st as (nullable, notNullable)) =>
+                      case #1 x of
+                          L.CName x =>
+                          (case #1 t of
+                               L.CFfi ("Basis", "client") =>
+                               (nullable, (x, Client) :: notNullable)
+                             | L.CApp ((L.CFfi ("Basis", "option"), _),
+                                       (L.CFfi ("Basis", "client"), _)) =>
+                               ((x, Client) :: nullable, notNullable)
+                             | L.CApp ((L.CFfi ("Basis", "channel"), _), _) =>
+                               (nullable, (x, Channel) :: notNullable)
+                             | L.CApp ((L.CFfi ("Basis", "option"), _),
+                                       (L.CApp ((L.CFfi ("Basis", "channel"), _), _), _)) =>
+                               ((x, Channel) :: nullable, notNullable)
+                             | _ => st)
+                        | _ => st) ([], []) xts
+
         fun expunger () =
             let
                 val target = (L'.EFfiApp ("Basis", "sqlifyClient", [(L'.ERel 0, loc)]), loc)
@@ -2482,23 +2501,7 @@ fun monoize env file =
                     case xts of
                         L.CRecord (_, xts) =>
                         let
-                            val (nullable, notNullable) =
-                                foldl (fn ((x, t), st as (nullable, notNullable)) =>
-                                          case #1 x of
-                                              L.CName x =>
-                                              (case #1 t of
-                                                   L.CFfi ("Basis", "client") =>
-                                                   (nullable, (x, Client) :: notNullable)
-                                                 | L.CApp ((L.CFfi ("Basis", "option"), _),
-                                                           (L.CFfi ("Basis", "client"), _)) =>
-                                                   ((x, Client) :: nullable, notNullable)
-                                                 | L.CApp ((L.CFfi ("Basis", "channel"), _), _) =>
-                                                   (nullable, (x, Channel) :: notNullable)
-                                                 | L.CApp ((L.CFfi ("Basis", "option"), _),
-                                                           (L.CApp ((L.CFfi ("Basis", "channel"), _), _), _)) =>
-                                                   ((x, Channel) :: nullable, notNullable)
-                                                 | _ => st)
-                                            | _ => st) ([], []) xts
+                            val (nullable, notNullable) = calcClientish xts
 
                             fun cond (x, v) =
                                 (L'.EStrcat ((L'.EPrim (Prim.String ("uw_" ^ x
@@ -2529,7 +2532,7 @@ fun monoize env file =
                                      (L'.EDml (foldl
                                                    (fn (eb, s) =>
                                                        (L'.EStrcat (s,
-                                                                    (L'.EStrcat ((L'.EPrim (Prim.String " AND "),
+                                                                    (L'.EStrcat ((L'.EPrim (Prim.String " OR "),
                                                                                   loc),
                                                                                  cond eb), loc)), loc))
                                                    (L'.EStrcat ((L'.EPrim (Prim.String ("DELETE FROM uw_"
@@ -2551,21 +2554,74 @@ fun monoize env file =
                             | _ => e) e file
             end
 
+        fun initializer () =
+            let
+                fun doTable (tab, xts, e) =
+                    case xts of
+                        L.CRecord (_, xts) =>
+                        let
+                            val (nullable, notNullable) = calcClientish xts
+
+                            val e =
+                                case nullable of
+                                    [] => e
+                                  | (x, _) :: ebs =>
+                                    (L'.ESeq (
+                                     (L'.EDml (L'.EPrim (Prim.String
+                                                             (foldl (fn ((x, _), s) =>
+                                                                        s ^ ", uw_" ^ x ^ " = NULL")
+                                                                    ("UPDATE uw_"
+                                                                     ^ tab
+                                                                     ^ " SET uw_"
+                                                                     ^ x
+                                                                     ^ " = NULL")
+                                                                    ebs)), loc), loc),
+                                     e), loc)
+
+                            val e =
+                                case notNullable of
+                                    [] => e
+                                  | eb :: ebs =>
+                                    (L'.ESeq (
+                                     (L'.EDml (L'.EPrim (Prim.String ("DELETE FROM uw_"
+                                                                      ^ tab)), loc), loc),
+                                     e), loc)
+                        in
+                            e
+                        end
+                      | _ => e
+
+                val e = (L'.ERecord [], loc)
+            in
+                foldl (fn ((d, _), e) =>
+                          case d of
+                              L.DTable (_, _, xts, tab) => doTable (tab, #1 xts, e)
+                            | _ => e) e file
+            end
+
         val (_, _, ds) = List.foldl (fn (d, (env, fm, ds)) =>
                                         case #1 d of
                                             L.DDatabase s =>
                                             let
-                                                val (n, fm) = Fm.freshName fm
-
-
-                                                val d = L'.DVal ("expunger",
-                                                                 n,
-                                                                 (L'.TFun (client, unit), loc),
-                                                                 (L'.EAbs ("cli", client, unit, expunger ()), loc),
-                                                                 "expunger")
+                                                val (nExp, fm) = Fm.freshName fm
+                                                val (nIni, fm) = Fm.freshName fm
+                                                                 
+                                                val dExp = L'.DVal ("expunger",
+                                                                    nExp,
+                                                                    (L'.TFun (client, unit), loc),
+                                                                    (L'.EAbs ("cli", client, unit, expunger ()), loc),
+                                                                    "expunger")
+                                                val dIni = L'.DVal ("initializer",
+                                                                    nIni,
+                                                                    (L'.TFun (unit, unit), loc),
+                                                                    (L'.EAbs ("_", unit, unit, initializer ()), loc),
+                                                                    "initializer")
                                             in
-                                                (env, Fm.enter fm, (L'.DDatabase (s, n), loc)
-                                                                   :: (d, loc)
+                                                (env, Fm.enter fm, (L'.DDatabase {name = s,
+                                                                                  expunge = nExp,
+                                                                                  initialize = nIni}, loc)
+                                                                   :: (dExp, loc)
+                                                                   :: (dIni, loc)
                                                                    :: ds)
                                             end
                                           | _ =>