From a24c2bdaf85c3d4eef19783e95b11d1cf15add09 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 12 Dec 2013 17:42:48 -0500 Subject: Start SQL transactions as read-only when possible, based on conservative program analysis --- include/urweb/types_cpp.h | 2 +- include/urweb/urweb_cpp.h | 1 + src/c/cgi.c | 3 +-- src/c/fastcgi.c | 3 +-- src/c/http.c | 3 +-- src/c/urweb.c | 21 ++++++++++----------- src/cjr_print.sml | 13 ++++++++++++- src/corify.sml | 2 +- src/effectize.sml | 10 ++++++++-- src/export.sig | 2 +- src/export.sml | 4 ++-- src/mysql.sml | 2 +- src/postgres.sml | 4 ++-- src/sqlite.sml | 2 +- src/tag.sml | 6 +++--- 15 files changed, 46 insertions(+), 32 deletions(-) diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 330f7755..789aecb1 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -82,7 +82,7 @@ typedef struct { void (*expunger)(struct uw_context *, uw_Basis_client); void (*db_init)(struct uw_context *); - int (*db_begin)(struct uw_context *); + int (*db_begin)(struct uw_context *, int could_write); int (*db_commit)(struct uw_context *); int (*db_rollback)(struct uw_context *); void (*db_close)(struct uw_context *); diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index cf046e83..8dfffdf9 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -86,6 +86,7 @@ uw_Basis_string uw_Basis_maybe_onunload(struct uw_context *, uw_Basis_string); void uw_set_needs_push(struct uw_context *, int); void uw_set_needs_sig(struct uw_context *, int); +void uw_set_could_write_db(struct uw_context *, int); char *uw_Basis_htmlifyInt(struct uw_context *, uw_Basis_int); char *uw_Basis_htmlifyFloat(struct uw_context *, uw_Basis_float); diff --git a/src/c/cgi.c b/src/c/cgi.c index 52c0ca2e..c9ec744a 100644 --- a/src/c/cgi.c +++ b/src/c/cgi.c @@ -134,8 +134,7 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - if (uw_get_app(ctx)->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); uw_commit(ctx); } diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c index 9e3c8d7e..d6d2391d 100644 --- a/src/c/fastcgi.c +++ b/src/c/fastcgi.c @@ -632,8 +632,7 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - if (uw_get_app(ctx)->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); uw_commit(ctx); } diff --git a/src/c/http.c b/src/c/http.c index ebe50bea..230d07f0 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -438,8 +438,7 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - if (uw_get_app(ctx)->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); uw_commit(ctx); } diff --git a/src/c/urweb.c b/src/c/urweb.c index 9641333c..3082f110 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -441,7 +441,7 @@ struct uw_context { const char *script_header; - int needs_push, needs_sig; + int needs_push, needs_sig, could_write_db; size_t n_deltas, used_deltas; delta *deltas; @@ -517,6 +517,7 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->script_header = ""; ctx->needs_push = 0; ctx->needs_sig = 0; + ctx->could_write_db = 1; ctx->source_count = 0; @@ -777,7 +778,7 @@ failure_kind uw_begin(uw_context ctx, char *path) { void uw_ensure_transaction(uw_context ctx) { if (!ctx->transaction_started) { - if (ctx->app->db_begin(ctx)) + if (ctx->app->db_begin(ctx, ctx->could_write_db)) uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); ctx->transaction_started = 1; } @@ -1191,6 +1192,10 @@ void uw_set_needs_sig(uw_context ctx, int n) { ctx->needs_sig = n; } +void uw_set_could_write_db(uw_context ctx, int n) { + ctx->could_write_db = n; +} + static void uw_buffer_check_ctx(uw_context ctx, const char *kind, uw_buffer *b, size_t extra, const char *desc) { if (b->back - b->front < extra) { @@ -3466,9 +3471,7 @@ failure_kind uw_initialize(uw_context ctx) { int r = setjmp(ctx->jmp_buf); if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); - ctx->transaction_started = 1; + uw_ensure_transaction(ctx); ctx->app->initializer(ctx); if (ctx->app->db_commit(ctx)) uw_error(ctx, FATAL, "Error running SQL COMMIT"); @@ -4085,9 +4088,7 @@ failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) { int r = setjmp(ctx->jmp_buf); if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); - ctx->transaction_started = 1; + uw_ensure_transaction(ctx); callback(ctx); } @@ -4134,9 +4135,7 @@ failure_kind uw_begin_onError(uw_context ctx, char *msg) { if (ctx->app->on_error) { if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); - ctx->transaction_started = 1; + uw_ensure_transaction(ctx); uw_buffer_reset(&ctx->outHeaders); if (on_success[0]) diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 798492d6..5d697eac 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -3001,11 +3001,18 @@ fun p_file env (ds, ps) = fun couldWrite ek = case ek of - Link => false + Link _ => false | Action ef => ef = ReadCookieWrite | Rpc ef => ef = ReadCookieWrite | Extern _ => false + fun couldWriteDb ek = + case ek of + Link ef => ef <> ReadOnly + | Action ef => ef <> ReadOnly + | Rpc ef => ef <> ReadOnly + | Extern ef => ef <> ReadOnly + val s = case Settings.getUrlPrefix () of "" => s @@ -3091,6 +3098,10 @@ fun p_file env (ds, ps) = end, string "\");", newline]), + string "uw_set_could_write_db(ctx, ", + string (if couldWriteDb ek then "1" else "0"), + string ");", + newline, string "uw_set_needs_push(ctx, ", string (case side of ServerAndPullAndPush => "1" diff --git a/src/corify.sml b/src/corify.sml index c06d62ca..c1c60045 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -1046,7 +1046,7 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = | _ => false) args then L'.Extern L'.ReadCookieWrite else - L'.Link + L'.Link L'.ReadCookieWrite in ((L.DVal ("wrap_" ^ s, 0, tf, e), loc) :: wds, (fn st => diff --git a/src/effectize.sml b/src/effectize.sml index 6ced952b..d711e620 100644 --- a/src/effectize.sml +++ b/src/effectize.sml @@ -153,7 +153,7 @@ fun effectize file = in (d, loop (writers, readers, pushers)) end - | DExport (Link, n, t) => + | DExport (Link _, n, t) => (case IM.find (writers, n) of NONE => () | SOME (loc, s) => @@ -162,7 +162,13 @@ fun effectize file = else ErrorMsg.errorAt loc ("A handler (URI prefix \"" ^ s ^ "\") accessible via GET could cause side effects; try accessing it only via forms, removing it from the signature of the main program module, or whitelisting it with the 'safeGet' .urp directive"); - ((DExport (Link, n, IM.inDomain (pushers, n)), #2 d), evs)) + ((DExport (Link (if IM.inDomain (writers, n) then + if IM.inDomain (readers, n) then + ReadCookieWrite + else + ReadWrite + else + ReadOnly), n, IM.inDomain (pushers, n)), #2 d), evs)) | DExport (Action _, n, _) => ((DExport (Action (if IM.inDomain (writers, n) then if IM.inDomain (readers, n) then diff --git a/src/export.sig b/src/export.sig index 9bcfa0d4..881459c5 100644 --- a/src/export.sig +++ b/src/export.sig @@ -33,7 +33,7 @@ datatype effect = | ReadWrite datatype export_kind = - Link + Link of effect | Action of effect | Rpc of effect | Extern of effect diff --git a/src/export.sml b/src/export.sml index 5d200894..a99d0b70 100644 --- a/src/export.sml +++ b/src/export.sml @@ -36,7 +36,7 @@ datatype effect = | ReadWrite datatype export_kind = - Link + Link of effect | Action of effect | Rpc of effect | Extern of effect @@ -49,7 +49,7 @@ fun p_effect ef = fun p_export_kind ck = case ck of - Link => string "link" + Link ef => box [string "link(", p_effect ef, string ")"] | Action ef => box [string "action(", p_effect ef, string ")"] | Rpc ef => box [string "rpc(", p_effect ef, string ")"] | Extern ef => box [string "extern(", p_effect ef, string ")"] diff --git a/src/mysql.sml b/src/mysql.sml index c70a1cdd..884cde36 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -577,7 +577,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, - string "static int uw_db_begin(uw_context ctx) {", + string "static int uw_db_begin(uw_context ctx, int could_write) {", newline, string "uw_conn *conn = uw_get_db(ctx);", newline, diff --git a/src/postgres.sml b/src/postgres.sml index 41529173..272097e7 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -402,11 +402,11 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, - string "static int uw_db_begin(uw_context ctx) {", + string "static int uw_db_begin(uw_context ctx, int could_write) {", newline, string "PGconn *conn = uw_get_db(ctx);", newline, - string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");", + string "PGresult *res = PQexec(conn, could_write ? \"BEGIN ISOLATION LEVEL SERIALIZABLE\" : \"BEGIN ISOLATION LEVEL SERIALIZABLE, READ ONLY\");", newline, newline, string "if (res == NULL) return 1;", diff --git a/src/sqlite.sml b/src/sqlite.sml index 09c4c683..c138415b 100644 --- a/src/sqlite.sml +++ b/src/sqlite.sml @@ -344,7 +344,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, - string "static int uw_db_begin(uw_context ctx) {", + string "static int uw_db_begin(uw_context ctx, int could_write) {", newline, string "uw_conn *conn = uw_get_db(ctx);", newline, diff --git a/src/tag.sml b/src/tag.sml index 9c4807c6..865e7f53 100644 --- a/src/tag.sml +++ b/src/tag.sml @@ -145,7 +145,7 @@ fun exp env (e, s) = end in case x of - (CName "Link", _) => tagIt' (Link, "Link") + (CName "Link", _) => tagIt' (Link ReadWrite, "Link") | (CName "Action", _) => tagIt' (Action ReadWrite, "Action") | _ => ((x, e, t), s) end) @@ -180,7 +180,7 @@ fun exp env (e, s) = | EFfiApp ("Basis", "url", [(e, t)]) => let - val (e, s) = tagIt (e, Link, "Url", s) + val (e, s) = tagIt (e, Link ReadWrite, "Url", s) in (EFfiApp ("Basis", "url", [(e, t)]), s) end @@ -201,7 +201,7 @@ fun exp env (e, s) = case eo of SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) => let - val (e, s) = tagIt (e', Link, "Url", s) + val (e, s) = tagIt (e', Link ReadWrite, "Url", s) in (EFfiApp ("Basis", "url", [(e, t)]), s) end -- cgit v1.2.3