From 7e3c1da2612b1f618611313bb1b1fbc9fcc3d82d Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 19 Aug 2015 10:53:18 -0400 Subject: Return to working version mode --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index b199cd29..a6f8ac43 100644 --- a/configure.ac +++ b/configure.ac @@ -1,5 +1,5 @@ AC_INIT([urweb], [20150819]) -WORKING_VERSION=0 +WORKING_VERSION=1 AC_USE_SYSTEM_EXTENSIONS # automake 1.12 requires this, but automake 1.11 doesn't recognize it -- cgit v1.2.3 From b1e5269ffae4cc185a1ca211f16c2a9f00531896 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 20 Aug 2015 15:11:40 -0400 Subject: Beautify '-h' output for web servers --- src/c/http.c | 2 +- src/settings.sml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/c/http.c b/src/c/http.c index e6c7b1af..9059746f 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -314,7 +314,7 @@ static void *worker(void *data) { } static void help(char *cmd) { - printf("Usage: %s [-p ] [-a ] [-t ] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe -T option sets socket recv timeout (0 disables timeout, default is 5 sec)", cmd); + printf("Usage: %s [-p ] [-a ] [-t ] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe '-T' option sets socket recv timeout (0 disables timeout, default is 5 sec).\n", cmd); } static void sigint(int signum) { diff --git a/src/settings.sml b/src/settings.sml index cd2de8a9..10a4af48 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -883,7 +883,7 @@ fun addFile {Uri, LoadFromFilename} = if path' = path then () else - ErrorMsg.error ("Two different files requested for URI " ^ Uri) + ErrorMsg.error ("Two different files requested for URI " ^ Uri ^ " ( " ^ path' ^ " vs. " ^ path ^ ")") | NONE => let val inf = BinIO.openIn path -- cgit v1.2.3 From 5a087f2a1fa5024a11c1b614d78b303edcbf57c6 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 27 Aug 2015 16:28:45 -0400 Subject: Proper error message for excessively fancy FFI signatures --- src/elaborate.sml | 12 ++++++++++++ tests/empty.ur | 0 tests/ffisub.urp | 3 +++ tests/ffisub.urs | 5 +++++ 4 files changed, 20 insertions(+) create mode 100644 tests/empty.ur create mode 100644 tests/ffisub.urp create mode 100644 tests/ffisub.urs diff --git a/src/elaborate.sml b/src/elaborate.sml index 5b18ae94..ca4e124c 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -4123,6 +4123,18 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) = val dNew = (L'.DFfiStr (x, n, sgn'), loc) in + case #1 sgn' of + L'.SgnConst sgis => + (case List.find (fn (L'.SgiConAbs _, _) => false + | (L'.SgiCon _, _) => false + | (L'.SgiDatatype _, _) => false + | (L'.SgiVal _, _) => false + | _ => true) sgis of + NONE => () + | SOME sgi => (ErrorMsg.errorAt loc "Disallowed signature item for FFI module"; + epreface ("item", p_sgn_item env sgi))) + | _ => raise Fail "FFI signature isn't SgnConst"; + Option.map (fn tm => ModDb.insert (dNew, tm)) tmo; ([dNew], (env', denv, enD gs' @ gs)) end) diff --git a/tests/empty.ur b/tests/empty.ur new file mode 100644 index 00000000..e69de29b diff --git a/tests/ffisub.urp b/tests/ffisub.urp new file mode 100644 index 00000000..b695bad1 --- /dev/null +++ b/tests/ffisub.urp @@ -0,0 +1,3 @@ +ffi ffisub + +empty diff --git a/tests/ffisub.urs b/tests/ffisub.urs new file mode 100644 index 00000000..ce245884 --- /dev/null +++ b/tests/ffisub.urs @@ -0,0 +1,5 @@ +structure S : sig + type t +end + +val x : S.t -- cgit v1.2.3 From dd5a19ce6d071c70e53db145b708ec9c102674f0 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Sun, 20 Sep 2015 17:46:07 -0400 Subject: Use correct OpenSSL thread safety macros on OS X (closes #209) Create an Autoconf test to determine if pthread_t is a pointer or scalar type, and use the appropriate CRYPTO_THREADID_set macro based on the result. --- configure.ac | 16 ++++++++++++++++ src/c/openssl.c | 8 +++++++- 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index a6f8ac43..f074ccbf 100644 --- a/configure.ac +++ b/configure.ac @@ -112,6 +112,22 @@ if test [$CLANG = "yes"]; then PTHREAD_LIBS="" fi +# Check if pthread_t is a scalar or pointer type so we can use the correct +# OpenSSL functions on it. +AC_MSG_CHECKING([if pthread_t is a pointer type]) +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ +#include + ]], + [[ +pthread_t a; +*a; + ]])], + AC_DEFINE([PTHREAD_T_IS_POINTER], [1], [Define if pthread_t is a pointer.]) + AC_MSG_RESULT(yes), + AC_MSG_RESULT(no)) + AC_SUBST(CC) AC_SUBST(BIN) AC_SUBST(LIB) diff --git a/src/c/openssl.c b/src/c/openssl.c index 6d018707..206a3bc8 100644 --- a/src/c/openssl.c +++ b/src/c/openssl.c @@ -34,9 +34,15 @@ static void random_password() { } // OpenSSL callbacks +#ifdef PTHREAD_T_IS_POINTER +# define CRYPTO_THREADID_SET CRYPTO_THREADID_set_pointer +#else +# define CRYPTO_THREADID_SET CRYPTO_THREADID_set_numeric +#endif static void thread_id(CRYPTO_THREADID *const result) { - CRYPTO_THREADID_set_numeric(result, pthread_self()); + CRYPTO_THREADID_SET(result, pthread_self()); } +#undef CRYPTO_THREADID_SET static void lock_or_unlock(const int mode, const int type, const char *file, const int line) { pthread_mutex_t *const lock = &openssl_locks[type]; -- cgit v1.2.3 From 4f4d74c0803d70ea7755ee877997f1e324f6c06b Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 15 Oct 2015 07:52:37 -0400 Subject: Make urweb-mode inherit from prog-mode (contributed by Ziv Scully) --- src/elisp/urweb-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el index 5eb36bc4..db08e1e0 100644 --- a/src/elisp/urweb-mode.el +++ b/src/elisp/urweb-mode.el @@ -246,7 +246,7 @@ See doc for the variable `urweb-mode-info'." ("\\<\\(signature\\)\\s-+\\(\\sw+\\)" (1 font-lock-keyword-face) (2 (amAttribute font-lock-interface-def-face))) - + (,urweb-keywords-regexp . font-lock-keyword-face) (,urweb-sql-keywords-regexp . font-lock-sql-face) (,urweb-cident-regexp . font-lock-cvariable-face)) @@ -377,7 +377,7 @@ See doc for the variable `urweb-mode-info'." (add-to-list 'auto-mode-alist '("\\.urs?\\'" . urweb-mode)) ;;;###autoload -(define-derived-mode urweb-mode fundamental-mode "Ur/Web" +(define-derived-mode urweb-mode prog-mode "Ur/Web" "\\Major mode for editing Ur/Web code. This mode runs `urweb-mode-hook' just before exiting. \\{urweb-mode-map}" @@ -409,7 +409,7 @@ This mode runs `urweb-mode-hook' just before exiting. (set-syntax-table urweb-mode-syntax-table) (setq local-abbrev-table urweb-mode-abbrev-table) ;; A paragraph is separated by blank lines or ^L only. - + (set (make-local-variable 'indent-line-function) 'urweb-indent-line) (set (make-local-variable 'comment-start) "(* ") (set (make-local-variable 'comment-end) " *)") -- cgit v1.2.3 From ee354c938959d7ae904fafae99966c3d136070e1 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 17 Oct 2015 10:49:25 -0400 Subject: Start of support for surviving database-server restarts, for Postgres --- include/urweb/urweb_cpp.h | 1 + src/c/urweb.c | 31 ++++- src/mysql.sml | 2 +- src/postgres.sml | 285 ++++++++++++++++++++++++++++++---------------- 4 files changed, 217 insertions(+), 102 deletions(-) diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 39679dd5..b1d2048e 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -40,6 +40,7 @@ uw_loggers* uw_get_loggers(struct uw_context *ctx); uw_loggers* uw_get_loggers(struct uw_context *ctx); failure_kind uw_begin(struct uw_context *, char *path); void uw_ensure_transaction(struct uw_context *); +int uw_try_reconnecting_if_at_most_one(struct uw_context *); failure_kind uw_begin_onError(struct uw_context *, char *msg); void uw_login(struct uw_context *); int uw_commit(struct uw_context *); diff --git a/src/c/urweb.c b/src/c/urweb.c index 6d3836f1..4ce469bd 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -797,10 +797,37 @@ failure_kind uw_begin(uw_context ctx, char *path) { return r; } +static void uw_try_reconnecting(uw_context ctx) { + // Hm, error starting transaction. + // Maybe the database server died but has since come back up. + // Let's try starting from scratch. + if (ctx->db) { + ctx->app->db_close(ctx); + ctx->db = NULL; + } + ctx->app->db_init(ctx); + + if (!ctx->db) + uw_error(ctx, FATAL, "Error reopening database connection"); +} + +int uw_try_reconnecting_if_at_most_one(uw_context ctx) { + if (ctx->at_most_one_query) { + uw_try_reconnecting(ctx); + return 1; + } else + return 0; +} + void uw_ensure_transaction(uw_context ctx) { if (!ctx->transaction_started && !ctx->at_most_one_query) { - if (ctx->app->db_begin(ctx, ctx->could_write_db)) - uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); + if (!ctx->db || ctx->app->db_begin(ctx, ctx->could_write_db)) { + uw_try_reconnecting(ctx); + + if (ctx->app->db_begin(ctx, ctx->could_write_db)) + uw_error(ctx, FATAL, "Error running SQL BEGIN"); + } + ctx->transaction_started = 1; } } diff --git a/src/mysql.sml b/src/mysql.sml index bb654fee..13ea9fc2 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -546,7 +546,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, string "mysql_close(mysql);", newline, - string "uw_error(ctx, BOUNDED_RETRY, ", + string "uw_error(ctx, FATAL, ", string "\"Connection to MySQL server failed: %s\", msg);"], newline, string "}", diff --git a/src/postgres.sml b/src/postgres.sml index 6df0331a..22d55e54 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2010, Adam Chlipala +(* Copyright (c) 2008-2010, 2015, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -520,7 +520,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, string "PQfinish(conn);", newline, - string "uw_error(ctx, BOUNDED_RETRY, ", + string "uw_error(ctx, FATAL, ", string "\"Connection to Postgres server failed: %s\", msg);"], newline, string "}", @@ -612,12 +612,24 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} = getter t end -fun queryCommon {loc, query, cols, doCols} = +fun queryCommon {loc, query, cols, doCols, runit} = box [string "int n, i;", newline, newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", + string "if (res == NULL) {", + box [newline, + string "if (uw_try_reconnecting_if_at_most_one(ctx)) {", + box [newline, + string "conn = uw_get_db(ctx);", + newline, + runit, + newline], + string "}", + newline, + string "if (res == NULL) uw_error(ctx, FATAL, \"Can't allocate query result; database server might be down.\");", + newline], + string "}", newline, newline, @@ -687,12 +699,18 @@ fun queryCommon {loc, query, cols, doCols} = newline] fun query {loc, cols, doCols} = - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", - newline, - newline, - queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}] + let + val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" + in + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + string "PGresult *res;", + newline, + runit, + newline, + newline, + queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query", runit = runit}] + end fun p_ensql t e = case t of @@ -756,33 +774,52 @@ fun makeParams inputs = newline] fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - - makeParams inputs, - - newline, - string "PGresult *res = ", - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString id), - string "\", ", - string (Int.toString (length inputs)), - string ", paramValues, paramLengths, paramFormats, 0);"] - else - box [string "PQexecParams(conn, \"", - string (Prim.toCString query), - string "\", ", - string (Int.toString (length inputs)), - string ", NULL, paramValues, paramLengths, paramFormats, 0);"], - newline, - newline, - queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", - string (Prim.toCString query), - string "\""]}] + let + val runit = + box [string "res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", ", + string (Int.toString (length inputs)), + string ", paramValues, paramLengths, paramFormats, 0);"] + else + box [string "PQexecParams(conn, \"", + string (Prim.toCString query), + string "\", ", + string (Int.toString (length inputs)), + string ", NULL, paramValues, paramLengths, paramFormats, 0);"]] + in + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + + makeParams inputs, + + newline, + string "PGresult *res;", + runit, + newline, + newline, + queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", + string (Prim.toCString query), + string "\""], + runit = runit}] + end -fun dmlCommon {loc, dml, mode} = - box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", +fun dmlCommon {loc, dml, mode, runit} = + box [string "if (res == NULL) {", + box [newline, + string "if (uw_try_reconnecting_if_at_most_one(ctx)) {", + box [newline, + string "conn = uw_get_db(ctx);", + newline, + runit, + newline], + string "}", + newline, + string "if (res == NULL) uw_error(ctx, FATAL, \"Can't allocate DML result; database server might be down.\");", + newline], + string "}", newline, newline, @@ -818,7 +855,11 @@ fun dmlCommon {loc, dml, mode} = string "res = PQexec(conn, \"ROLLBACK TO s\");", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", + string "if (res == NULL) {", + box [newline, + string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server might be down.\");", + newline], + string "}", newline, newline, @@ -851,7 +892,7 @@ fun dmlCommon {loc, dml, mode} = newline, string "res = PQexec(conn, \"RELEASE s\");", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", + string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML RELEASE result.\");", newline, newline, @@ -877,7 +918,7 @@ fun makeSavepoint mode = Error => box [] | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", + string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML SAVEPOINT result.\");", newline, newline, string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", @@ -893,52 +934,71 @@ fun makeSavepoint mode = newline] fun dml (loc, mode) = - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res;", - newline, + let + val runit = string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);" + in + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + string "PGresult *res;", + newline, - makeSavepoint mode, + makeSavepoint mode, - string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);", - newline, - newline, - dmlCommon {loc = loc, dml = string "dml", mode = mode}] + runit, + newline, + newline, + dmlCommon {loc = loc, dml = string "dml", mode = mode, runit = runit}] + end fun dmlPrepared {loc, id, dml, inputs, mode} = - box [string "PGconn *conn = uw_get_db(ctx);", - newline, + let + val runit = + box [string "res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", ", + string (Int.toString (length inputs)), + string ", paramValues, paramLengths, paramFormats, 0);"] + else + box [string "PQexecParams(conn, \"", + string (Prim.toCString dml), + string "\", ", + string (Int.toString (length inputs)), + string ", NULL, paramValues, paramLengths, paramFormats, 0);"]] + in + box [string "PGconn *conn = uw_get_db(ctx);", + newline, - makeParams inputs, + makeParams inputs, - newline, - string "PGresult *res;", - newline, - newline, + newline, + string "PGresult *res;", + newline, + newline, - makeSavepoint mode, + makeSavepoint mode, - string "res = ", - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString id), - string "\", ", - string (Int.toString (length inputs)), - string ", paramValues, paramLengths, paramFormats, 0);"] - else - box [string "PQexecParams(conn, \"", - string (Prim.toCString dml), - string "\", ", - string (Int.toString (length inputs)), - string ", NULL, paramValues, paramLengths, paramFormats, 0);"], - newline, - newline, - dmlCommon {loc = loc, dml = box [string "\"", - string (Prim.toCString dml), - string "\""], mode = mode}] + runit, + newline, + newline, + dmlCommon {loc = loc, dml = box [string "\"", + string (Prim.toCString dml), + string "\""], mode = mode, runit = runit}] + end -fun nextvalCommon {loc, query} = - box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");", +fun nextvalCommon {loc, query, runit} = + box [string "if (res == NULL) {", + box [newline, + string "if (uw_try_reconnecting_if_at_most_one(ctx))", + newline, + string "conn = uw_get_db(ctx);", + newline, + runit, + newline, + string "uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");", + newline], + string "}", newline, newline, @@ -987,6 +1047,8 @@ fun nextval {loc, seqE, seqName} = | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ", seqE, string ", \"')\"))"] + + val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" in box [string "char *query = ", query, @@ -994,33 +1056,53 @@ fun nextval {loc, seqE, seqName} = newline, string "PGconn *conn = uw_get_db(ctx);", newline, - string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", + string "PGresult *res;", + newline, + runit, newline, newline, - nextvalCommon {loc = loc, query = string "query"}] + nextvalCommon {loc = loc, query = string "query", runit = runit}] end fun nextvalPrepared {loc, id, query} = - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - newline, - string "PGresult *res = ", - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString id), - string "\", 0, NULL, NULL, NULL, 0);"] - else - box [string "PQexecParams(conn, \"", - string (Prim.toCString query), - string "\", 0, NULL, NULL, NULL, NULL, 0);"], - newline, - newline, - nextvalCommon {loc = loc, query = box [string "\"", - string (Prim.toCString query), - string "\""]}] + let + val runit = + box [string "res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", 0, NULL, NULL, NULL, 0);"] + else + box [string "PQexecParams(conn, \"", + string (Prim.toCString query), + string "\", 0, NULL, NULL, NULL, NULL, 0);"]] + in + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + newline, -fun setvalCommon {loc, query} = - box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");", + string "PGresult *res;", + newline, + runit, + newline, + newline, + nextvalCommon {loc = loc, query = box [string "\"", + string (Prim.toCString query), + string "\""], runit = runit}] + end + +fun setvalCommon {loc, query, runit} = + box [string "if (res == NULL) {", + box [newline, + string "if (uw_try_reconnecting_if_at_most_one(ctx))", + newline, + string "conn = uw_get_db(ctx);", + newline, + runit, + newline, + string "uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");", + newline], + string "}", newline, newline, @@ -1048,6 +1130,8 @@ fun setval {loc, seqE, count} = string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ", count, string "), \")\"))))"] + + val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" in box [string "char *query = ", query, @@ -1055,10 +1139,13 @@ fun setval {loc, seqE, count} = newline, string "PGconn *conn = uw_get_db(ctx);", newline, - string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", + + string "PGresult *res;", + newline, + runit, newline, newline, - setvalCommon {loc = loc, query = string "query"}] + setvalCommon {loc = loc, query = string "query", runit = runit}] end fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" -- cgit v1.2.3 From fd90892fdc15fda4ac8bd4ce931b4b500ff92a1c Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 17 Oct 2015 11:08:12 -0400 Subject: Switching to a more dynamic method of handling database reconnection, restarting transactions --- include/urweb/urweb_cpp.h | 2 +- src/c/urweb.c | 9 +- src/mysql.sml | 2 +- src/postgres.sml | 279 +++++++++++++++++++--------------------------- 4 files changed, 122 insertions(+), 170 deletions(-) diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index b1d2048e..a371d8e8 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -40,7 +40,7 @@ uw_loggers* uw_get_loggers(struct uw_context *ctx); uw_loggers* uw_get_loggers(struct uw_context *ctx); failure_kind uw_begin(struct uw_context *, char *path); void uw_ensure_transaction(struct uw_context *); -int uw_try_reconnecting_if_at_most_one(struct uw_context *); +void uw_try_reconnecting_and_restarting(struct uw_context *); failure_kind uw_begin_onError(struct uw_context *, char *msg); void uw_login(struct uw_context *); int uw_commit(struct uw_context *); diff --git a/src/c/urweb.c b/src/c/urweb.c index 4ce469bd..9371147b 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -811,12 +811,9 @@ static void uw_try_reconnecting(uw_context ctx) { uw_error(ctx, FATAL, "Error reopening database connection"); } -int uw_try_reconnecting_if_at_most_one(uw_context ctx) { - if (ctx->at_most_one_query) { - uw_try_reconnecting(ctx); - return 1; - } else - return 0; +void uw_try_reconnecting_and_restarting(uw_context ctx) { + uw_try_reconnecting(ctx); + uw_error(ctx, UNLIMITED_RETRY, "Restarting transaction after fixing database connection"); } void uw_ensure_transaction(uw_context ctx) { diff --git a/src/mysql.sml b/src/mysql.sml index 13ea9fc2..057d73ff 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2009-2010, Adam Chlipala +(* Copyright (c) 2009-2010, 2015, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without diff --git a/src/postgres.sml b/src/postgres.sml index 22d55e54..bc1238c0 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2010, 2015, Adam Chlipala +(* Copyright (c) 2008-2010, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -520,7 +520,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, string "PQfinish(conn);", newline, - string "uw_error(ctx, FATAL, ", + string "uw_error(ctx, BOUNDED_RETRY, ", string "\"Connection to Postgres server failed: %s\", msg);"], newline, string "}", @@ -612,22 +612,16 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} = getter t end -fun queryCommon {loc, query, cols, doCols, runit} = +fun queryCommon {loc, query, cols, doCols} = box [string "int n, i;", newline, newline, string "if (res == NULL) {", box [newline, - string "if (uw_try_reconnecting_if_at_most_one(ctx)) {", - box [newline, - string "conn = uw_get_db(ctx);", - newline, - runit, - newline], - string "}", + string "uw_try_reconnecting_and_restarting(ctx);", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Can't allocate query result; database server might be down.\");", + string "uw_error(ctx, FATAL, \"Can't allocate query result; database server may be down.\");", newline], string "}", newline, @@ -699,18 +693,12 @@ fun queryCommon {loc, query, cols, doCols, runit} = newline] fun query {loc, cols, doCols} = - let - val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" - in - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res;", - newline, - runit, - newline, - newline, - queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query", runit = runit}] - end + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", + newline, + newline, + queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}] fun p_ensql t e = case t of @@ -774,50 +762,37 @@ fun makeParams inputs = newline] fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = - let - val runit = - box [string "res = ", - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString id), - string "\", ", - string (Int.toString (length inputs)), - string ", paramValues, paramLengths, paramFormats, 0);"] - else - box [string "PQexecParams(conn, \"", - string (Prim.toCString query), - string "\", ", - string (Int.toString (length inputs)), - string ", NULL, paramValues, paramLengths, paramFormats, 0);"]] - in - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - - makeParams inputs, - - newline, - string "PGresult *res;", - runit, - newline, - newline, - queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", - string (Prim.toCString query), - string "\""], - runit = runit}] - end + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + + makeParams inputs, -fun dmlCommon {loc, dml, mode, runit} = + newline, + string "PGresult *res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", ", + string (Int.toString (length inputs)), + string ", paramValues, paramLengths, paramFormats, 0);"] + else + box [string "PQexecParams(conn, \"", + string (Prim.toCString query), + string "\", ", + string (Int.toString (length inputs)), + string ", NULL, paramValues, paramLengths, paramFormats, 0);"], + newline, + newline, + queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", + string (Prim.toCString query), + string "\""]}] + +fun dmlCommon {loc, dml, mode} = box [string "if (res == NULL) {", box [newline, - string "if (uw_try_reconnecting_if_at_most_one(ctx)) {", - box [newline, - string "conn = uw_get_db(ctx);", - newline, - runit, - newline], - string "}", + string "uw_try_reconnecting_and_restarting(ctx);", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Can't allocate DML result; database server might be down.\");", + string "uw_error(ctx, FATAL, \"Can't allocate DML result; database server may be down.\");", newline], string "}", newline, @@ -857,7 +832,9 @@ fun dmlCommon {loc, dml, mode, runit} = newline, string "if (res == NULL) {", box [newline, - string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server might be down.\");", + string "uw_try_reconnecting_and_restarting(ctx);", + newline, + string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server may be down.\");", newline], string "}", newline, @@ -892,7 +869,13 @@ fun dmlCommon {loc, dml, mode, runit} = newline, string "res = PQexec(conn, \"RELEASE s\");", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML RELEASE result.\");", + string "if (res == NULL) {", + box [newline, + string "uw_try_reconnecting_and_restarting(ctx);", + newline, + string "uw_error(ctx, FATAL, \"Can't allocate DML RELEASE result; database server may be down.\");", + newline], + string "}", newline, newline, @@ -918,7 +901,13 @@ fun makeSavepoint mode = Error => box [] | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");", newline, - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML SAVEPOINT result.\");", + string "if (res == NULL) {", + box [newline, + string "uw_try_reconnecting_and_restarting(ctx);", + newline, + string "uw_error(ctx, FATAL, \"Can't allocate DML SAVEPOINT result; database server may be down.\");", + newline], + string "}", newline, newline, string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", @@ -934,69 +923,56 @@ fun makeSavepoint mode = newline] fun dml (loc, mode) = - let - val runit = string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);" - in - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res;", - newline, + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + string "PGresult *res;", + newline, - makeSavepoint mode, + makeSavepoint mode, - runit, - newline, - newline, - dmlCommon {loc = loc, dml = string "dml", mode = mode, runit = runit}] - end + string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);", + newline, + newline, + dmlCommon {loc = loc, dml = string "dml", mode = mode}] fun dmlPrepared {loc, id, dml, inputs, mode} = - let - val runit = - box [string "res = ", - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString id), - string "\", ", - string (Int.toString (length inputs)), - string ", paramValues, paramLengths, paramFormats, 0);"] - else - box [string "PQexecParams(conn, \"", - string (Prim.toCString dml), - string "\", ", - string (Int.toString (length inputs)), - string ", NULL, paramValues, paramLengths, paramFormats, 0);"]] - in - box [string "PGconn *conn = uw_get_db(ctx);", - newline, + box [string "PGconn *conn = uw_get_db(ctx);", + newline, - makeParams inputs, + makeParams inputs, - newline, - string "PGresult *res;", - newline, - newline, + newline, + string "PGresult *res;", + newline, + newline, - makeSavepoint mode, + makeSavepoint mode, - runit, - newline, - newline, - dmlCommon {loc = loc, dml = box [string "\"", - string (Prim.toCString dml), - string "\""], mode = mode, runit = runit}] - end + string "res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", ", + string (Int.toString (length inputs)), + string ", paramValues, paramLengths, paramFormats, 0);"] + else + box [string "PQexecParams(conn, \"", + string (Prim.toCString dml), + string "\", ", + string (Int.toString (length inputs)), + string ", NULL, paramValues, paramLengths, paramFormats, 0);"], + newline, + newline, + dmlCommon {loc = loc, dml = box [string "\"", + string (Prim.toCString dml), + string "\""], mode = mode}] -fun nextvalCommon {loc, query, runit} = +fun nextvalCommon {loc, query} = box [string "if (res == NULL) {", box [newline, - string "if (uw_try_reconnecting_if_at_most_one(ctx))", + string "uw_try_reconnecting_and_restarting(ctx);", newline, - string "conn = uw_get_db(ctx);", - newline, - runit, - newline, - string "uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");", + string "uw_error(ctx, FATAL, \"Can't allocate NEXTVAL result; database server may be down.\");", newline], string "}", newline, @@ -1047,8 +1023,6 @@ fun nextval {loc, seqE, seqName} = | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ", seqE, string ", \"')\"))"] - - val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" in box [string "char *query = ", query, @@ -1056,51 +1030,37 @@ fun nextval {loc, seqE, seqName} = newline, string "PGconn *conn = uw_get_db(ctx);", newline, - string "PGresult *res;", + string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", newline, - runit, newline, - newline, - nextvalCommon {loc = loc, query = string "query", runit = runit}] + nextvalCommon {loc = loc, query = string "query"}] end fun nextvalPrepared {loc, id, query} = - let - val runit = - box [string "res = ", - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString id), - string "\", 0, NULL, NULL, NULL, 0);"] - else - box [string "PQexecParams(conn, \"", - string (Prim.toCString query), - string "\", 0, NULL, NULL, NULL, NULL, 0);"]] - in - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - newline, - - string "PGresult *res;", - newline, - runit, - newline, - newline, - nextvalCommon {loc = loc, query = box [string "\"", - string (Prim.toCString query), - string "\""], runit = runit}] - end + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + newline, + string "PGresult *res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", 0, NULL, NULL, NULL, 0);"] + else + box [string "PQexecParams(conn, \"", + string (Prim.toCString query), + string "\", 0, NULL, NULL, NULL, NULL, 0);"], + newline, + newline, + nextvalCommon {loc = loc, query = box [string "\"", + string (Prim.toCString query), + string "\""]}] -fun setvalCommon {loc, query, runit} = +fun setvalCommon {loc, query} = box [string "if (res == NULL) {", box [newline, - string "if (uw_try_reconnecting_if_at_most_one(ctx))", - newline, - string "conn = uw_get_db(ctx);", - newline, - runit, + string "uw_try_reconnecting_and_restarting(ctx);", newline, - string "uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");", + string "uw_error(ctx, FATAL, \"Can't allocate SETVAL result; database server may be down.\");", newline], string "}", newline, @@ -1130,8 +1090,6 @@ fun setval {loc, seqE, count} = string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ", count, string "), \")\"))))"] - - val runit = string "res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" in box [string "char *query = ", query, @@ -1139,13 +1097,10 @@ fun setval {loc, seqE, count} = newline, string "PGconn *conn = uw_get_db(ctx);", newline, - - string "PGresult *res;", - newline, - runit, + string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", newline, newline, - setvalCommon {loc = loc, query = string "query", runit = runit}] + setvalCommon {loc = loc, query = string "query"}] end fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" -- cgit v1.2.3 From ad45a5b1ad463c54d5196428d55b0080a53f19bc Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 17 Oct 2015 11:31:22 -0400 Subject: Database-server reconnection for MySQL --- src/c/urweb.c | 5 +++-- src/mysql.sml | 28 +++++++++++++++++++++------- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/src/c/urweb.c b/src/c/urweb.c index 9371147b..d656ae03 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -813,7 +813,7 @@ static void uw_try_reconnecting(uw_context ctx) { void uw_try_reconnecting_and_restarting(uw_context ctx) { uw_try_reconnecting(ctx); - uw_error(ctx, UNLIMITED_RETRY, "Restarting transaction after fixing database connection"); + uw_error(ctx, BOUNDED_RETRY, "Restarting transaction after fixing database connection"); } void uw_ensure_transaction(uw_context ctx) { @@ -826,7 +826,8 @@ void uw_ensure_transaction(uw_context ctx) { } ctx->transaction_started = 1; - } + } else if (ctx->at_most_one_query && !ctx->db) + uw_try_reconnecting(ctx); } uw_Basis_client uw_Basis_self(uw_context ctx) { diff --git a/src/mysql.sml b/src/mysql.sml index 057d73ff..692be0a2 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -861,11 +861,17 @@ fun queryCommon {loc, query, cols, doCols} = end) cols, newline, - string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"", - string (ErrorMsg.spanToString loc), - string ": Error reseting statement: %s\\n%s\", ", - query, - string ", mysql_error(conn->conn));", + string "if (mysql_stmt_reset(stmt)) {", + box [newline, + string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);", + newline, + string "uw_error(ctx, FATAL, \"", + string (ErrorMsg.spanToString loc), + string ": Error reseting statement: %s\\n%s\", ", + query, + string ", mysql_error(conn->conn));", + newline], + string "}", newline, newline, @@ -1233,7 +1239,9 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} = fun dmlCommon {loc, dml, mode} = box [string "if (mysql_stmt_execute(stmt)) {", - box [string "if (mysql_errno(conn->conn) == 1213)", + box [string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);", + newline, + string "if (mysql_errno(conn->conn) == 1213)", newline, box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");", newline], @@ -1540,7 +1548,13 @@ fun nextval {loc, seqE, seqName} = newline, newline, - string "if (mysql_query(conn->conn, insert)) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");", + string "if (mysql_query(conn->conn, insert)) {", + box [newline, + string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);", + newline, + string "uw_error(ctx, FATAL, \"'nextval' INSERT failed\");", + newline], + string "}", newline, string "n = mysql_insert_id(conn->conn);", newline, -- cgit v1.2.3 From cb0109804fdad0dd423bb344446344cdc08c0886 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 18 Oct 2015 10:34:24 -0400 Subject: New release --- CHANGELOG | 7 +++++++ configure.ac | 4 ++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index 02e9d754..1e87b778 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,10 @@ +======== +20151018 +======== + +- Applications now reconnect to database server automatically after losing connection. +- Bug fixes and improvements to compatibility, documentation, and error messages + ======== 20150819 ======== diff --git a/configure.ac b/configure.ac index f074ccbf..ee76f9ee 100644 --- a/configure.ac +++ b/configure.ac @@ -1,5 +1,5 @@ -AC_INIT([urweb], [20150819]) -WORKING_VERSION=1 +AC_INIT([urweb], [20151018]) +WORKING_VERSION=0 AC_USE_SYSTEM_EXTENSIONS # automake 1.12 requires this, but automake 1.11 doesn't recognize it -- cgit v1.2.3