summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/urweb/urweb_cpp.h2
-rw-r--r--src/c/urweb.c9
-rw-r--r--src/mysql.sml2
-rw-r--r--src/postgres.sml279
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 #"'" => "\\'"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-25 08:31:48 +0000