adamc@866: (* Copyright (c) 2008-2009, Adam Chlipala adamc@866: * All rights reserved. adamc@866: * adamc@866: * Redistribution and use in source and binary forms, with or without adamc@866: * modification, are permitted provided that the following conditions are met: adamc@866: * adamc@866: * - Redistributions of source code must retain the above copyright notice, adamc@866: * this list of conditions and the following disclaimer. adamc@866: * - Redistributions in binary form must reproduce the above copyright notice, adamc@866: * this list of conditions and the following disclaimer in the documentation adamc@866: * and/or other materials provided with the distribution. adamc@866: * - The names of contributors may not be used to endorse or promote products adamc@866: * derived from this software without specific prior written permission. adamc@866: * adamc@866: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@866: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@866: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@866: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE adamc@866: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@866: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@866: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@866: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@866: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@866: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@866: * POSSIBILITY OF SUCH DAMAGE. adamc@866: *) adamc@866: adamc@866: structure MySQL :> MYSQL = struct adamc@866: adamc@866: open Settings adamc@866: open Print.PD adamc@866: open Print adamc@866: adamc@870: fun init {dbstring, prepared = ss, tables, sequences} = adamc@866: let adamc@866: val host = ref NONE adamc@866: val user = ref NONE adamc@866: val passwd = ref NONE adamc@866: val db = ref NONE adamc@866: val port = ref NONE adamc@866: val unix_socket = ref NONE adamc@866: adamc@866: fun stringOf r = case !r of adamc@866: NONE => string "NULL" adamc@866: | SOME s => box [string "\"", adamc@866: string (String.toString s), adamc@866: string "\""] adamc@866: in adamc@866: app (fn s => adamc@866: case String.fields (fn ch => ch = #"=") s of adamc@866: [name, value] => adamc@866: (case name of adamc@866: "host" => adamc@866: if size value > 0 andalso String.sub (value, 0) = #"/" then adamc@866: unix_socket := SOME value adamc@866: else adamc@866: host := SOME value adamc@866: | "hostaddr" => host := SOME value adamc@866: | "port" => port := Int.fromString value adamc@866: | "dbname" => db := SOME value adamc@866: | "user" => user := SOME value adamc@866: | "password" => passwd := SOME value adamc@866: | _ => ()) adamc@866: | _ => ()) (String.tokens Char.isSpace dbstring); adamc@866: adamc@866: box [string "typedef struct {", adamc@866: newline, adamc@866: box [string "MYSQL *conn;", adamc@866: newline, adamc@866: p_list_sepi (box []) adamc@866: (fn i => fn _ => adamc@866: box [string "MYSQL_STMT *p", adamc@866: string (Int.toString i), adamc@866: string ";", adamc@866: newline]) adamc@866: ss], adamc@866: string "} uw_conn;", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: if #persistent (currentProtocol ()) then adamc@866: box [string "static void uw_db_prepare(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "MYSQL_STMT *stmt;", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: p_list_sepi newline (fn i => fn (s, n) => adamc@866: let adamc@866: fun uhoh this s args = adamc@866: box [p_list_sepi (box []) adamc@866: (fn j => fn () => adamc@866: box [string adamc@866: "mysql_stmt_close(conn->p", adamc@866: string (Int.toString j), adamc@866: string ");", adamc@866: newline]) adamc@866: (List.tabulate (i, fn _ => ())), adamc@866: box (if this then adamc@866: [string adamc@866: "mysql_stmt_close(conn->p", adamc@866: string (Int.toString i), adamc@866: string ");", adamc@866: newline] adamc@866: else adamc@866: []), adamc@866: string "mysql_close(conn->conn);", adamc@866: newline, adamc@866: string "uw_error(ctx, FATAL, \"", adamc@866: string s, adamc@866: string "\"", adamc@866: p_list_sep (box []) (fn s => box [string ", ", adamc@866: string s]) args, adamc@866: string ");", adamc@866: newline] adamc@866: in adamc@866: box [string "stmt = mysql_stmt_init(conn->conn);", adamc@866: newline, adamc@866: string "if (stmt == NULL) {", adamc@866: newline, adamc@866: uhoh false "Out of memory allocating prepared statement" [], adamc@866: string "}", adamc@866: newline, adamc@866: adamc@866: string "if (mysql_stmt_prepare(stmt, \"", adamc@866: string (String.toString s), adamc@866: string "\", ", adamc@866: string (Int.toString (size s)), adamc@866: string ")) {", adamc@866: newline, adamc@866: box [string "char msg[1024];", adamc@866: newline, adamc@866: string "strncpy(msg, mysql_stmt_error(stmt), 1024);", adamc@866: newline, adamc@866: string "msg[1023] = 0;", adamc@866: newline, adamc@866: uhoh true "Error preparing statement: %s" ["msg"]], adamc@866: string "}", adamc@866: newline] adamc@866: end) adamc@866: ss, adamc@866: adamc@866: string "}"] adamc@866: else adamc@866: string "static void uw_db_prepare(uw_context ctx) { }", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "void uw_db_init(uw_context ctx) {", adamc@866: newline, adamc@866: string "MYSQL *mysql = mysql_init(NULL);", adamc@866: newline, adamc@866: string "uw_conn *conn;", adamc@866: newline, adamc@866: string "if (mysql == NULL) uw_error(ctx, FATAL, ", adamc@866: string "\"libmysqlclient can't allocate a connection.\");", adamc@866: newline, adamc@866: string "if (mysql_real_connect(mysql, ", adamc@866: stringOf host, adamc@866: string ", ", adamc@866: stringOf user, adamc@866: string ", ", adamc@866: stringOf passwd, adamc@866: string ", ", adamc@866: stringOf db, adamc@866: string ", ", adamc@866: case !port of adamc@866: NONE => string "0" adamc@866: | SOME n => string (Int.toString n), adamc@866: string ", ", adamc@866: stringOf unix_socket, adamc@866: string ", 0)) {", adamc@866: newline, adamc@866: box [string "char msg[1024];", adamc@866: newline, adamc@866: string "strncpy(msg, mysql_error(mysql), 1024);", adamc@866: newline, adamc@866: string "msg[1023] = 0;", adamc@866: newline, adamc@866: string "mysql_close(mysql);", adamc@866: newline, adamc@866: string "uw_error(ctx, BOUNDED_RETRY, ", adamc@866: string "\"Connection to MySQL server failed: %s\", msg);"], adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@867: string "conn = calloc(1, sizeof(conn));", adamc@866: newline, adamc@866: string "conn->conn = mysql;", adamc@866: newline, adamc@866: string "uw_set_db(ctx, conn);", adamc@866: newline, adamc@866: string "uw_db_validate(ctx);", adamc@866: newline, adamc@866: string "uw_db_prepare(ctx);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "void uw_db_close(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: p_list_sepi (box []) adamc@866: (fn i => fn _ => adamc@866: box [string "if (conn->p", adamc@866: string (Int.toString i), adamc@866: string ") mysql_stmt_close(conn->p", adamc@866: string (Int.toString i), adamc@866: string ");", adamc@866: newline]) adamc@866: ss, adamc@866: string "mysql_close(conn->conn);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "int uw_db_begin(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: newline, adamc@866: string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE\")", adamc@866: newline, adamc@866: string " || mysql_query(conn->conn, \"BEGIN\");", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "int uw_db_commit(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "return mysql_commit(conn->conn);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "int uw_db_rollback(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "return mysql_rollback(conn->conn);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline] adamc@866: end adamc@866: adamc@867: fun query _ = raise Fail "MySQL query" adamc@867: fun queryPrepared _ = raise Fail "MySQL queryPrepared" adamc@868: fun dml _ = raise Fail "MySQL dml" adamc@868: fun dmlPrepared _ = raise Fail "MySQL dmlPrepared" adamc@869: fun nextval _ = raise Fail "MySQL nextval" adamc@869: fun nextvalPrepared _ = raise Fail "MySQL nextvalPrepared" adamc@867: adamc@866: val () = addDbms {name = "mysql", adamc@866: header = "mysql/mysql.h", adamc@866: link = "-lmysqlclient", adamc@866: global_init = box [string "void uw_client_init() {", adamc@866: newline, adamc@866: box [string "if (mysql_library_init(0, NULL, NULL)) {", adamc@866: newline, adamc@866: box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");", adamc@866: newline, adamc@866: string "exit(1);", adamc@866: newline], adamc@866: string "}", adamc@866: newline], adamc@866: string "}", adamc@866: newline], adamc@867: init = init, adamc@867: query = query, adamc@868: queryPrepared = queryPrepared, adamc@868: dml = dml, adamc@869: dmlPrepared = dmlPrepared, adamc@869: nextval = nextval, adamc@869: nextvalPrepared = nextvalPrepared} adamc@866: adamc@866: end