Mercurial > urweb

annotate src/mysql.sml @ 2307:6ae9a2784a45

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Return to working version mode
author Adam Chlipala <adam@chlipala.net>
date Sun, 20 Dec 2015 14:39:50 -0500
parents c76a9712334c
children
rev   line source
adam@2177 1 (* Copyright (c) 2009-2010, 2015, Adam Chlipala
adamc@866 2 * All rights reserved.
adamc@866 3 *
adamc@866 4 * Redistribution and use in source and binary forms, with or without
adamc@866 5 * modification, are permitted provided that the following conditions are met:
adamc@866 6 *
adamc@866 7 * - Redistributions of source code must retain the above copyright notice,
adamc@866 8 * this list of conditions and the following disclaimer.
adamc@866 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@866 10 * this list of conditions and the following disclaimer in the documentation
adamc@866 11 * and/or other materials provided with the distribution.
adamc@866 12 * - The names of contributors may not be used to endorse or promote products
adamc@866 13 * derived from this software without specific prior written permission.
adamc@866 14 *
adamc@866 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@866 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@866 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@866 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1682 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@866 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@866 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@866 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@866 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@866 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@866 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@866 26 *)
adamc@866 27
adamc@866 28 structure MySQL :> MYSQL = struct
adamc@866 29
adamc@866 30 open Settings
adamc@866 31 open Print.PD
adamc@866 32 open Print
adamc@866 33
adamc@873 34 fun p_sql_type t =
adamc@873 35 case t of
adamc@873 36 Int => "bigint"
adamc@873 37 | Float => "double"
adamc@873 38 | String => "longtext"
adamc@1011 39 | Char => "char"
adamc@873 40 | Bool => "bool"
adamc@873 41 | Time => "timestamp"
adamc@873 42 | Blob => "longblob"
adamc@873 43 | Channel => "bigint"
adamc@873 44 | Client => "int"
adamc@873 45 | Nullable t => p_sql_type t
adamc@873 46
adamc@873 47 fun p_buffer_type t =
adamc@873 48 case t of
adamc@873 49 Int => "MYSQL_TYPE_LONGLONG"
adamc@873 50 | Float => "MYSQL_TYPE_DOUBLE"
adamc@873 51 | String => "MYSQL_TYPE_STRING"
adamc@1013 52 | Char => "MYSQL_TYPE_STRING"
adamc@873 53 | Bool => "MYSQL_TYPE_LONG"
adamc@938 54 | Time => "MYSQL_TYPE_TIMESTAMP"
adamc@873 55 | Blob => "MYSQL_TYPE_BLOB"
adamc@873 56 | Channel => "MYSQL_TYPE_LONGLONG"
adamc@873 57 | Client => "MYSQL_TYPE_LONG"
adamc@873 58 | Nullable t => p_buffer_type t
adamc@873 59
adamc@874 60 fun p_sql_type_base t =
adamc@874 61 case t of
adamc@874 62 Int => "bigint"
adamc@874 63 | Float => "double"
adamc@874 64 | String => "longtext"
adamc@1011 65 | Char => "char"
adamc@874 66 | Bool => "tinyint"
adamc@874 67 | Time => "timestamp"
adamc@874 68 | Blob => "longblob"
adamc@874 69 | Channel => "bigint"
adamc@874 70 | Client => "int"
adamc@874 71 | Nullable t => p_sql_type_base t
adamc@874 72
adamc@874 73 val ident = String.translate (fn #"'" => "PRIME"
adamc@874 74 | ch => str ch)
adamc@874 75
adamc@874 76 fun checkRel (table, checkNullable) (s, xts) =
adamc@874 77 let
adamc@874 78 val sl = CharVector.map Char.toLower s
adam@1953 79 val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then
adam@1953 80 String.substring (sl, 1, size sl - 2)
adam@1953 81 else
adam@1953 82 sl
adam@1970 83 val both = "table_name = '" ^ sl ^ "'"
adamc@874 84
adamc@998 85 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE " ^ both
adamc@874 86
adamc@998 87 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ",
adamc@998 88 both,
adamc@998 89 " AND (",
adam@1600 90 case String.concatWith " OR "
adam@1600 91 (map (fn (x, t) =>
adam@1953 92 String.concat ["(LOWER(column_name) = '",
adam@1953 93 Settings.mangleSqlCatalog
adam@1953 94 (CharVector.map
adam@1953 95 Char.toLower (ident x)),
adam@1953 96 "' AND data_type ",
adam@1953 97 case p_sql_type_base t of
adam@1953 98 "bigint" =>
adam@1953 99 "IN ('bigint', 'int')"
adam@1953 100 | "longtext" =>
adam@1953 101 "IN ('longtext', 'varchar')"
adam@1953 102 | s => "= '" ^ s ^ "'",
adam@1600 103 if checkNullable then
adam@1600 104 (" AND is_nullable = '"
adam@1600 105 ^ (if isNotNull t then
adam@1600 106 "NO"
adam@1600 107 else
adam@1600 108 "YES")
adam@1600 109 ^ "'")
adam@1600 110 else
adam@1600 111 "",
adam@1600 112 ")"]) xts) of
adam@1600 113 "" => "FALSE"
adam@1600 114 | s => s,
adamc@874 115 ")"]
adamc@874 116
adamc@998 117 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ",
adamc@998 118 both,
adam@1953 119 " AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"]
adamc@874 120 in
adamc@874 121 box [string "if (mysql_query(conn->conn, \"",
adamc@874 122 string q,
adamc@874 123 string "\")) {",
adamc@874 124 newline,
adamc@874 125 box [string "mysql_close(conn->conn);",
adamc@874 126 newline,
adamc@874 127 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@874 128 string q,
adamc@874 129 string "\");",
adamc@874 130 newline],
adamc@874 131 string "}",
adamc@874 132 newline,
adamc@874 133 newline,
adamc@874 134
adamc@874 135 string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
adamc@874 136 newline,
adamc@874 137 box [string "mysql_free_result(res);",
adamc@874 138 newline,
adamc@874 139 string "mysql_close(conn->conn);",
adamc@874 140 newline,
adamc@874 141 string "uw_error(ctx, FATAL, \"Result store failed:\\n",
adamc@874 142 string q,
adamc@874 143 string "\");",
adamc@874 144 newline],
adamc@874 145 string "}",
adamc@874 146 newline,
adamc@874 147 newline,
adamc@874 148
adamc@874 149 string "if (mysql_num_fields(res) != 1) {",
adamc@874 150 newline,
adamc@874 151 box [string "mysql_free_result(res);",
adamc@874 152 newline,
adamc@874 153 string "mysql_close(conn->conn);",
adamc@874 154 newline,
adamc@874 155 string "uw_error(ctx, FATAL, \"Bad column count:\\n",
adamc@874 156 string q,
adamc@874 157 string "\");",
adamc@874 158 newline],
adamc@874 159 string "}",
adamc@874 160 newline,
adamc@874 161 newline,
adamc@874 162
adamc@874 163 string "if ((row = mysql_fetch_row(res)) == NULL) {",
adamc@874 164 newline,
adamc@874 165 box [string "mysql_free_result(res);",
adamc@874 166 newline,
adamc@874 167 string "mysql_close(conn->conn);",
adamc@874 168 newline,
adamc@874 169 string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
adamc@874 170 string q,
adamc@874 171 string "\");",
adamc@874 172 newline],
adamc@874 173 string "}",
adamc@874 174 newline,
adamc@874 175 newline,
adamc@874 176
adamc@874 177 string "if (strcmp(row[0], \"1\")) {",
adamc@874 178 newline,
adamc@874 179 box [string "mysql_free_result(res);",
adamc@874 180 newline,
adamc@874 181 string "mysql_close(conn->conn);",
adamc@874 182 newline,
adamc@874 183 string "uw_error(ctx, FATAL, \"Table '",
adam@1953 184 string sl,
adamc@874 185 string "' does not exist.\");",
adamc@874 186 newline],
adamc@874 187 string "}",
adamc@874 188 newline,
adamc@874 189 newline,
adamc@874 190 string "mysql_free_result(res);",
adamc@874 191 newline,
adamc@874 192 newline,
adamc@874 193
adamc@874 194 string "if (mysql_query(conn->conn, \"",
adamc@874 195 string q',
adamc@874 196 string "\")) {",
adamc@874 197 newline,
adamc@874 198 box [string "mysql_close(conn->conn);",
adamc@874 199 newline,
adamc@874 200 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@874 201 string q',
adamc@874 202 string "\");",
adamc@874 203 newline],
adamc@874 204 string "}",
adamc@874 205 newline,
adamc@874 206 newline,
adamc@874 207
adamc@874 208 string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
adamc@874 209 newline,
adamc@874 210 box [string "mysql_free_result(res);",
adamc@874 211 newline,
adamc@874 212 string "mysql_close(conn->conn);",
adamc@874 213 newline,
adamc@874 214 string "uw_error(ctx, FATAL, \"Result store failed:\\n",
adamc@874 215 string q',
adamc@874 216 string "\");",
adamc@874 217 newline],
adamc@874 218 string "}",
adamc@874 219 newline,
adamc@874 220 newline,
adamc@874 221
adamc@874 222 string "if (mysql_num_fields(res) != 1) {",
adamc@874 223 newline,
adamc@874 224 box [string "mysql_free_result(res);",
adamc@874 225 newline,
adamc@874 226 string "mysql_close(conn->conn);",
adamc@874 227 newline,
adamc@874 228 string "uw_error(ctx, FATAL, \"Bad column count:\\n",
adamc@874 229 string q',
adamc@874 230 string "\");",
adamc@874 231 newline],
adamc@874 232 string "}",
adamc@874 233 newline,
adamc@874 234 newline,
adamc@874 235
adamc@874 236 string "if ((row = mysql_fetch_row(res)) == NULL) {",
adamc@874 237 newline,
adamc@874 238 box [string "mysql_free_result(res);",
adamc@874 239 newline,
adamc@874 240 string "mysql_close(conn->conn);",
adamc@874 241 newline,
adamc@874 242 string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
adamc@874 243 string q',
adamc@874 244 string "\");",
adamc@874 245 newline],
adamc@874 246 string "}",
adamc@874 247 newline,
adamc@874 248 newline,
adamc@874 249
adamc@874 250 string "if (strcmp(row[0], \"",
adamc@874 251 string (Int.toString (length xts)),
adamc@874 252 string "\")) {",
adamc@874 253 newline,
adamc@874 254 box [string "mysql_free_result(res);",
adamc@874 255 newline,
adamc@874 256 string "mysql_close(conn->conn);",
adamc@874 257 newline,
adamc@874 258 string "uw_error(ctx, FATAL, \"Table '",
adam@1953 259 string sl,
adamc@874 260 string "' has the wrong column types.\");",
adamc@874 261 newline],
adamc@874 262 string "}",
adamc@874 263 newline,
adamc@874 264 newline,
adamc@874 265 string "mysql_free_result(res);",
adamc@874 266 newline,
adamc@874 267 newline,
adam@1682 268
adamc@874 269 string "if (mysql_query(conn->conn, \"",
adamc@874 270 string q'',
adamc@874 271 string "\")) {",
adamc@874 272 newline,
adamc@874 273 box [string "mysql_close(conn->conn);",
adamc@874 274 newline,
adamc@874 275 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@874 276 string q'',
adamc@874 277 string "\");",
adamc@874 278 newline],
adamc@874 279 string "}",
adamc@874 280 newline,
adamc@874 281 newline,
adamc@874 282
adamc@874 283 string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
adamc@874 284 newline,
adamc@874 285 box [string "mysql_free_result(res);",
adamc@874 286 newline,
adamc@874 287 string "mysql_close(conn->conn);",
adamc@874 288 newline,
adamc@874 289 string "uw_error(ctx, FATAL, \"Result store failed:\\n",
adamc@874 290 string q'',
adamc@874 291 string "\");",
adamc@874 292 newline],
adamc@874 293 string "}",
adamc@874 294 newline,
adamc@874 295 newline,
adamc@874 296
adamc@874 297 string "if (mysql_num_fields(res) != 1) {",
adamc@874 298 newline,
adamc@874 299 box [string "mysql_free_result(res);",
adamc@874 300 newline,
adamc@874 301 string "mysql_close(conn->conn);",
adamc@874 302 newline,
adamc@874 303 string "uw_error(ctx, FATAL, \"Bad column count:\\n",
adamc@874 304 string q'',
adamc@874 305 string "\");",
adamc@874 306 newline],
adamc@874 307 string "}",
adamc@874 308 newline,
adamc@874 309 newline,
adamc@874 310
adamc@874 311 string "if ((row = mysql_fetch_row(res)) == NULL) {",
adamc@874 312 newline,
adamc@874 313 box [string "mysql_free_result(res);",
adamc@874 314 newline,
adamc@874 315 string "mysql_close(conn->conn);",
adamc@874 316 newline,
adamc@874 317 string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
adamc@874 318 string q'',
adamc@874 319 string "\");",
adamc@874 320 newline],
adamc@874 321 string "}",
adamc@874 322 newline,
adamc@874 323 newline,
adamc@874 324
adamc@874 325 string "if (strcmp(row[0], \"",
adamc@874 326 string (Int.toString (length xts)),
adamc@874 327 string "\")) {",
adamc@874 328 newline,
adamc@874 329 box [string "mysql_free_result(res);",
adamc@874 330 newline,
adamc@874 331 string "mysql_close(conn->conn);",
adamc@874 332 newline,
adamc@874 333 string "uw_error(ctx, FATAL, \"Table '",
adam@1953 334 string sl,
adamc@874 335 string "' has extra columns.\");",
adamc@874 336 newline],
adamc@874 337 string "}",
adamc@874 338 newline,
adamc@874 339 newline,
adamc@874 340 string "mysql_free_result(res);",
adamc@874 341 newline]
adamc@874 342 end
adamc@874 343
adamc@872 344 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@866 345 let
adamc@866 346 val host = ref NONE
adamc@866 347 val user = ref NONE
adamc@866 348 val passwd = ref NONE
adamc@866 349 val db = ref NONE
adamc@866 350 val port = ref NONE
adamc@866 351 val unix_socket = ref NONE
adamc@866 352
adamc@866 353 fun stringOf r = case !r of
adamc@866 354 NONE => string "NULL"
adamc@866 355 | SOME s => box [string "\"",
adam@1656 356 string (Prim.toCString s),
adamc@866 357 string "\""]
adamc@866 358 in
adamc@866 359 app (fn s =>
adamc@866 360 case String.fields (fn ch => ch = #"=") s of
adamc@866 361 [name, value] =>
adamc@866 362 (case name of
adamc@866 363 "host" =>
adamc@866 364 if size value > 0 andalso String.sub (value, 0) = #"/" then
adamc@866 365 unix_socket := SOME value
adamc@866 366 else
adamc@866 367 host := SOME value
adamc@866 368 | "hostaddr" => host := SOME value
adamc@866 369 | "port" => port := Int.fromString value
adamc@866 370 | "dbname" => db := SOME value
adamc@866 371 | "user" => user := SOME value
adamc@866 372 | "password" => passwd := SOME value
adamc@866 373 | _ => ())
adamc@866 374 | _ => ()) (String.tokens Char.isSpace dbstring);
adamc@866 375
adamc@866 376 box [string "typedef struct {",
adamc@866 377 newline,
adamc@866 378 box [string "MYSQL *conn;",
adamc@866 379 newline,
adamc@866 380 p_list_sepi (box [])
adamc@866 381 (fn i => fn _ =>
adamc@866 382 box [string "MYSQL_STMT *p",
adamc@866 383 string (Int.toString i),
adamc@866 384 string ";",
adamc@866 385 newline])
adamc@866 386 ss],
adamc@866 387 string "} uw_conn;",
adamc@866 388 newline,
adamc@866 389 newline,
adamc@866 390
adamc@1094 391 string "static void uw_client_init(void) {",
adamc@874 392 newline,
adamc@879 393 box [string "uw_sqlfmtInt = \"%lld%n\";",
adamc@879 394 newline,
adam@1920 395 string "uw_sqlfmtFloat = \"%.16g%n\";",
adamc@879 396 newline,
adamc@879 397 string "uw_Estrings = 0;",
adamc@879 398 newline,
adam@1834 399 string "uw_sql_type_annotations = 0;",
adam@1834 400 newline,
adamc@879 401 string "uw_sqlsuffixString = \"\";",
adamc@879 402 newline,
adamc@1011 403 string "uw_sqlsuffixChar = \"\";",
adamc@1011 404 newline,
adamc@879 405 string "uw_sqlsuffixBlob = \"\";",
adamc@879 406 newline,
adamc@879 407 string "uw_sqlfmtUint4 = \"%u%n\";",
adamc@879 408 newline,
adamc@879 409 newline,
adamc@879 410
adamc@879 411 string "if (mysql_library_init(0, NULL, NULL)) {",
adamc@874 412 newline,
adamc@874 413 box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
adamc@874 414 newline,
adamc@874 415 string "exit(1);",
adamc@874 416 newline],
adamc@874 417 string "}",
adamc@874 418 newline],
adamc@874 419 string "}",
adamc@874 420 newline,
adamc@874 421 newline,
adamc@874 422
adamc@866 423 if #persistent (currentProtocol ()) then
adamc@874 424 box [string "static void uw_db_validate(uw_context ctx) {",
adamc@874 425 newline,
adamc@874 426 string "uw_conn *conn = uw_get_db(ctx);",
adamc@874 427 newline,
adamc@874 428 string "MYSQL_RES *res;",
adamc@874 429 newline,
adamc@874 430 string "MYSQL_ROW row;",
adamc@874 431 newline,
adamc@874 432 newline,
adamc@874 433 p_list_sep newline (checkRel ("tables", true)) tables,
adamc@884 434 p_list_sep newline (fn name => checkRel ("tables", true)
adamc@884 435 (name, [("id", Settings.Client)])) sequences,
adamc@874 436 p_list_sep newline (checkRel ("views", false)) views,
adamc@874 437 string "}",
adamc@874 438 newline,
adamc@874 439 newline,
adamc@874 440
adamc@874 441 string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 442 newline,
adamc@866 443 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 444 newline,
adamc@866 445 string "MYSQL_STMT *stmt;",
adamc@866 446 newline,
adamc@866 447 newline,
adamc@866 448
adam@2103 449 p_list_sepi newline (fn i => fn (s, _) =>
adamc@866 450 let
adamc@866 451 fun uhoh this s args =
adamc@866 452 box [p_list_sepi (box [])
adamc@866 453 (fn j => fn () =>
adamc@866 454 box [string
adamc@866 455 "mysql_stmt_close(conn->p",
adamc@866 456 string (Int.toString j),
adamc@866 457 string ");",
adamc@866 458 newline])
adamc@866 459 (List.tabulate (i, fn _ => ())),
adamc@866 460 box (if this then
adamc@866 461 [string
adamc@866 462 "mysql_stmt_close(conn->p",
adamc@866 463 string (Int.toString i),
adamc@866 464 string ");",
adamc@866 465 newline]
adamc@866 466 else
adamc@866 467 []),
adamc@866 468 string "mysql_close(conn->conn);",
adamc@866 469 newline,
adamc@866 470 string "uw_error(ctx, FATAL, \"",
adamc@866 471 string s,
adamc@866 472 string "\"",
adamc@866 473 p_list_sep (box []) (fn s => box [string ", ",
adamc@866 474 string s]) args,
adamc@866 475 string ");",
adamc@866 476 newline]
adamc@866 477 in
adamc@866 478 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@866 479 newline,
adamc@866 480 string "if (stmt == NULL) {",
adamc@866 481 newline,
adamc@866 482 uhoh false "Out of memory allocating prepared statement" [],
adamc@866 483 string "}",
adamc@866 484 newline,
adamc@874 485 string "conn->p",
adamc@874 486 string (Int.toString i),
adamc@874 487 string " = stmt;",
adamc@874 488 newline,
adamc@866 489
adamc@866 490 string "if (mysql_stmt_prepare(stmt, \"",
adam@1656 491 string (Prim.toCString s),
adamc@866 492 string "\", ",
adamc@866 493 string (Int.toString (size s)),
adamc@866 494 string ")) {",
adamc@866 495 newline,
adamc@866 496 box [string "char msg[1024];",
adamc@866 497 newline,
adamc@866 498 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@866 499 newline,
adamc@866 500 string "msg[1023] = 0;",
adamc@866 501 newline,
adamc@866 502 uhoh true "Error preparing statement: %s" ["msg"]],
adamc@866 503 string "}",
adamc@866 504 newline]
adamc@866 505 end)
adamc@866 506 ss,
adamc@866 507
adamc@866 508 string "}"]
adamc@866 509 else
adamc@882 510 box [string "static void uw_db_prepare(uw_context ctx) { }",
adamc@882 511 newline,
adamc@882 512 string "static void uw_db_validate(uw_context ctx) { }"],
adamc@866 513 newline,
adamc@866 514 newline,
adam@1682 515
adamc@1094 516 string "static void uw_db_init(uw_context ctx) {",
adamc@866 517 newline,
adamc@866 518 string "MYSQL *mysql = mysql_init(NULL);",
adamc@866 519 newline,
adamc@866 520 string "uw_conn *conn;",
adamc@866 521 newline,
adamc@866 522 string "if (mysql == NULL) uw_error(ctx, FATAL, ",
adamc@866 523 string "\"libmysqlclient can't allocate a connection.\");",
adamc@866 524 newline,
adamc@866 525 string "if (mysql_real_connect(mysql, ",
adamc@866 526 stringOf host,
adamc@866 527 string ", ",
adamc@866 528 stringOf user,
adamc@866 529 string ", ",
adamc@866 530 stringOf passwd,
adamc@866 531 string ", ",
adamc@866 532 stringOf db,
adamc@866 533 string ", ",
adamc@866 534 case !port of
adamc@866 535 NONE => string "0"
adamc@866 536 | SOME n => string (Int.toString n),
adamc@866 537 string ", ",
adamc@866 538 stringOf unix_socket,
adam@1955 539 string ", CLIENT_MULTI_STATEMENTS) == NULL) {",
adamc@866 540 newline,
adamc@866 541 box [string "char msg[1024];",
adamc@866 542 newline,
adamc@866 543 string "strncpy(msg, mysql_error(mysql), 1024);",
adamc@866 544 newline,
adamc@866 545 string "msg[1023] = 0;",
adamc@866 546 newline,
adamc@866 547 string "mysql_close(mysql);",
adamc@866 548 newline,
adam@2176 549 string "uw_error(ctx, FATAL, ",
adamc@866 550 string "\"Connection to MySQL server failed: %s\", msg);"],
adamc@866 551 newline,
adamc@866 552 string "}",
adamc@866 553 newline,
adam@1957 554 newline,
adam@1957 555 string "if (mysql_set_character_set(mysql, \"utf8\")) {",
adam@1957 556 newline,
adam@1957 557 box [string "char msg[1024];",
adam@1957 558 newline,
adam@1957 559 string "strncpy(msg, mysql_error(mysql), 1024);",
adam@1957 560 newline,
adam@1957 561 string "msg[1023] = 0;",
adam@1957 562 newline,
adam@1957 563 string "mysql_close(mysql);",
adam@1957 564 newline,
adam@1957 565 string "uw_error(ctx, FATAL, ",
adam@1957 566 string "\"Error setting UTF-8 character set for MySQL connection: %s\", msg);"],
adam@1957 567 newline,
adam@1957 568 string "}",
adam@1957 569 newline,
adam@1957 570 newline,
adamc@874 571 string "conn = calloc(1, sizeof(uw_conn));",
adamc@866 572 newline,
adamc@866 573 string "conn->conn = mysql;",
adamc@866 574 newline,
adamc@866 575 string "uw_set_db(ctx, conn);",
adamc@866 576 newline,
adamc@866 577 string "uw_db_validate(ctx);",
adamc@866 578 newline,
adamc@866 579 string "uw_db_prepare(ctx);",
adamc@866 580 newline,
adamc@866 581 string "}",
adamc@866 582 newline,
adamc@866 583 newline,
adamc@866 584
adamc@1094 585 string "static void uw_db_close(uw_context ctx) {",
adamc@866 586 newline,
adamc@866 587 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 588 newline,
adamc@866 589 p_list_sepi (box [])
adamc@866 590 (fn i => fn _ =>
adamc@866 591 box [string "if (conn->p",
adamc@866 592 string (Int.toString i),
adamc@866 593 string ") mysql_stmt_close(conn->p",
adamc@866 594 string (Int.toString i),
adamc@866 595 string ");",
adamc@866 596 newline])
adamc@866 597 ss,
adamc@866 598 string "mysql_close(conn->conn);",
adamc@866 599 newline,
adamc@866 600 string "}",
adamc@866 601 newline,
adamc@866 602 newline,
adamc@866 603
adam@1936 604 string "static int uw_db_begin(uw_context ctx, int could_write) {",
adamc@866 605 newline,
adamc@866 606 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 607 newline,
adamc@866 608 newline,
adam@1955 609 string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE; BEGIN\") ? 1 : (mysql_next_result(conn->conn), 0);",
adamc@866 610 newline,
adamc@866 611 string "}",
adamc@866 612 newline,
adamc@866 613 newline,
adamc@866 614
adamc@1094 615 string "static int uw_db_commit(uw_context ctx) {",
adamc@866 616 newline,
adamc@866 617 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 618 newline,
adamc@866 619 string "return mysql_commit(conn->conn);",
adamc@866 620 newline,
adamc@866 621 string "}",
adamc@866 622 newline,
adamc@866 623 newline,
adamc@866 624
adamc@1094 625 string "static int uw_db_rollback(uw_context ctx) {",
adamc@866 626 newline,
adamc@866 627 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 628 newline,
adamc@866 629 string "return mysql_rollback(conn->conn);",
adamc@866 630 newline,
adamc@866 631 string "}",
adamc@866 632 newline,
adamc@866 633 newline]
adamc@866 634 end
adamc@866 635
adamc@880 636 fun p_getcol {loc, wontLeakStrings = _, col = i, typ = t} =
adamc@873 637 let
adamc@873 638 fun getter t =
adamc@873 639 case t of
adamc@873 640 String => box [string "({",
adamc@873 641 newline,
adamc@873 642 string "uw_Basis_string s = uw_malloc(ctx, length",
adamc@873 643 string (Int.toString i),
adamc@873 644 string " + 1);",
adamc@873 645 newline,
adamc@873 646 string "out[",
adamc@873 647 string (Int.toString i),
adamc@873 648 string "].buffer = s;",
adamc@873 649 newline,
adamc@873 650 string "out[",
adamc@873 651 string (Int.toString i),
adamc@873 652 string "].buffer_length = length",
adamc@873 653 string (Int.toString i),
adamc@873 654 string " + 1;",
adamc@873 655 newline,
adamc@873 656 string "mysql_stmt_fetch_column(stmt, &out[",
adamc@873 657 string (Int.toString i),
adamc@873 658 string "], ",
adamc@873 659 string (Int.toString i),
adamc@873 660 string ", 0);",
adamc@873 661 newline,
adamc@873 662 string "s[length",
adamc@873 663 string (Int.toString i),
adamc@873 664 string "] = 0;",
adamc@873 665 newline,
adamc@873 666 string "s;",
adamc@873 667 newline,
adamc@873 668 string "})"]
adamc@873 669 | Blob => box [string "({",
adamc@873 670 newline,
adamc@873 671 string "uw_Basis_blob b = {length",
adamc@873 672 string (Int.toString i),
adamc@873 673 string ", uw_malloc(ctx, length",
adamc@873 674 string (Int.toString i),
adamc@873 675 string ")};",
adamc@873 676 newline,
adamc@873 677 string "out[",
adamc@873 678 string (Int.toString i),
adamc@873 679 string "].buffer = b.data;",
adamc@873 680 newline,
adamc@873 681 string "out[",
adamc@873 682 string (Int.toString i),
adamc@873 683 string "].buffer_length = length",
adamc@873 684 string (Int.toString i),
adamc@873 685 string ";",
adamc@873 686 newline,
adamc@873 687 string "mysql_stmt_fetch_column(stmt, &out[",
adamc@873 688 string (Int.toString i),
adamc@873 689 string "], ",
adamc@873 690 string (Int.toString i),
adamc@873 691 string ", 0);",
adamc@873 692 newline,
adamc@873 693 string "b;",
adamc@873 694 newline,
adamc@873 695 string "})"]
adamc@873 696 | Time => box [string "({",
adamc@876 697 string "MYSQL_TIME *mt = &buffer",
adamc@873 698 string (Int.toString i),
adamc@873 699 string ";",
adamc@873 700 newline,
adamc@873 701 newline,
adamc@938 702 string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month-1, mt->year - 1900, 0, 0, -1};",
adamc@873 703 newline,
adam@1443 704 string "uw_Basis_time res = {mktime(&t), 0};",
adam@1443 705 newline,
adam@1443 706 string "res;",
adamc@873 707 newline,
adamc@873 708 string "})"]
adamc@889 709 | Channel => box [string "({",
adamc@889 710 string "uw_Basis_channel ch = {buffer",
adamc@889 711 string (Int.toString i),
adamc@889 712 string " >> 32, buffer",
adamc@889 713 string (Int.toString i),
adamc@889 714 string " & 0xFFFFFFFF};",
adamc@889 715 newline,
adamc@889 716 string "ch;",
adamc@889 717 newline,
adamc@889 718 string "})"]
adamc@873 719 | _ => box [string "buffer",
adamc@873 720 string (Int.toString i)]
adamc@873 721 in
adamc@873 722 case t of
adamc@873 723 Nullable t => box [string "(is_null",
adamc@873 724 string (Int.toString i),
adamc@873 725 string " ? NULL : ",
adamc@873 726 case t of
adamc@873 727 String => getter t
adamc@873 728 | _ => box [string "({",
adamc@873 729 newline,
adamc@873 730 string (p_sql_ctype t),
adamc@873 731 space,
adamc@873 732 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@873 733 string (p_sql_ctype t),
adamc@873 734 string "));",
adamc@873 735 newline,
adamc@873 736 string "*tmp = ",
adamc@873 737 getter t,
adamc@873 738 string ";",
adamc@873 739 newline,
adamc@873 740 string "tmp;",
adamc@873 741 newline,
adamc@873 742 string "})"],
adamc@873 743 string ")"]
adamc@873 744 | _ => box [string "(is_null",
adamc@873 745 string (Int.toString i),
adamc@873 746 string " ? ",
adamc@873 747 box [string "({",
adamc@873 748 string (p_sql_ctype t),
adamc@873 749 space,
adamc@873 750 string "tmp;",
adamc@873 751 newline,
adamc@873 752 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
adamc@873 753 string (Int.toString i),
adamc@873 754 string "\");",
adamc@873 755 newline,
adamc@873 756 string "tmp;",
adamc@873 757 newline,
adamc@873 758 string "})"],
adamc@873 759 string " : ",
adamc@873 760 getter t,
adamc@873 761 string ")"]
adamc@873 762 end
adamc@873 763
adamc@873 764 fun queryCommon {loc, query, cols, doCols} =
adamc@873 765 box [string "int n, r;",
adamc@873 766 newline,
adamc@873 767 string "MYSQL_BIND out[",
adamc@873 768 string (Int.toString (length cols)),
adamc@873 769 string "];",
adamc@873 770 newline,
adamc@873 771 p_list_sepi (box []) (fn i => fn t =>
adamc@873 772 let
adamc@873 773 fun buffers t =
adamc@873 774 case t of
adamc@873 775 String => box [string "unsigned long length",
adamc@873 776 string (Int.toString i),
adamc@873 777 string ";",
adamc@873 778 newline]
adamc@873 779 | Blob => box [string "unsigned long length",
adamc@873 780 string (Int.toString i),
adamc@873 781 string ";",
adamc@873 782 newline]
adamc@876 783 | Time => box [string "MYSQL_TIME buffer",
adamc@876 784 string (Int.toString i),
adamc@876 785 string ";",
adamc@876 786 newline]
adamc@889 787 | Channel => box [string "unsigned long long buffer",
adamc@889 788 string (Int.toString i),
adamc@889 789 string ";",
adamc@889 790 newline]
adamc@873 791 | _ => box [string (p_sql_ctype t),
adamc@873 792 space,
adamc@873 793 string "buffer",
adamc@873 794 string (Int.toString i),
adamc@873 795 string ";",
adamc@873 796 newline]
adamc@873 797 in
adamc@873 798 box [string "my_bool is_null",
adamc@873 799 string (Int.toString i),
adamc@873 800 string ";",
adamc@873 801 newline,
adamc@873 802 case t of
adamc@873 803 Nullable t => buffers t
adamc@873 804 | _ => buffers t,
adamc@873 805 newline]
adamc@873 806 end) cols,
adamc@873 807 newline,
adamc@873 808
adamc@873 809 string "memset(out, 0, sizeof out);",
adamc@873 810 newline,
adamc@873 811 p_list_sepi (box []) (fn i => fn t =>
adamc@873 812 let
adamc@873 813 fun buffers t =
adamc@873 814 case t of
adamc@875 815 String => box [string "out[",
adamc@875 816 string (Int.toString i),
adamc@875 817 string "].length = &length",
adamc@875 818 string (Int.toString i),
adamc@875 819 string ";",
adamc@875 820 newline]
adamc@1013 821 | Char => box [string "out[",
adamc@1013 822 string (Int.toString i),
adamc@1013 823 string "].buffer_length = 1;",
adamc@1013 824 newline,
adamc@1013 825 string "out[",
adamc@1013 826 string (Int.toString i),
adamc@1013 827 string "].buffer = &buffer",
adamc@1013 828 string (Int.toString i),
adamc@1013 829 string ";",
adamc@1013 830 newline]
adamc@875 831 | Blob => box [string "out[",
adamc@875 832 string (Int.toString i),
adamc@875 833 string "].length = &length",
adamc@875 834 string (Int.toString i),
adamc@875 835 string ";",
adamc@875 836 newline]
adamc@873 837 | _ => box [string "out[",
adamc@873 838 string (Int.toString i),
adamc@873 839 string "].buffer = &buffer",
adamc@873 840 string (Int.toString i),
adamc@873 841 string ";",
adamc@873 842 newline]
adamc@873 843 in
adamc@873 844 box [string "out[",
adamc@873 845 string (Int.toString i),
adamc@873 846 string "].buffer_type = ",
adamc@873 847 string (p_buffer_type t),
adamc@873 848 string ";",
adamc@873 849 newline,
adamc@873 850 string "out[",
adamc@873 851 string (Int.toString i),
adamc@873 852 string "].is_null = &is_null",
adamc@873 853 string (Int.toString i),
adamc@873 854 string ";",
adamc@873 855 newline,
adam@1682 856
adamc@873 857 case t of
adamc@873 858 Nullable t => buffers t
adamc@873 859 | _ => buffers t,
adamc@873 860 newline]
adamc@873 861 end) cols,
adamc@873 862 newline,
adamc@873 863
adam@2178 864 string "if (mysql_stmt_reset(stmt)) {",
adam@2178 865 box [newline,
adam@2178 866 string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);",
adam@2178 867 newline,
adam@2178 868 string "uw_error(ctx, FATAL, \"",
adam@2178 869 string (ErrorMsg.spanToString loc),
adam@2178 870 string ": Error reseting statement: %s\\n%s\", ",
adam@2178 871 query,
adam@2178 872 string ", mysql_error(conn->conn));",
adam@2178 873 newline],
adam@2178 874 string "}",
adamc@875 875 newline,
adamc@875 876 newline,
adamc@875 877
adam@1954 878 string "if (mysql_stmt_execute(stmt)) {",
adam@1954 879 newline,
adam@1954 880 box [string "if (mysql_errno(conn->conn) == 1213)",
adam@1954 881 newline,
adam@1954 882 box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1954 883 newline],
adam@1954 884 newline,
adam@1954 885 string "uw_error(ctx, FATAL, \"",
adam@1954 886 string (ErrorMsg.spanToString loc),
adam@1954 887 string ": Error executing query: %s\\n%s\", ",
adam@1954 888 query,
adam@1954 889 string ", mysql_error(conn->conn));",
adam@1954 890 newline],
adam@1954 891 string "}",
adamc@875 892 newline,
adamc@875 893 newline,
adamc@875 894
adamc@875 895 string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
adamc@875 896 string (ErrorMsg.spanToString loc),
adamc@875 897 string ": Error binding query result: %s\\n%s\", ",
adamc@875 898 query,
adamc@875 899 string ", mysql_error(conn->conn));",
adamc@873 900 newline,
adamc@873 901 newline,
adamc@873 902
adamc@873 903 string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"",
adamc@873 904 string (ErrorMsg.spanToString loc),
adamc@875 905 string ": Error storing query result: %s\\n%s\", ",
adamc@875 906 query,
adamc@875 907 string ", mysql_error(conn->conn));",
adamc@873 908 newline,
adamc@873 909 newline,
adamc@873 910
adamc@873 911 string "uw_end_region(ctx);",
adamc@873 912 newline,
adamc@875 913 string "while (1) {",
adamc@875 914 newline,
adamc@875 915 string "r = mysql_stmt_fetch(stmt);",
adamc@875 916 newline,
adamc@875 917 string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;",
adamc@873 918 newline,
adamc@873 919 doCols p_getcol,
adamc@873 920 string "}",
adamc@873 921 newline,
adamc@873 922 newline,
adamc@873 923
adamc@874 924 string "if (r == 1) uw_error(ctx, FATAL, \"",
adamc@873 925 string (ErrorMsg.spanToString loc),
adamc@875 926 string ": query result fetching failed: %s\\n%s\", ",
adamc@875 927 query,
adamc@875 928 string ", mysql_error(conn->conn));",
adamc@875 929 newline,
adamc@875 930 newline,
adamc@875 931
adamc@875 932 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
adamc@875 933 string (ErrorMsg.spanToString loc),
adamc@875 934 string ": Error reseting statement: %s\\n%s\", ",
adamc@875 935 query,
adamc@875 936 string ", mysql_error(conn->conn));",
adamc@875 937 newline,
adamc@875 938 newline]
adamc@873 939
adamc@873 940 fun query {loc, cols, doCols} =
adamc@873 941 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 942 newline,
adamc@876 943 string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
adamc@873 944 newline,
adamc@875 945 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
adamc@873 946 string (ErrorMsg.spanToString loc),
adamc@873 947 string ": can't allocate temporary prepared statement\");",
adamc@873 948 newline,
adamc@873 949 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@873 950 newline,
adamc@873 951 string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"",
adamc@873 952 string (ErrorMsg.spanToString loc),
adamc@875 953 string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));",
adamc@873 954 newline,
adamc@873 955 newline,
adamc@873 956
adamc@873 957 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
adamc@873 958
adamc@873 959 string "uw_pop_cleanup(ctx);",
adamc@873 960 newline]
adamc@873 961
adamc@879 962 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
adamc@873 963 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 964 newline,
adamc@873 965 string "MYSQL_BIND in[",
adamc@873 966 string (Int.toString (length inputs)),
adamc@873 967 string "];",
adamc@873 968 newline,
adamc@873 969 p_list_sepi (box []) (fn i => fn t =>
adamc@873 970 let
adamc@873 971 fun buffers t =
adamc@873 972 case t of
adamc@873 973 String => box [string "unsigned long in_length",
adamc@873 974 string (Int.toString i),
adamc@873 975 string ";",
adamc@873 976 newline]
adamc@873 977 | Blob => box [string "unsigned long in_length",
adamc@873 978 string (Int.toString i),
adamc@873 979 string ";",
adamc@873 980 newline]
adamc@876 981 | Time => box [string "MYSQL_TIME in_buffer",
adamc@873 982 string (Int.toString i),
adamc@1013 983 string ";",
adamc@1013 984 newline]
adamc@873 985 | _ => box []
adamc@873 986 in
adamc@873 987 box [case t of
adamc@873 988 Nullable t => box [string "my_bool in_is_null",
adamc@873 989 string (Int.toString i),
adamc@873 990 string ";",
adamc@873 991 newline,
adamc@873 992 buffers t]
adamc@873 993 | _ => buffers t,
adamc@873 994 newline]
adamc@873 995 end) inputs,
adamc@873 996
adamc@879 997 if nested then
adamc@879 998 box [string "MYSQL_STMT *stmt;",
adamc@879 999 newline]
adamc@879 1000 else
adamc@879 1001 box [string "MYSQL_STMT *stmt = conn->p",
adamc@879 1002 string (Int.toString id),
adamc@879 1003 string ";",
adamc@879 1004 newline,
adamc@879 1005 newline,
adamc@879 1006
adamc@879 1007 string "if (stmt == NULL) {",
adamc@879 1008 newline],
adamc@879 1009
adamc@878 1010 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@878 1011 newline,
adamc@878 1012 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
adamc@878 1013 newline,
adamc@880 1014 if nested then
adamc@880 1015 box [string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@880 1016 newline]
adamc@880 1017 else
adamc@880 1018 box [],
adamc@878 1019 string "if (mysql_stmt_prepare(stmt, \"",
adam@1656 1020 string (Prim.toCString query),
adamc@878 1021 string "\", ",
adamc@878 1022 string (Int.toString (size query)),
adamc@878 1023 string ")) {",
adamc@878 1024 newline,
adamc@878 1025 box [string "char msg[1024];",
adamc@878 1026 newline,
adamc@878 1027 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@878 1028 newline,
adamc@878 1029 string "msg[1023] = 0;",
adamc@878 1030 newline,
adamc@880 1031 if nested then
adamc@880 1032 box []
adamc@880 1033 else
adamc@880 1034 box [string "mysql_stmt_close(stmt);",
adamc@880 1035 newline],
adamc@878 1036 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
adamc@878 1037 newline],
adamc@878 1038 string "}",
adamc@878 1039 newline,
adamc@879 1040 if nested then
adamc@879 1041 box []
adamc@879 1042 else
adamc@879 1043 box [string "conn->p",
adamc@879 1044 string (Int.toString id),
adamc@879 1045 string " = stmt;",
adamc@879 1046 newline]],
adamc@879 1047 if nested then
adamc@879 1048 box []
adamc@879 1049 else
adamc@879 1050 box [string "}",
adamc@879 1051 newline],
adamc@878 1052 newline,
adamc@878 1053
adamc@873 1054 string "memset(in, 0, sizeof in);",
adamc@873 1055 newline,
adamc@873 1056 p_list_sepi (box []) (fn i => fn t =>
adamc@873 1057 let
adamc@873 1058 fun buffers t =
adamc@873 1059 case t of
adamc@873 1060 String => box [string "in[",
adamc@873 1061 string (Int.toString i),
adamc@873 1062 string "].buffer = arg",
adamc@873 1063 string (Int.toString (i + 1)),
adamc@873 1064 string ";",
adamc@873 1065 newline,
adamc@873 1066 string "in_length",
adamc@873 1067 string (Int.toString i),
adamc@873 1068 string "= in[",
adamc@873 1069 string (Int.toString i),
adamc@873 1070 string "].buffer_length = strlen(arg",
adamc@873 1071 string (Int.toString (i + 1)),
adamc@873 1072 string ");",
adamc@873 1073 newline,
adamc@873 1074 string "in[",
adamc@873 1075 string (Int.toString i),
adamc@873 1076 string "].length = &in_length",
adamc@873 1077 string (Int.toString i),
adamc@873 1078 string ";",
adamc@873 1079 newline]
adamc@1013 1080 | Char => box [string "in[",
adamc@1013 1081 string (Int.toString i),
adamc@1013 1082 string "].buffer = &arg",
adamc@1013 1083 string (Int.toString (i + 1)),
adamc@1013 1084 string ";",
adamc@1013 1085 newline,
adamc@1013 1086 string "in[",
adamc@1013 1087 string (Int.toString i),
adamc@1013 1088 string "].buffer_length = 1;",
adamc@1013 1089 newline]
adamc@873 1090 | Blob => box [string "in[",
adamc@873 1091 string (Int.toString i),
adamc@873 1092 string "].buffer = arg",
adamc@873 1093 string (Int.toString (i + 1)),
adamc@873 1094 string ".data;",
adamc@873 1095 newline,
adamc@873 1096 string "in_length",
adamc@873 1097 string (Int.toString i),
adamc@873 1098 string "= in[",
adamc@873 1099 string (Int.toString i),
adamc@873 1100 string "].buffer_length = arg",
adamc@873 1101 string (Int.toString (i + 1)),
adamc@873 1102 string ".size;",
adamc@873 1103 newline,
adamc@873 1104 string "in[",
adamc@873 1105 string (Int.toString i),
adamc@873 1106 string "].length = &in_length",
adamc@873 1107 string (Int.toString i),
adamc@873 1108 string ";",
adamc@873 1109 newline]
adamc@873 1110 | Time =>
adamc@873 1111 let
adamc@873 1112 fun oneField dst src =
adamc@873 1113 box [string "in_buffer",
adamc@873 1114 string (Int.toString i),
adamc@873 1115 string ".",
adamc@873 1116 string dst,
adamc@873 1117 string " = tms.tm_",
adamc@873 1118 string src,
adamc@873 1119 string ";",
adamc@873 1120 newline]
adamc@873 1121 in
adamc@873 1122 box [string "({",
adamc@873 1123 newline,
adamc@873 1124 string "struct tm tms;",
adamc@873 1125 newline,
adamc@873 1126 string "if (localtime_r(&arg",
adamc@873 1127 string (Int.toString (i + 1)),
adam@1443 1128 string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"",
adamc@873 1129 string (ErrorMsg.spanToString loc),
adamc@873 1130 string ": error converting to MySQL time\");",
adamc@873 1131 newline,
adamc@938 1132 oneField "year" "year + 1900",
adamc@888 1133 box [string "in_buffer",
adamc@888 1134 string (Int.toString i),
adamc@888 1135 string ".month = tms.tm_mon + 1;",
adamc@888 1136 newline],
adamc@873 1137 oneField "day" "mday",
adam@1839 1138 oneField "hour" "hour",
adamc@873 1139 oneField "minute" "min",
adamc@873 1140 oneField "second" "sec",
adamc@873 1141 newline,
adamc@873 1142 string "in[",
adamc@873 1143 string (Int.toString i),
adamc@873 1144 string "].buffer = &in_buffer",
adamc@873 1145 string (Int.toString i),
adamc@873 1146 string ";",
adamc@933 1147 newline,
adamc@933 1148 string "});",
adamc@873 1149 newline]
adamc@873 1150 end
adamc@889 1151 | Channel => box [string "in_buffer",
adamc@889 1152 string (Int.toString i),
adamc@889 1153 string " = ((unsigned long long)arg",
adamc@889 1154 string (Int.toString (i + 1)),
adamc@889 1155 string ".cli << 32) | arg",
adamc@889 1156 string (Int.toString (i + 1)),
adamc@889 1157 string ".chn;",
adamc@889 1158 newline,
adamc@889 1159 string "in[",
adamc@889 1160 string (Int.toString i),
adamc@889 1161 string "].buffer = &in_buffer",
adamc@889 1162 string (Int.toString i),
adamc@889 1163 string ";",
adamc@889 1164 newline]
adam@1682 1165
adamc@873 1166 | _ => box [string "in[",
adamc@873 1167 string (Int.toString i),
adamc@873 1168 string "].buffer = &arg",
adamc@873 1169 string (Int.toString (i + 1)),
adamc@873 1170 string ";",
adamc@873 1171 newline]
adamc@873 1172 in
adamc@873 1173 box [string "in[",
adamc@873 1174 string (Int.toString i),
adamc@873 1175 string "].buffer_type = ",
adamc@873 1176 string (p_buffer_type t),
adamc@873 1177 string ";",
adamc@873 1178 newline,
adam@1682 1179
adamc@873 1180 case t of
adamc@873 1181 Nullable t => box [string "in[",
adamc@873 1182 string (Int.toString i),
adamc@873 1183 string "].is_null = &in_is_null",
adamc@873 1184 string (Int.toString i),
adamc@873 1185 string ";",
adamc@873 1186 newline,
adamc@873 1187 string "if (arg",
adamc@873 1188 string (Int.toString (i + 1)),
adamc@873 1189 string " == NULL) {",
adamc@873 1190 newline,
adamc@873 1191 box [string "in_is_null",
adamc@873 1192 string (Int.toString i),
adamc@873 1193 string " = 1;",
adamc@873 1194 newline],
adamc@873 1195 string "} else {",
adamc@873 1196 box [case t of
adamc@873 1197 String => box []
adamc@873 1198 | _ =>
adamc@873 1199 box [string (p_sql_ctype t),
adamc@873 1200 space,
adamc@876 1201 string "tmp = *arg",
adamc@876 1202 string (Int.toString (i + 1)),
adamc@876 1203 string ";",
adamc@876 1204 newline,
adamc@876 1205 string (p_sql_ctype t),
adamc@876 1206 space,
adamc@873 1207 string "arg",
adamc@873 1208 string (Int.toString (i + 1)),
adamc@876 1209 string " = tmp;",
adamc@873 1210 newline],
adamc@873 1211 string "in_is_null",
adamc@873 1212 string (Int.toString i),
adamc@873 1213 string " = 0;",
adamc@873 1214 newline,
adamc@873 1215 buffers t,
adamc@876 1216 newline],
adamc@876 1217 string "}",
adamc@876 1218 newline]
adam@1682 1219
adamc@873 1220 | _ => buffers t,
adamc@873 1221 newline]
adamc@873 1222 end) inputs,
adamc@873 1223 newline,
adamc@873 1224
adamc@875 1225 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
adamc@875 1226 string (ErrorMsg.spanToString loc),
adamc@875 1227 string ": error binding parameters\");",
adamc@875 1228 newline,
adamc@875 1229
adamc@873 1230 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656 1231 string (Prim.toCString query),
adamc@879 1232 string "\""]},
adamc@879 1233
adamc@879 1234 if nested then
adamc@879 1235 box [string "uw_pop_cleanup(ctx);",
adamc@879 1236 newline]
adamc@879 1237 else
adamc@879 1238 box []]
adamc@873 1239
adam@1293 1240 fun dmlCommon {loc, dml, mode} =
adam@1953 1241 box [string "if (mysql_stmt_execute(stmt)) {",
adam@2178 1242 box [string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);",
adam@2178 1243 newline,
adam@2178 1244 string "if (mysql_errno(conn->conn) == 1213)",
adam@1953 1245 newline,
adam@1953 1246 box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1953 1247 newline],
adam@1953 1248 newline,
adam@1953 1249 case mode of
adam@1953 1250 Settings.Error => box [string "uw_error(ctx, FATAL, \"",
adam@1953 1251 string (ErrorMsg.spanToString loc),
adam@1953 1252 string ": Error executing DML: %s\\n%s\", ",
adam@1953 1253 dml,
adam@1953 1254 string ", mysql_error(conn->conn));"]
adam@1953 1255 | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));",
adam@1953 1256 newline],
adam@1953 1257 string "}",
adamc@875 1258 newline]
adamc@875 1259
adam@1293 1260 fun dml (loc, mode) =
adamc@875 1261 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@875 1262 newline,
adamc@1013 1263 string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
adamc@875 1264 newline,
adamc@933 1265 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
adamc@875 1266 string (ErrorMsg.spanToString loc),
adamc@875 1267 string ": can't allocate temporary prepared statement\");",
adamc@875 1268 newline,
adamc@875 1269 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@875 1270 newline,
adamc@875 1271 string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
adamc@875 1272 string (ErrorMsg.spanToString loc),
adamc@875 1273 string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
adamc@875 1274 newline,
adamc@875 1275 newline,
adamc@875 1276
adam@1293 1277 dmlCommon {loc = loc, dml = string "dml", mode = mode},
adamc@875 1278
adamc@875 1279 string "uw_pop_cleanup(ctx);",
adamc@875 1280 newline]
adamc@875 1281
adam@1293 1282 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@875 1283 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@875 1284 newline,
adamc@875 1285 string "MYSQL_BIND in[",
adamc@875 1286 string (Int.toString (length inputs)),
adamc@875 1287 string "];",
adamc@875 1288 newline,
adamc@875 1289 p_list_sepi (box []) (fn i => fn t =>
adamc@875 1290 let
adamc@875 1291 fun buffers t =
adamc@875 1292 case t of
adamc@875 1293 String => box [string "unsigned long in_length",
adamc@875 1294 string (Int.toString i),
adamc@875 1295 string ";",
adamc@875 1296 newline]
adamc@875 1297 | Blob => box [string "unsigned long in_length",
adamc@875 1298 string (Int.toString i),
adamc@875 1299 string ";",
adamc@875 1300 newline]
adamc@876 1301 | Time => box [string "MYSQL_TIME in_buffer",
adamc@875 1302 string (Int.toString i),
adamc@875 1303 string ";",
adamc@875 1304 newline]
adamc@889 1305 | Channel => box [string "unsigned long long in_buffer",
adamc@889 1306 string (Int.toString i),
adamc@889 1307 string ";",
adamc@889 1308 newline]
adamc@875 1309 | _ => box []
adamc@875 1310 in
adamc@875 1311 box [case t of
adamc@875 1312 Nullable t => box [string "my_bool in_is_null",
adamc@875 1313 string (Int.toString i),
adamc@875 1314 string ";",
adamc@875 1315 newline,
adamc@875 1316 buffers t]
adamc@875 1317 | _ => buffers t,
adamc@875 1318 newline]
adamc@875 1319 end) inputs,
adamc@875 1320 string "MYSQL_STMT *stmt = conn->p",
adamc@875 1321 string (Int.toString id),
adamc@875 1322 string ";",
adamc@875 1323 newline,
adamc@875 1324 newline,
adamc@875 1325
adamc@878 1326 string "if (stmt == NULL) {",
adamc@878 1327 newline,
adamc@878 1328 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@878 1329 newline,
adamc@878 1330 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
adamc@878 1331 newline,
adamc@878 1332 string "if (mysql_stmt_prepare(stmt, \"",
adam@1656 1333 string (Prim.toCString dml),
adamc@878 1334 string "\", ",
adamc@878 1335 string (Int.toString (size dml)),
adamc@878 1336 string ")) {",
adamc@878 1337 newline,
adamc@878 1338 box [string "char msg[1024];",
adamc@878 1339 newline,
adamc@878 1340 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@878 1341 newline,
adamc@878 1342 string "msg[1023] = 0;",
adamc@878 1343 newline,
adamc@878 1344 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
adamc@878 1345 newline],
adamc@878 1346 string "}",
adamc@878 1347 newline,
adamc@878 1348 string "conn->p",
adamc@878 1349 string (Int.toString id),
adamc@878 1350 string " = stmt;",
adamc@878 1351 newline],
adamc@878 1352 string "}",
adamc@878 1353 newline,
adamc@878 1354 newline,
adamc@878 1355
adamc@875 1356 string "memset(in, 0, sizeof in);",
adamc@875 1357 newline,
adamc@875 1358 p_list_sepi (box []) (fn i => fn t =>
adamc@875 1359 let
adamc@875 1360 fun buffers t =
adamc@875 1361 case t of
adamc@875 1362 String => box [string "in[",
adamc@875 1363 string (Int.toString i),
adamc@875 1364 string "].buffer = arg",
adamc@875 1365 string (Int.toString (i + 1)),
adamc@875 1366 string ";",
adamc@875 1367 newline,
adamc@875 1368 string "in_length",
adamc@875 1369 string (Int.toString i),
adamc@875 1370 string "= in[",
adamc@875 1371 string (Int.toString i),
adamc@875 1372 string "].buffer_length = strlen(arg",
adamc@875 1373 string (Int.toString (i + 1)),
adamc@875 1374 string ");",
adamc@875 1375 newline,
adamc@875 1376 string "in[",
adamc@875 1377 string (Int.toString i),
adamc@875 1378 string "].length = &in_length",
adamc@875 1379 string (Int.toString i),
adamc@875 1380 string ";",
adamc@875 1381 newline]
adamc@875 1382 | Blob => box [string "in[",
adamc@875 1383 string (Int.toString i),
adamc@875 1384 string "].buffer = arg",
adamc@875 1385 string (Int.toString (i + 1)),
adamc@875 1386 string ".data;",
adamc@875 1387 newline,
adamc@875 1388 string "in_length",
adamc@875 1389 string (Int.toString i),
adamc@875 1390 string "= in[",
adamc@875 1391 string (Int.toString i),
adamc@875 1392 string "].buffer_length = arg",
adamc@875 1393 string (Int.toString (i + 1)),
adamc@875 1394 string ".size;",
adamc@875 1395 newline,
adamc@875 1396 string "in[",
adamc@875 1397 string (Int.toString i),
adamc@875 1398 string "].length = &in_length",
adamc@875 1399 string (Int.toString i),
adamc@875 1400 string ";",
adamc@875 1401 newline]
adamc@875 1402 | Time =>
adamc@875 1403 let
adamc@875 1404 fun oneField dst src =
adamc@875 1405 box [string "in_buffer",
adamc@875 1406 string (Int.toString i),
adamc@875 1407 string ".",
adamc@875 1408 string dst,
adamc@875 1409 string " = tms.tm_",
adamc@875 1410 string src,
adamc@875 1411 string ";",
adamc@875 1412 newline]
adamc@875 1413 in
adamc@875 1414 box [string "({",
adamc@875 1415 newline,
adamc@875 1416 string "struct tm tms;",
adamc@875 1417 newline,
adamc@875 1418 string "if (localtime_r(&arg",
adamc@875 1419 string (Int.toString (i + 1)),
adam@1443 1420 string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"",
adamc@875 1421 string (ErrorMsg.spanToString loc),
adamc@875 1422 string ": error converting to MySQL time\");",
adamc@875 1423 newline,
adamc@938 1424 oneField "year" "year + 1900",
adamc@938 1425 oneField "month" "mon + 1",
adamc@875 1426 oneField "day" "mday",
adam@1839 1427 oneField "hour" "hour",
adamc@875 1428 oneField "minute" "min",
adamc@875 1429 oneField "second" "sec",
adamc@875 1430 newline,
adamc@875 1431 string "in[",
adamc@875 1432 string (Int.toString i),
adamc@875 1433 string "].buffer = &in_buffer",
adamc@875 1434 string (Int.toString i),
adamc@875 1435 string ";",
adamc@933 1436 newline,
adamc@933 1437 string "});",
adamc@875 1438 newline]
adamc@875 1439 end
adamc@889 1440 | Channel => box [string "in_buffer",
adamc@889 1441 string (Int.toString i),
adamc@889 1442 string " = ((unsigned long long)arg",
adamc@889 1443 string (Int.toString (i + 1)),
adamc@889 1444 string ".cli << 32) | arg",
adamc@889 1445 string (Int.toString (i + 1)),
adamc@889 1446 string ".chn;",
adamc@889 1447 newline,
adamc@889 1448 string "in[",
adamc@889 1449 string (Int.toString i),
adamc@889 1450 string "].buffer = &in_buffer",
adamc@889 1451 string (Int.toString i),
adamc@889 1452 string ";",
adamc@889 1453 newline]
adam@1682 1454
adamc@875 1455 | _ => box [string "in[",
adamc@875 1456 string (Int.toString i),
adamc@875 1457 string "].buffer = &arg",
adamc@875 1458 string (Int.toString (i + 1)),
adamc@875 1459 string ";",
adamc@875 1460 newline]
adamc@875 1461 in
adamc@875 1462 box [string "in[",
adamc@875 1463 string (Int.toString i),
adamc@875 1464 string "].buffer_type = ",
adamc@875 1465 string (p_buffer_type t),
adamc@875 1466 string ";",
adamc@875 1467 newline,
adamc@889 1468
adamc@889 1469 case t of
adamc@889 1470 Channel => box [string "in[",
adamc@889 1471 string (Int.toString i),
adamc@889 1472 string "].is_unsigned = 1;",
adamc@889 1473 newline]
adamc@889 1474 | _ => box [],
adam@1682 1475
adamc@875 1476 case t of
adamc@875 1477 Nullable t => box [string "in[",
adamc@875 1478 string (Int.toString i),
adamc@875 1479 string "].is_null = &in_is_null",
adamc@875 1480 string (Int.toString i),
adamc@875 1481 string ";",
adamc@875 1482 newline,
adamc@875 1483 string "if (arg",
adamc@875 1484 string (Int.toString (i + 1)),
adamc@875 1485 string " == NULL) {",
adamc@875 1486 newline,
adamc@875 1487 box [string "in_is_null",
adamc@875 1488 string (Int.toString i),
adamc@875 1489 string " = 1;",
adamc@875 1490 newline],
adamc@875 1491 string "} else {",
adamc@875 1492 box [case t of
adamc@875 1493 String => box []
adamc@875 1494 | _ =>
adamc@875 1495 box [string (p_sql_ctype t),
adamc@875 1496 space,
adamc@876 1497 string "tmp = *arg",
adamc@876 1498 string (Int.toString (i + 1)),
adamc@876 1499 string ";",
adamc@876 1500 newline,
adamc@876 1501 string (p_sql_ctype t),
adamc@876 1502 space,
adamc@875 1503 string "arg",
adamc@875 1504 string (Int.toString (i + 1)),
adamc@876 1505 string " = tmp;",
adamc@875 1506 newline],
adamc@875 1507 string "in_is_null",
adamc@875 1508 string (Int.toString i),
adamc@875 1509 string " = 0;",
adamc@875 1510 newline,
adamc@875 1511 buffers t,
adamc@876 1512 newline],
adamc@876 1513 string "}",
adamc@876 1514 newline]
adam@1682 1515
adamc@875 1516 | _ => buffers t,
adamc@875 1517 newline]
adamc@875 1518 end) inputs,
adamc@875 1519 newline,
adamc@875 1520
adamc@875 1521 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
adamc@875 1522 string (ErrorMsg.spanToString loc),
adamc@875 1523 string ": error binding parameters\");",
adamc@875 1524 newline,
adamc@875 1525
adamc@875 1526 dmlCommon {loc = loc, dml = box [string "\"",
adam@1656 1527 string (Prim.toCString dml),
adam@1293 1528 string "\""], mode = mode}]
adamc@875 1529
adamc@878 1530 fun nextval {loc, seqE, seqName} =
adamc@878 1531 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@878 1532 newline,
adamc@878 1533 string "char *insert = ",
adamc@878 1534 case seqName of
adamc@878 1535 SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"")
adamc@878 1536 | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
adamc@878 1537 seqE,
adamc@878 1538 string ", \" VALUES ()\"))"],
adamc@878 1539 string ";",
adamc@878 1540 newline,
adamc@878 1541 string "char *delete = ",
adamc@878 1542 case seqName of
adamc@878 1543 SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
adamc@878 1544 | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
adamc@878 1545 seqE,
adamc@878 1546 string ")"],
adamc@878 1547 string ";",
adamc@878 1548 newline,
adamc@878 1549 newline,
adamc@878 1550
adam@2178 1551 string "if (mysql_query(conn->conn, insert)) {",
adam@2178 1552 box [newline,
adam@2178 1553 string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);",
adam@2178 1554 newline,
adam@2178 1555 string "uw_error(ctx, FATAL, \"'nextval' INSERT failed\");",
adam@2178 1556 newline],
adam@2178 1557 string "}",
adamc@878 1558 newline,
adamc@878 1559 string "n = mysql_insert_id(conn->conn);",
adamc@878 1560 newline,
adamc@878 1561 string "if (mysql_query(conn->conn, delete)) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");",
adamc@878 1562 newline]
adamc@878 1563
adamc@878 1564 fun nextvalPrepared _ = raise Fail "MySQL.nextvalPrepared called"
adamc@867 1565
adamc@1073 1566 fun setval _ = raise Fail "MySQL.setval called"
adamc@1073 1567
adamc@877 1568 fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'"
adamc@877 1569 | #"\\" => "\\\\"
adamc@877 1570 | ch =>
adamc@877 1571 if Char.isPrint ch then
adamc@877 1572 str ch
adamc@877 1573 else
adamc@877 1574 (ErrorMsg.error
adamc@877 1575 "Non-printing character found in SQL string literal";
adamc@877 1576 ""))
adam@1656 1577 (Prim.toCString s) ^ "'"
adamc@874 1578
adamc@877 1579 fun p_cast (s, _) = s
adamc@874 1580
adamc@874 1581 fun p_blank _ = "?"
adamc@874 1582
adamc@866 1583 val () = addDbms {name = "mysql",
adam@1464 1584 header = Config.msheader,
adam@1682 1585 randomFunction = "RAND",
adamc@866 1586 link = "-lmysqlclient",
adamc@867 1587 init = init,
adamc@873 1588 p_sql_type = p_sql_type,
adamc@867 1589 query = query,
adamc@868 1590 queryPrepared = queryPrepared,
adamc@868 1591 dml = dml,
adamc@869 1592 dmlPrepared = dmlPrepared,
adamc@869 1593 nextval = nextval,
adamc@874 1594 nextvalPrepared = nextvalPrepared,
adamc@1073 1595 setval = setval,
adamc@874 1596 sqlifyString = sqlifyString,
adamc@874 1597 p_cast = p_cast,
adamc@874 1598 p_blank = p_blank,
adamc@877 1599 supportsDeleteAs = false,
adamc@886 1600 supportsUpdateAs = false,
adamc@884 1601 createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)",
adamc@878 1602 textKeysNeedLengths = true,
adamc@879 1603 supportsNextval = false,
adamc@882 1604 supportsNestedPrepared = false,
adamc@890 1605 sqlPrefix = "SET storage_engine=InnoDB;\n\n",
adamc@1014 1606 supportsOctetLength = true,
adamc@1014 1607 trueString = "TRUE",
adamc@1196 1608 falseString = "FALSE",
adamc@1196 1609 onlyUnion = true,
adam@1777 1610 nestedRelops = false,
adam@1777 1611 windowFunctions = false}
adamc@866 1612
adamc@866 1613 end