Start of multi-DBMS support

13 files changed, 615 insertions, 166 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 221ac039..f088e74d 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -286,10 +286,14 @@ static void client_send(client *c, buf *msg) {
 
 // Global entry points
 
+extern void uw_client_init();
+
 void uw_global_init() {
   srand(time(NULL) ^ getpid());
 
   clients = malloc(0);
+
+  uw_client_init();
 }
 
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 14721edd..d3f1b469 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2039,6 +2039,8 @@ fun p_fun env (fx, n, args, ran, e) =
              string "}"]
     end
 
+val prepped = ref ([] : (string * int) list)
+
 fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DStruct (n, xts) =>
@@ -2196,115 +2198,8 @@ fun p_decl env (dAll as (d, _) : decl) =
              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_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,
+             #init (Settings.currentDbms ()) (name, !prepped),
 
              string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
              newline,
@@ -2323,54 +2218,9 @@ fun p_decl env (dAll as (d, _) : decl) =
              string "}",
              newline]
 
-      | DPreparedStatements [] =>
-        box [string "static void uw_db_prepare(uw_context ctx) {",
-             newline,
-             string "}"]
       | DPreparedStatements ss =>
-        if #persistent (Settings.currentProtocol ()) then
-            box [string "static void uw_db_prepare(uw_context ctx) {",
-                 newline,
-                 string "PGconn *conn = uw_get_db(ctx);",
-                 newline,
-                 string "PGresult *res;",
-                 newline,
-                 newline,
-
-                 p_list_sepi newline (fn i => fn (s, n) =>
-                                                 box [string "res = PQprepare(conn, \"uw",
-                                                      string (Int.toString i),
-                                                      string "\", \"",
-                                                      string (String.toString s),
-                                                      string "\", ",
-                                                      string (Int.toString n),
-                                                      string ", NULL);",
-                                                      newline,
-                                                      string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-                                                      newline,
-                                                      box [string "char msg[1024];",
-                                                           newline,
-                                                           string "strncpy(msg, PQerrorMessage(conn), 1024);",
-                                                           newline,
-                                                           string "msg[1023] = 0;",
-                                                           newline,
-                                                           string "PQclear(res);",
-                                                           newline,
-                                                           string "PQfinish(conn);",
-                                                           newline,
-                                                           string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
-                                                           string (String.toString s),
-                                                           string "\\n%s\", msg);",
-                                                           newline],
-                                                      string "}",
-                                                      newline,
-                                                      string "PQclear(res);",
-                                                      newline])
-                             ss,
-                 
-                 string "}"]
-        else
-            string "static void uw_db_prepare(uw_context ctx) { }"
+        (prepped := ss;
+         box [])
 
       | DJavaScript s => box [string "static char jslib[] = \"",
                               string (String.toString s),
@@ -3268,7 +3118,7 @@ fun p_file env (ds, ps) =
              string "#include <math.h>",
              newline,
              if hasDb then
-                 box [string "#include <postgresql/libpq-fe.h>",
+                 box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"),
                       newline]
              else
                  box [],
diff --git a/src/compiler.sig b/src/compiler.sig
index 2f062622..f7727771 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -49,7 +49,9 @@ signature COMPILER = sig
          jsFuncs : (Settings.ffi * string) list,
          rewrites : Settings.rewrite list,
          filterUrl : Settings.rule list,
-         filterMime : Settings.rule list
+         filterMime : Settings.rule list,
+         protocol : string option,
+         dbms : string option
     }
     val compile : string -> unit
     val compileC : {cname : string, oname : string, ename : string, libs : string,
diff --git a/src/compiler.sml b/src/compiler.sml
index 2a53bf08..9cf874c7 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -53,7 +53,9 @@ type job = {
      jsFuncs : (Settings.ffi * string) list,
      rewrites : Settings.rewrite list,
      filterUrl : Settings.rule list,
-     filterMime : Settings.rule list
+     filterMime : Settings.rule list,
+     protocol : string option,
+     dbms : string option
 }
 
 type ('src, 'dst) phase = {
@@ -349,6 +351,8 @@ fun parseUrp' fname =
                 val url = ref []
                 val mime = ref []
                 val libs = ref []
+                val protocol = ref NONE
+                val dbms = ref NONE
 
                 fun finish sources =
                     let
@@ -373,7 +377,9 @@ fun parseUrp' fname =
                             rewrites = rev (!rewrites),
                             filterUrl = rev (!url),
                             filterMime = rev (!mime),
-                            sources = sources
+                            sources = sources,
+                            protocol = !protocol,
+                            dbms = !dbms
                         }
 
                         fun mergeO f (old, new) =
@@ -410,7 +416,9 @@ fun parseUrp' fname =
                             rewrites = #rewrites old @ #rewrites new,
                             filterUrl = #filterUrl old @ #filterUrl new,
                             filterMime = #filterMime old @ #filterMime new,
-                            sources = #sources new @ #sources old
+                            sources = #sources new @ #sources old,
+                            protocol = mergeO #2 (#protocol old, #protocol new),
+                            dbms = mergeO #2 (#dbms old, #dbms new)
                         }
                     in
                         foldr (fn (fname, job) => merge (job, pu fname)) job (!libs)
