# HG changeset patch # User Adam Chlipala # Date 1238686946 14400 # Node ID a3ddf05fb3e3497bfc51cc9776b861989e637983 # Parent 3b46548f701b0872156d122346cde605c7035383 On start-up, delete/nullify rows mentioning clients or channels diff -r 3b46548f701b -r a3ddf05fb3e3 include/urweb.h --- a/include/urweb.h Thu Apr 02 10:57:14 2009 -0400 +++ b/include/urweb.h Thu Apr 02 11:42:26 2009 -0400 @@ -10,8 +10,9 @@ void uw_client_connect(unsigned id, int pass, int sock); void uw_prune_clients(uw_context); +failure_kind uw_initialize(uw_context); -uw_context uw_init(size_t outHeaders_len, size_t script_len, size_t page_len, size_t heap_len); +uw_context uw_init(void); void uw_set_db(uw_context, void*); void *uw_get_db(uw_context); void uw_free(uw_context); diff -r 3b46548f701b -r a3ddf05fb3e3 src/c/driver.c --- a/src/c/driver.c Thu Apr 02 10:57:14 2009 -0400 +++ b/src/c/driver.c Thu Apr 02 11:42:26 2009 -0400 @@ -69,7 +69,7 @@ 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 *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 @@ 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 @@ } } + initialize(); + names = calloc(nthreads, sizeof(int)); sockfd = socket(PF_INET, SOCK_STREAM, 0); // do some error checking! diff -r 3b46548f701b -r a3ddf05fb3e3 src/c/urweb.c --- a/src/c/urweb.c Thu Apr 02 10:57:14 2009 -0400 +++ b/src/c/urweb.c Thu Apr 02 11:42:26 2009 -0400 @@ -308,15 +308,15 @@ 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 @@ 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 -r 3b46548f701b -r a3ddf05fb3e3 src/cjr.sml --- a/src/cjr.sml Thu Apr 02 10:57:14 2009 -0400 +++ b/src/cjr.sml Thu Apr 02 11:42:26 2009 -0400 @@ -106,7 +106,7 @@ | 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 -r 3b46548f701b -r a3ddf05fb3e3 src/cjr_print.sml --- a/src/cjr_print.sml Thu Apr 02 10:57:14 2009 -0400 +++ b/src/cjr_print.sml Thu Apr 02 11:42:26 2009 -0400 @@ -1937,128 +1937,138 @@ 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 @@ 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 -r 3b46548f701b -r a3ddf05fb3e3 src/mono.sml --- a/src/mono.sml Thu Apr 02 10:57:14 2009 -0400 +++ b/src/mono.sml Thu Apr 02 11:42:26 2009 -0400 @@ -122,7 +122,7 @@ | 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 -r 3b46548f701b -r a3ddf05fb3e3 src/mono_print.sml --- a/src/mono_print.sml Thu Apr 02 10:57:14 2009 -0400 +++ b/src/mono_print.sml Thu Apr 02 11:42:26 2009 -0400 @@ -413,13 +413,16 @@ | 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 -r 3b46548f701b -r a3ddf05fb3e3 src/mono_shake.sml --- a/src/mono_shake.sml Thu Apr 02 10:57:14 2009 -0400 +++ b/src/mono_shake.sml Thu Apr 02 11:42:26 2009 -0400 @@ -45,7 +45,7 @@ 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 -r 3b46548f701b -r a3ddf05fb3e3 src/monoize.sml --- a/src/monoize.sml Thu Apr 02 10:57:14 2009 -0400 +++ b/src/monoize.sml Thu Apr 02 11:42:26 2009 -0400 @@ -2474,6 +2474,25 @@ 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 @@ 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 @@ (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 @@ | _ => 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 | _ =>