summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CHANGELOG7
-rw-r--r--configure.ac18
-rw-r--r--include/urweb/urweb_cpp.h1
-rw-r--r--src/c/http.c2
-rw-r--r--src/c/openssl.c8
-rw-r--r--src/c/urweb.c31
-rw-r--r--src/elaborate.sml12
-rw-r--r--src/elisp/urweb-mode.el6
-rw-r--r--src/mysql.sml32
-rw-r--r--src/postgres.sml56
-rw-r--r--src/settings.sml2
-rw-r--r--tests/empty.ur0
-rw-r--r--tests/ffisub.urp3
-rw-r--r--tests/ffisub.urs5
14 files changed, 157 insertions, 26 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 02e9d754..1e87b778 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,11 @@
========
+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 b199cd29..ee76f9ee 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,4 +1,4 @@
-AC_INIT([urweb], [20150819])
+AC_INIT([urweb], [20151018])
WORKING_VERSION=0
AC_USE_SYSTEM_EXTENSIONS
@@ -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.h>
+ ]],
+ [[
+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/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index 39679dd5..a371d8e8 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 *);
+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/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 <port>] [-a <IP address>] [-t <thread count>] [-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 <port>] [-a <IP address>] [-t <thread count>] [-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/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];
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 6d3836f1..d656ae03 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -797,12 +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");
+}
+
+void uw_try_reconnecting_and_restarting(uw_context ctx) {
+ uw_try_reconnecting(ctx);
+ uw_error(ctx, BOUNDED_RETRY, "Restarting transaction after fixing database connection");
+}
+
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;
- }
+ } 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/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/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"
"\\<urweb-mode-map>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) " *)")
diff --git a/src/mysql.sml b/src/mysql.sml
index bb654fee..692be0a2 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
@@ -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 "}",
@@ -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,
diff --git a/src/postgres.sml b/src/postgres.sml
index 6df0331a..bc1238c0 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -617,7 +617,13 @@ fun queryCommon {loc, query, cols, doCols} =
newline,
newline,
- string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+ string "if (res == NULL) {",
+ box [newline,
+ string "uw_try_reconnecting_and_restarting(ctx);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Can't allocate query result; database server may be down.\");",
+ newline],
+ string "}",
newline,
newline,
@@ -782,7 +788,13 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
string "\""]}]
fun dmlCommon {loc, dml, mode} =
- box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
+ box [string "if (res == NULL) {",
+ box [newline,
+ string "uw_try_reconnecting_and_restarting(ctx);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Can't allocate DML result; database server may be down.\");",
+ newline],
+ string "}",
newline,
newline,
@@ -818,7 +830,13 @@ 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_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,
newline,
@@ -851,7 +869,13 @@ 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) {",
+ 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,
@@ -877,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 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) {",
@@ -938,7 +968,13 @@ fun dmlPrepared {loc, id, dml, inputs, mode} =
string "\""], mode = mode}]
fun nextvalCommon {loc, query} =
- box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
+ box [string "if (res == NULL) {",
+ box [newline,
+ string "uw_try_reconnecting_and_restarting(ctx);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Can't allocate NEXTVAL result; database server may be down.\");",
+ newline],
+ string "}",
newline,
newline,
@@ -1020,7 +1056,13 @@ fun nextvalPrepared {loc, id, query} =
string "\""]}]
fun setvalCommon {loc, query} =
- box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
+ box [string "if (res == NULL) {",
+ box [newline,
+ string "uw_try_reconnecting_and_restarting(ctx);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Can't allocate SETVAL result; database server may be down.\");",
+ newline],
+ string "}",
newline,
newline,
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
diff --git a/tests/empty.ur b/tests/empty.ur
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/tests/empty.ur
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