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@873: fun p_sql_type t = adamc@873: case t of adamc@873: Int => "bigint" adamc@873: | Float => "double" adamc@873: | String => "longtext" adamc@873: | Bool => "bool" adamc@873: | Time => "timestamp" adamc@873: | Blob => "longblob" adamc@873: | Channel => "bigint" adamc@873: | Client => "int" adamc@873: | Nullable t => p_sql_type t adamc@873: adamc@873: fun p_buffer_type t = adamc@873: case t of adamc@873: Int => "MYSQL_TYPE_LONGLONG" adamc@873: | Float => "MYSQL_TYPE_DOUBLE" adamc@873: | String => "MYSQL_TYPE_STRING" adamc@873: | Bool => "MYSQL_TYPE_LONG" adamc@873: | Time => "MYSQL_TYPE_TIME" adamc@873: | Blob => "MYSQL_TYPE_BLOB" adamc@873: | Channel => "MYSQL_TYPE_LONGLONG" adamc@873: | Client => "MYSQL_TYPE_LONG" adamc@873: | Nullable t => p_buffer_type t adamc@873: adamc@874: fun p_sql_type_base t = adamc@874: case t of adamc@874: Int => "bigint" adamc@874: | Float => "double" adamc@874: | String => "longtext" adamc@874: | Bool => "tinyint" adamc@874: | Time => "timestamp" adamc@874: | Blob => "longblob" adamc@874: | Channel => "bigint" adamc@874: | Client => "int" adamc@874: | Nullable t => p_sql_type_base t adamc@874: adamc@874: val ident = String.translate (fn #"'" => "PRIME" adamc@874: | ch => str ch) adamc@874: adamc@874: fun checkRel (table, checkNullable) (s, xts) = adamc@874: let adamc@874: val sl = CharVector.map Char.toLower s adamc@874: adamc@874: val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '" adamc@874: ^ sl ^ "'" adamc@874: adamc@874: val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", adamc@874: sl, adamc@874: "' AND (", adamc@874: String.concatWith " OR " adamc@874: (map (fn (x, t) => adamc@874: String.concat ["(column_name = 'uw_", adamc@874: CharVector.map adamc@874: Char.toLower (ident x), adamc@874: "' AND data_type = '", adamc@874: p_sql_type_base t, adamc@874: "'", adamc@874: if checkNullable then adamc@874: (" AND is_nullable = '" adamc@874: ^ (if isNotNull t then adamc@874: "NO" adamc@874: else adamc@874: "YES") adamc@874: ^ "'") adamc@874: else adamc@874: "", adamc@874: ")"]) xts), adamc@874: ")"] adamc@874: adamc@874: val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", adamc@874: sl, adamc@874: "' AND column_name LIKE 'uw_%'"] adamc@874: in adamc@874: box [string "if (mysql_query(conn->conn, \"", adamc@874: string q, adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((res = mysql_store_result(conn->conn)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Result store failed:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_num_fields(res) != 1) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Bad column count:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((row = mysql_fetch_row(res)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (strcmp(row[0], \"1\")) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Table '", adamc@874: string s, adamc@874: string "' does not exist.\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: string "mysql_free_result(res);", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_query(conn->conn, \"", adamc@874: string q', adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((res = mysql_store_result(conn->conn)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Result store failed:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_num_fields(res) != 1) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Bad column count:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((row = mysql_fetch_row(res)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (strcmp(row[0], \"", adamc@874: string (Int.toString (length xts)), adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Table '", adamc@874: string s, adamc@874: string "' has the wrong column types.\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: string "mysql_free_result(res);", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_query(conn->conn, \"", adamc@874: string q'', adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((res = mysql_store_result(conn->conn)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Result store failed:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_num_fields(res) != 1) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Bad column count:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((row = mysql_fetch_row(res)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (strcmp(row[0], \"", adamc@874: string (Int.toString (length xts)), adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Table '", adamc@874: string s, adamc@874: string "' has extra columns.\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: string "mysql_free_result(res);", adamc@874: newline] adamc@874: end adamc@874: adamc@872: fun init {dbstring, prepared = ss, tables, views, 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@874: string "void uw_client_init(void) {", adamc@874: newline, adamc@874: box [string "if (mysql_library_init(0, NULL, NULL)) {", adamc@874: newline, adamc@874: box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");", adamc@874: newline, adamc@874: string "exit(1);", adamc@874: newline], adamc@874: string "}", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@866: if #persistent (currentProtocol ()) then adamc@874: box [string "static void uw_db_validate(uw_context ctx) {", adamc@874: newline, adamc@874: string "uw_conn *conn = uw_get_db(ctx);", adamc@874: newline, adamc@874: string "MYSQL_RES *res;", adamc@874: newline, adamc@874: string "MYSQL_ROW row;", adamc@874: newline, adamc@874: newline, adamc@874: p_list_sep newline (checkRel ("tables", true)) tables, adamc@874: p_list_sep newline (checkRel ("views", false)) views, adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: 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@874: string "conn->p", adamc@874: string (Int.toString i), adamc@874: string " = stmt;", adamc@874: 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@874: string ", 0) == NULL) {", 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@874: string "conn = calloc(1, sizeof(uw_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@873: fun p_getcol {wontLeakStrings = _, col = i, typ = t} = adamc@873: let adamc@873: fun getter t = adamc@873: case t of adamc@873: String => box [string "({", adamc@873: newline, adamc@873: string "uw_Basis_string s = uw_malloc(ctx, length", adamc@873: string (Int.toString i), adamc@873: string " + 1);", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = s;", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = length", adamc@873: string (Int.toString i), adamc@873: string " + 1;", adamc@873: newline, adamc@873: string "mysql_stmt_fetch_column(stmt, &out[", adamc@873: string (Int.toString i), adamc@873: string "], ", adamc@873: string (Int.toString i), adamc@873: string ", 0);", adamc@873: newline, adamc@873: string "s[length", adamc@873: string (Int.toString i), adamc@873: string "] = 0;", adamc@873: newline, adamc@873: string "s;", adamc@873: newline, adamc@873: string "})"] adamc@873: | Blob => box [string "({", adamc@873: newline, adamc@873: string "uw_Basis_blob b = {length", adamc@873: string (Int.toString i), adamc@873: string ", uw_malloc(ctx, length", adamc@873: string (Int.toString i), adamc@873: string ")};", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = b.data;", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: string "mysql_stmt_fetch_column(stmt, &out[", adamc@873: string (Int.toString i), adamc@873: string "], ", adamc@873: string (Int.toString i), adamc@873: string ", 0);", adamc@873: newline, adamc@873: string "b;", adamc@873: newline, adamc@873: string "})"] adamc@873: | Time => box [string "({", adamc@876: string "MYSQL_TIME *mt = &buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: newline, adamc@873: string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month, mt->year, 0, 0, -1};", adamc@873: newline, adamc@876: string "mktime(&t);", adamc@873: newline, adamc@873: string "})"] adamc@873: | _ => box [string "buffer", adamc@873: string (Int.toString i)] adamc@873: in adamc@873: case t of adamc@873: Nullable t => box [string "(is_null", adamc@873: string (Int.toString i), adamc@873: string " ? NULL : ", adamc@873: case t of adamc@873: String => getter t adamc@873: | _ => box [string "({", adamc@873: newline, adamc@873: string (p_sql_ctype t), adamc@873: space, adamc@873: string "*tmp = uw_malloc(ctx, sizeof(", adamc@873: string (p_sql_ctype t), adamc@873: string "));", adamc@873: newline, adamc@873: string "*tmp = ", adamc@873: getter t, adamc@873: string ";", adamc@873: newline, adamc@873: string "tmp;", adamc@873: newline, adamc@873: string "})"], adamc@873: string ")"] adamc@873: | _ => box [string "(is_null", adamc@873: string (Int.toString i), adamc@873: string " ? ", adamc@873: box [string "({", adamc@873: string (p_sql_ctype t), adamc@873: space, adamc@873: string "tmp;", adamc@873: newline, adamc@873: string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #", adamc@873: string (Int.toString i), adamc@873: string "\");", adamc@873: newline, adamc@873: string "tmp;", adamc@873: newline, adamc@873: string "})"], adamc@873: string " : ", adamc@873: getter t, adamc@873: string ")"] adamc@873: end adamc@873: adamc@873: fun queryCommon {loc, query, cols, doCols} = adamc@873: box [string "int n, r;", adamc@873: newline, adamc@873: string "MYSQL_BIND out[", adamc@873: string (Int.toString (length cols)), adamc@873: string "];", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@873: String => box [string "unsigned long length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Blob => box [string "unsigned long length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@876: | Time => box [string "MYSQL_TIME buffer", adamc@876: string (Int.toString i), adamc@876: string ";", adamc@876: newline] adamc@873: | _ => box [string (p_sql_ctype t), adamc@873: space, adamc@873: string "buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "my_bool is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: case t of adamc@873: Nullable t => buffers t adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) cols, adamc@873: newline, adamc@873: adamc@873: string "memset(out, 0, sizeof out);", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@875: String => box [string "out[", adamc@875: string (Int.toString i), adamc@875: string "].length = &length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Blob => box [string "out[", adamc@875: string (Int.toString i), adamc@875: string "].length = &length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@873: | _ => box [string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = &buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_type = ", adamc@873: string (p_buffer_type t), adamc@873: string ";", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].is_null = &is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: adamc@873: case t of adamc@873: Nullable t => buffers t adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) cols, adamc@873: newline, adamc@873: adamc@875: string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error reseting statement: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adamc@873: string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": Error executing query: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adamc@875: string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error binding query result: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": Error storing query result: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: string "uw_end_region(ctx);", adamc@873: newline, adamc@875: string "while (1) {", adamc@875: newline, adamc@875: string "r = mysql_stmt_fetch(stmt);", adamc@875: newline, adamc@875: string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;", adamc@873: newline, adamc@873: doCols p_getcol, adamc@873: string "}", adamc@873: newline, adamc@873: newline, adamc@873: adamc@874: string "if (r == 1) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": query result fetching failed: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adamc@875: string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error reseting statement: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline] adamc@873: adamc@873: fun query {loc, cols, doCols} = adamc@873: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@873: newline, adamc@876: string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);", adamc@873: newline, adamc@875: string "if (stmt == NULL) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@873: string ": can't allocate temporary prepared statement\");", adamc@873: newline, adamc@873: string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);", adamc@873: newline, adamc@873: string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}, adamc@873: adamc@873: string "uw_pop_cleanup(ctx);", adamc@873: newline] adamc@873: adamc@873: fun queryPrepared {loc, id, query, inputs, cols, doCols} = adamc@873: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@873: newline, adamc@873: string "MYSQL_BIND in[", adamc@873: string (Int.toString (length inputs)), adamc@873: string "];", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@873: String => box [string "unsigned long in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Blob => box [string "unsigned long in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@876: | Time => box [string "MYSQL_TIME in_buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | _ => box [] adamc@873: in adamc@873: box [case t of adamc@873: Nullable t => box [string "my_bool in_is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: buffers t] adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) inputs, adamc@873: string "MYSQL_STMT *stmt = conn->p", adamc@873: string (Int.toString id), adamc@873: string ";", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: string "memset(in, 0, sizeof in);", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@873: String => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ";", adamc@873: newline, adamc@873: string "in_length", adamc@873: string (Int.toString i), adamc@873: string "= in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = strlen(arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ");", adamc@873: newline, adamc@873: string "in[", adamc@873: string (Int.toString i), adamc@873: string "].length = &in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Blob => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ".data;", adamc@873: newline, adamc@873: string "in_length", adamc@873: string (Int.toString i), adamc@873: string "= in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ".size;", adamc@873: newline, adamc@873: string "in[", adamc@873: string (Int.toString i), adamc@873: string "].length = &in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Time => adamc@873: let adamc@873: fun oneField dst src = adamc@873: box [string "in_buffer", adamc@873: string (Int.toString i), adamc@873: string ".", adamc@873: string dst, adamc@873: string " = tms.tm_", adamc@873: string src, adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "({", adamc@873: newline, adamc@873: string "struct tm tms;", adamc@873: newline, adamc@873: string "if (localtime_r(&arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ", &tm) == NULL) uw_error(\"", adamc@873: string (ErrorMsg.spanToString loc), adamc@873: string ": error converting to MySQL time\");", adamc@873: newline, adamc@873: oneField "year" "year", adamc@873: oneField "month" "mon", adamc@873: oneField "day" "mday", adamc@873: oneField "hour" "hour", adamc@873: oneField "minute" "min", adamc@873: oneField "second" "sec", adamc@873: newline, adamc@873: string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = &in_buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: end adamc@873: adamc@873: | _ => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = &arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_type = ", adamc@873: string (p_buffer_type t), adamc@873: string ";", adamc@873: newline, adamc@873: adamc@873: case t of adamc@873: Nullable t => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].is_null = &in_is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: string "if (arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string " == NULL) {", adamc@873: newline, adamc@873: box [string "in_is_null", adamc@873: string (Int.toString i), adamc@873: string " = 1;", adamc@873: newline], adamc@873: string "} else {", adamc@873: box [case t of adamc@873: String => box [] adamc@873: | _ => adamc@873: box [string (p_sql_ctype t), adamc@873: space, adamc@876: string "tmp = *arg", adamc@876: string (Int.toString (i + 1)), adamc@876: string ";", adamc@876: newline, adamc@876: string (p_sql_ctype t), adamc@876: space, adamc@873: string "arg", adamc@873: string (Int.toString (i + 1)), adamc@876: string " = tmp;", adamc@873: newline], adamc@873: string "in_is_null", adamc@873: string (Int.toString i), adamc@873: string " = 0;", adamc@873: newline, adamc@873: buffers t, adamc@876: newline], adamc@876: string "}", adamc@876: newline] adamc@873: adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) inputs, adamc@873: newline, adamc@873: adamc@875: string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error binding parameters\");", adamc@875: newline, adamc@875: adamc@873: queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", adamc@873: string (String.toString query), adamc@873: string "\""]}] adamc@873: adamc@875: fun dmlCommon {loc, dml} = adamc@875: box [string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error executing DML: %s\\n%s\", ", adamc@875: dml, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline] adamc@875: adamc@875: fun dml loc = adamc@875: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@875: newline, adamc@875: string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);", adamc@875: newline, adamc@875: string "if (stmt == NULL) uw_error(ctx, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": can't allocate temporary prepared statement\");", adamc@875: newline, adamc@875: string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);", adamc@875: newline, adamc@875: string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adamc@875: dmlCommon {loc = loc, dml = string "dml"}, adamc@875: adamc@875: string "uw_pop_cleanup(ctx);", adamc@875: newline] adamc@875: adamc@875: fun dmlPrepared {loc, id, dml, inputs} = adamc@875: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@875: newline, adamc@875: string "MYSQL_BIND in[", adamc@875: string (Int.toString (length inputs)), adamc@875: string "];", adamc@875: newline, adamc@875: p_list_sepi (box []) (fn i => fn t => adamc@875: let adamc@875: fun buffers t = adamc@875: case t of adamc@875: String => box [string "unsigned long in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Blob => box [string "unsigned long in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@876: | Time => box [string "MYSQL_TIME in_buffer", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | _ => box [] adamc@875: in adamc@875: box [case t of adamc@875: Nullable t => box [string "my_bool in_is_null", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline, adamc@875: buffers t] adamc@875: | _ => buffers t, adamc@875: newline] adamc@875: end) inputs, adamc@875: string "MYSQL_STMT *stmt = conn->p", adamc@875: string (Int.toString id), adamc@875: string ";", adamc@875: newline, adamc@875: newline, adamc@875: adamc@875: string "memset(in, 0, sizeof in);", adamc@875: newline, adamc@875: p_list_sepi (box []) (fn i => fn t => adamc@875: let adamc@875: fun buffers t = adamc@875: case t of adamc@875: String => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ";", adamc@875: newline, adamc@875: string "in_length", adamc@875: string (Int.toString i), adamc@875: string "= in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer_length = strlen(arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ");", adamc@875: newline, adamc@875: string "in[", adamc@875: string (Int.toString i), adamc@875: string "].length = &in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Blob => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ".data;", adamc@875: newline, adamc@875: string "in_length", adamc@875: string (Int.toString i), adamc@875: string "= in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer_length = arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ".size;", adamc@875: newline, adamc@875: string "in[", adamc@875: string (Int.toString i), adamc@875: string "].length = &in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Time => adamc@875: let adamc@875: fun oneField dst src = adamc@875: box [string "in_buffer", adamc@875: string (Int.toString i), adamc@875: string ".", adamc@875: string dst, adamc@875: string " = tms.tm_", adamc@875: string src, adamc@875: string ";", adamc@875: newline] adamc@875: in adamc@875: box [string "({", adamc@875: newline, adamc@875: string "struct tm tms;", adamc@875: newline, adamc@875: string "if (localtime_r(&arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ", &tm) == NULL) uw_error(\"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error converting to MySQL time\");", adamc@875: newline, adamc@875: oneField "year" "year", adamc@875: oneField "month" "mon", adamc@875: oneField "day" "mday", adamc@875: oneField "hour" "hour", adamc@875: oneField "minute" "min", adamc@875: oneField "second" "sec", adamc@875: newline, adamc@875: string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = &in_buffer", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: end adamc@875: adamc@875: | _ => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = &arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ";", adamc@875: newline] adamc@875: in adamc@875: box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer_type = ", adamc@875: string (p_buffer_type t), adamc@875: string ";", adamc@875: newline, adamc@875: adamc@875: case t of adamc@875: Nullable t => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].is_null = &in_is_null", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline, adamc@875: string "if (arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string " == NULL) {", adamc@875: newline, adamc@875: box [string "in_is_null", adamc@875: string (Int.toString i), adamc@875: string " = 1;", adamc@875: newline], adamc@875: string "} else {", adamc@875: box [case t of adamc@875: String => box [] adamc@875: | _ => adamc@875: box [string (p_sql_ctype t), adamc@875: space, adamc@876: string "tmp = *arg", adamc@876: string (Int.toString (i + 1)), adamc@876: string ";", adamc@876: newline, adamc@876: string (p_sql_ctype t), adamc@876: space, adamc@875: string "arg", adamc@875: string (Int.toString (i + 1)), adamc@876: string " = tmp;", adamc@875: newline], adamc@875: string "in_is_null", adamc@875: string (Int.toString i), adamc@875: string " = 0;", adamc@875: newline, adamc@875: buffers t, adamc@876: newline], adamc@876: string "}", adamc@876: newline] adamc@875: adamc@875: | _ => buffers t, adamc@875: newline] adamc@875: end) inputs, adamc@875: newline, adamc@875: adamc@875: string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error binding parameters\");", adamc@875: newline, adamc@875: adamc@875: dmlCommon {loc = loc, dml = box [string "\"", adamc@875: string (String.toString dml), adamc@875: string "\""]}] adamc@875: adamc@873: fun nextval _ = box [] adamc@873: fun nextvalPrepared _ = box [] adamc@867: adamc@877: fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'" adamc@877: | #"\\" => "\\\\" adamc@877: | ch => adamc@877: if Char.isPrint ch then adamc@877: str ch adamc@877: else adamc@877: (ErrorMsg.error adamc@877: "Non-printing character found in SQL string literal"; adamc@877: "")) adamc@877: (String.toString s) ^ "'" adamc@874: adamc@877: fun p_cast (s, _) = s adamc@874: adamc@874: fun p_blank _ = "?" adamc@874: adamc@866: val () = addDbms {name = "mysql", adamc@866: header = "mysql/mysql.h", adamc@866: link = "-lmysqlclient", adamc@867: init = init, adamc@873: p_sql_type = p_sql_type, adamc@867: query = query, adamc@868: queryPrepared = queryPrepared, adamc@868: dml = dml, adamc@869: dmlPrepared = dmlPrepared, adamc@869: nextval = nextval, adamc@874: nextvalPrepared = nextvalPrepared, adamc@874: sqlifyString = sqlifyString, adamc@874: p_cast = p_cast, adamc@874: p_blank = p_blank, adamc@877: supportsDeleteAs = false, adamc@877: createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTO_INCREMENT)", adamc@877: textKeysNeedLengths = true} adamc@866: adamc@866: end