@@ -570,6 +578,8 @@ fun parseUrp' fname =
                 Settings.setRewriteRules (#rewrites job);
                 Settings.setUrlRules (#filterUrl job);
                 Settings.setMimeRules (#filterMime job);
+                Option.app Settings.setProtocol (#protocol job);
+                Option.app Settings.setDbms (#dbms job);
                 job
             end
     in
@@ -949,7 +959,7 @@ fun compile job =
                 val hasDb = List.exists (fn (Cjr.DDatabase _, _) => true | _ => false) (#1 file)
                 val libs =
                     if hasDb then
-                        "-lpq"
+                        #link (Settings.currentDbms ())
                     else
                         ""
             in
diff --git a/src/demo.sml b/src/demo.sml
index 21242d73..b8323993 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -106,7 +106,9 @@ fun make {prefix, dirname, guided} =
             jsFuncs = [],
             rewrites = #rewrites combined @ #rewrites urp,
             filterUrl = #filterUrl combined @ #filterUrl urp,
-            filterMime = #filterMime combined @ #filterMime urp
+            filterMime = #filterMime combined @ #filterMime urp,
+            protocol = mergeWith #2 (#protocol combined, #protocol urp),
+            dbms = mergeWith #2 (#dbms combined, #dbms urp)
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 62fb6509..7498bb5e 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -41,6 +41,9 @@ fun doArgs args =
       | "-protocol" :: name :: rest =>
         (Settings.setProtocol name;
          doArgs rest)
+      | "-dbms" :: name :: rest =>
+        (Settings.setDbms name;
+         doArgs rest)
       | "-debug" :: rest =>
         (Settings.setDebug true;
          doArgs rest)
diff --git a/src/mysql.sig b/src/mysql.sig
new file mode 100644
index 00000000..fa254ae3
--- /dev/null
+++ b/src/mysql.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MYSQL = sig
+
+end
diff --git a/src/mysql.sml b/src/mysql.sml
new file mode 100644
index 00000000..b791a93c
--- /dev/null
+++ b/src/mysql.sml
@@ -0,0 +1,273 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure MySQL :> MYSQL = struct
+
+open Settings
+open Print.PD
+open Print
+
+fun init (dbstring, ss) =
+    let
+        val host = ref NONE
+        val user = ref NONE
+        val passwd = ref NONE
+        val db = ref NONE
+        val port = ref NONE
+        val unix_socket = ref NONE
+
+        fun stringOf r = case !r of
+                             NONE => string "NULL"
+                           | SOME s => box [string "\"",
+                                            string (String.toString s),
+                                            string "\""]
+    in
+        app (fn s =>
+                case String.fields (fn ch => ch = #"=") s of
+                    [name, value] =>
+                    (case name of
+                         "host" =>
+                         if size value > 0 andalso String.sub (value, 0) = #"/" then
+                             unix_socket := SOME value
+                         else
+                             host := SOME value
+                       | "hostaddr" => host := SOME value
+                       | "port" => port := Int.fromString value
+                       | "dbname" => db := SOME value
+                       | "user" => user := SOME value
+                       | "password" => passwd := SOME value
+                       | _ => ())
+                  | _ => ()) (String.tokens Char.isSpace dbstring);
+
+        box [string "typedef struct {",
+             newline,
+             box [string "MYSQL *conn;",
+                  newline,
+                  p_list_sepi (box [])
+                              (fn i => fn _ =>
+                                          box [string "MYSQL_STMT *p",
+                                               string (Int.toString i),
+                                               string ";",
+                                               newline])
+                              ss],
+             string "} uw_conn;",
+             newline,
+             newline,
+
+             if #persistent (currentProtocol ()) then
+                 box [string "static void uw_db_prepare(uw_context ctx) {",
+                      newline,
+                      string "uw_conn *conn = uw_get_db(ctx);",
+                      newline,
+                      string "MYSQL_STMT *stmt;",
+                      newline,
+                      newline,
+
+                      p_list_sepi newline (fn i => fn (s, n) =>
+                                                      let
+                                                          fun uhoh this s args =
+                                                              box [p_list_sepi (box [])
+                                                                               (fn j => fn () =>
+                                                                                           box [string
+                                                                                                    "mysql_stmt_close(conn->p",
+                                                                                                string (Int.toString j),
+                                                                                                string ");",
+                                                                                                newline])
+                                                                               (List.tabulate (i, fn _ => ())),
+                                                                   box (if this then
+                                                                            [string
+                                                                                 "mysql_stmt_close(conn->p",
+                                                                             string (Int.toString i),
+                                                                             string ");",
+                                                                             newline]
+                                                                        else
+                                                                            []),
+                                                                   string "mysql_close(conn->conn);",
+                                                                   newline,
+                                                                   string "uw_error(ctx, FATAL, \"",
+                                                                   string s,
+                                                                   string "\"",
+                                                                   p_list_sep (box []) (fn s => box [string ", ",
+                                                                                                     string s]) args,
+                                                                   string ");",
+                                                                   newline]
+                                                      in
+                                                          box [string "stmt = mysql_stmt_init(conn->conn);",
+                                                               newline,
+                                                               string "if (stmt == NULL) {",
+                                                               newline,
+                                                               uhoh false "Out of memory allocating prepared statement" [],
+                                                               string "}",
+                                                               newline,
+
+                                                               string "if (mysql_stmt_prepare(stmt, \"",
+                                                               string (String.toString s),
+                                                               string "\", ",
+                                                               string (Int.toString (size s)),
+                                                               string ")) {",
+                                                               newline,
+                                                               box [string "char msg[1024];",
+                                                                    newline,
+                                                                    string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
+                                                                    newline,
+                                                                    string "msg[1023] = 0;",
+                                                                    newline,
+                                                                    uhoh true "Error preparing statement: %s" ["msg"]],
+                                                               string "}",
+                                                               newline]
+                                                      end)
+                                  ss,
+
+                      string "}"]
+             else
+                 string "static void uw_db_prepare(uw_context ctx) { }",
+             newline,
+             newline,
+             
+             string "void uw_db_init(uw_context ctx) {",
+             newline,
+             string "MYSQL *mysql = mysql_init(NULL);",
+             newline,
+             string "uw_conn *conn;",
+             newline,
+             string "if (mysql == NULL) uw_error(ctx, FATAL, ",
+             string "\"libmysqlclient can't allocate a connection.\");",
+             newline,
+             string "if (mysql_real_connect(mysql, ",
+             stringOf host,
+             string ", ",
+             stringOf user,
+             string ", ",
+             stringOf passwd,
+             string ", ",
+             stringOf db,
+             string ", ",
+             case !port of
+                 NONE => string "0"
+               | SOME n => string (Int.toString n),
+             string ", ",
+             stringOf unix_socket,
+             string ", 0)) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, mysql_error(mysql), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "mysql_close(mysql);",
+                  newline,
+                  string "uw_error(ctx, BOUNDED_RETRY, ",
+                  string "\"Connection to MySQL server failed: %s\", msg);"],
+             newline,
+             string "}",
+             newline,
+             string "conn = malloc(sizeof(conn));",
+             newline,
+             string "conn->conn = mysql;",
+             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 "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             p_list_sepi (box [])
+                         (fn i => fn _ =>
+                                     box [string "if (conn->p",
+                                          string (Int.toString i),
+                                          string ") mysql_stmt_close(conn->p",
+                                          string (Int.toString i),
+                                          string ");",
+                                          newline])
+                         ss,
+             string "mysql_close(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "int uw_db_begin(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             newline,
+             string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE\")",
+             newline,
+             string "  || mysql_query(conn->conn, \"BEGIN\");",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "int uw_db_commit(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             string "return mysql_commit(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "int uw_db_rollback(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             string "return mysql_rollback(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline]
+    end
+
+val () = addDbms {name = "mysql",
+                  header = "mysql/mysql.h",
+                  link = "-lmysqlclient",
+                  global_init = box [string "void uw_client_init() {",
+                                     newline,
+                                     box [string "if (mysql_library_init(0, NULL, NULL)) {",
+                                          newline,
+                                          box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
+                                               newline,
+                                               string "exit(1);",
+                                               newline],
+                                          string "}",
+                                          newline],
+                              string "}",
+                                     newline],
+                  init = init}
+
+end
diff --git a/src/postgres.sig b/src/postgres.sig
new file mode 100644
index 00000000..54117f07
--- /dev/null
+++ b/src/postgres.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature POSTGRES = sig
+
+end
diff --git a/src/postgres.sml b/src/postgres.sml
new file mode 100644
index 00000000..43db90e7
--- /dev/null
+++ b/src/postgres.sml
@@ -0,0 +1,200 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Postgres :> POSTGRES = struct
+
+open Settings
+open Print.PD
+open Print
+
+fun init (dbstring, ss) =
+    box [if #persistent (currentProtocol ()) then
+             box [string "static void uw_db_prepare(uw_context ctx) {",
+                  newline,
+                  string "PGconn *conn = uw_get_db(ctx);",
+                  newline,
+                  string "PGresult *res;",
+                  newline,
+                  newline,
+
+                  p_list_sepi newline (fn i => fn (s, n) =>
+                                                  box [string "res = PQprepare(conn, \"uw",
+                                                       string (Int.toString i),
+                                                       string "\", \"",
+                                                       string (String.toString s),
+                                                       string "\", ",
+                                                       string (Int.toString n),
+                                                       string ", NULL);",
+                                                       newline,
+                                                       string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+                                                       newline,
+                                                       box [string "char msg[1024];",
+                                                            newline,
+                                                            string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                                                            newline,
+                                                            string "msg[1023] = 0;",
+                                                            newline,
+                                                            string "PQclear(res);",
+                                                            newline,
+                                                            string "PQfinish(conn);",
+                                                            newline,
+                                                            string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
+                                                            string (String.toString s),
+                                                            string "\\n%s\", msg);",
+                                                            newline],
+                                                       string "}",
+                                                       newline,
+                                                       string "PQclear(res);",
+                                                       newline])
+                              ss,
+
+                  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_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]
+         else
+             string "static void uw_db_prepare(uw_context ctx) { }",
+         newline,
+         newline,
+
+         string "void uw_db_init(uw_context ctx) {",
+         newline,
+         string "PGconn *conn = PQconnectdb(\"",
+         string (String.toString dbstring),
+         string "\");",
+         newline,
+         string "if (conn == NULL) uw_error(ctx, FATAL, ",
+         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 "}"]
+
+val () = addDbms {name = "postgres",
+                  header = "postgresql/libpq-fe.h",
+                  link = "-lpq",
+                  global_init = box [string "void uw_client_init() { }",
+                                     newline],
+                  init = init}
+val () = setDbms "postgres"
+
+end
diff --git a/src/settings.sig b/src/settings.sig
index 8259e519..215839a1 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -27,6 +27,11 @@
 
 signature SETTINGS = sig
     
+    val setDebug : bool -> unit
+    val getDebug : unit -> bool
+                           
+    val clibFile : string -> string
+
     (* How do all application URLs begin? *)
     val setUrlPrefix : string -> unit
     val getUrlPrefix : unit -> string
@@ -92,13 +97,25 @@ signature SETTINGS = sig
         persistent : bool   (* Multiple requests per process? *)
     }
     val addProtocol : protocol -> unit
-    val getProtocol : string -> protocol option
     val setProtocol : string -> unit
     val currentProtocol : unit -> protocol
 
-    val setDebug : bool -> unit
-    val getDebug : unit -> bool
+    (* Different DBMSes *)
+    type dbms = {
+         name : string,
+         (* Call it this on the command line *)
+         header : string,
+         (* Include this C header file *)
+         link : string,
+         (* Pass these linker arguments *)
+         global_init : Print.PD.pp_desc,
+         (* Define uw_client_init() *)
+         init : string * (string * int) list -> Print.PD.pp_desc
+         (* Define uw_db_init() from dbstring and prepared statements *)
+    }
 
-    val clibFile : string -> string
+    val addDbms : dbms -> unit
+    val setDbms : string -> unit
+    val currentDbms : unit -> dbms
 
 end
diff --git a/src/settings.sml b/src/settings.sml
index 845683a7..ed3d1f14 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -274,4 +274,26 @@ val debug = ref false
 fun setDebug b = debug := b
 fun getDebug () = !debug
 
+type dbms = {
+     name : string,
+     header : string,
+     link : string,
+     global_init : Print.PD.pp_desc,
+     init : string * (string * int) list -> Print.PD.pp_desc
+}
+
+val dbmses = ref ([] : dbms list)
+val curDb = ref ({name = "",
+                  header = "",
+                  link = "",
+                  global_init = Print.box [],
+                  init = fn _ => Print.box []} : dbms)
+
+fun addDbms v = dbmses := v :: !dbmses
+fun setDbms s =
+    case List.find (fn db => #name db = s) (!dbmses) of
+        NONE => raise Fail ("Unknown DBMS " ^ s)
+      | SOME db => curDb := db
+fun currentDbms () = !curDb
+
 end
diff --git a/src/sources b/src/sources
index 0ed28654..7ba0b999 100644
--- a/src/sources
+++ b/src/sources
@@ -25,6 +25,12 @@ cgi.sml
 fastcgi.sig
 fastcgi.sml
 
+postgres.sig
+postgres.sml
+
+mysql.sig
+mysql.sml
+
 print.sig
 print.sml