diff options
-rw-r--r-- | src/cjr_print.sml | 10 | ||||
-rw-r--r-- | src/jscomp.sml | 2 | ||||
-rw-r--r-- | src/mysql.sml | 14 | ||||
-rw-r--r-- | src/postgres.sml | 20 | ||||
-rw-r--r-- | src/prim.sig | 3 | ||||
-rw-r--r-- | src/prim.sml | 16 | ||||
-rw-r--r-- | src/sources | 6 | ||||
-rw-r--r-- | src/sqlite.sml | 18 |
8 files changed, 52 insertions, 37 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 8bb2f64d..851fa02d 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2388,7 +2388,7 @@ fun p_decl env (dAll as (d, _) : decl) = | DPreparedStatements _ => box [] | DJavaScript s => box [string "static char jslib[] = \"", - string (String.toCString s), + string (Prim.toCString s), string "\";"] | DCookie s => box [string "/*", space, @@ -2863,7 +2863,7 @@ fun p_file env (ds, ps) = prefix ^ s in box [string "if (!strncmp(request, \"", - string (String.toCString s), + string (Prim.toCString s), string "\", ", string (Int.toString (size s)), string ") && (request[", @@ -3090,10 +3090,10 @@ fun p_file env (ds, ps) = box [string "if (!str", case #kind rule of Settings.Exact => box [string "cmp(s, \"", - string (String.toCString (#pattern rule)), + string (Prim.toCString (#pattern rule)), string "\"))"] | Settings.Prefix => box [string "ncmp(s, \"", - string (String.toCString (#pattern rule)), + string (Prim.toCString (#pattern rule)), string "\", ", string (Int.toString (size (#pattern rule))), string "))"], @@ -3402,7 +3402,7 @@ fun p_file env (ds, ps) = "uw_handle", "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics", - "\"" ^ String.toCString (Settings.getTimeFormat ()) ^ "\""], + "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\""], string "};", newline] end diff --git a/src/jscomp.sml b/src/jscomp.sml index 7a5bf85d..57f59b12 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -1324,7 +1324,7 @@ fun process file = val script = if !foundJavaScript then lines ^ urlRules ^ String.concat (rev (#script st)) - ^ "\ntime_format = \"" ^ String.toCString (Settings.getTimeFormat ()) ^ "\";\n" + ^ "\ntime_format = \"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\";\n" else "" in diff --git a/src/mysql.sml b/src/mysql.sml index 0715d253..686f430f 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -346,7 +346,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = fun stringOf r = case !r of NONE => string "NULL" | SOME s => box [string "\"", - string (String.toCString s), + string (Prim.toCString s), string "\""] in app (fn s => @@ -479,7 +479,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, string "if (mysql_stmt_prepare(stmt, \"", - string (String.toCString s), + string (Prim.toCString s), string "\", ", string (Int.toString (size s)), string ")) {", @@ -978,7 +978,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} = else box [], string "if (mysql_stmt_prepare(stmt, \"", - string (String.toCString query), + string (Prim.toCString query), string "\", ", string (Int.toString (size query)), string ")) {", @@ -1189,7 +1189,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} = newline, queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", - string (String.toCString query), + string (Prim.toCString query), string "\""]}, if nested then @@ -1283,7 +1283,7 @@ fun dmlPrepared {loc, id, dml, inputs, mode} = string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");", newline, string "if (mysql_stmt_prepare(stmt, \"", - string (String.toCString dml), + string (Prim.toCString dml), string "\", ", string (Int.toString (size dml)), string ")) {", @@ -1477,7 +1477,7 @@ fun dmlPrepared {loc, id, dml, inputs, mode} = newline, dmlCommon {loc = loc, dml = box [string "\"", - string (String.toCString dml), + string (Prim.toCString dml), string "\""], mode = mode}] fun nextval {loc, seqE, seqName} = @@ -1521,7 +1521,7 @@ fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'" (ErrorMsg.error "Non-printing character found in SQL string literal"; "")) - (String.toCString s) ^ "'" + (Prim.toCString s) ^ "'" fun p_cast (s, _) = s diff --git a/src/postgres.sml b/src/postgres.sml index c180e38f..3a2fd40d 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -337,7 +337,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = box [string "res = PQprepare(conn, \"uw", string (Int.toString i), string "\", \"", - string (String.toCString s), + string (Prim.toCString s), string "\", ", string (Int.toString n), string ", NULL);", @@ -355,7 +355,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = string "PQfinish(conn);", newline, string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n", - string (String.toCString s), + string (Prim.toCString s), string "\\n%s\", msg);", newline], string "}", @@ -481,7 +481,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = string "char *env_db_str = getenv(\"URWEB_PQ_CON\");", newline, string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"", - string (String.toCString dbstring), + string (Prim.toCString dbstring), string "\" : env_db_str);", newline, string "if (conn == NULL) uw_error(ctx, FATAL, ", @@ -732,14 +732,14 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = string ", paramValues, paramLengths, paramFormats, 0);"] else box [string "PQexecParams(conn, \"", - string (String.toCString query), + string (Prim.toCString query), string "\", ", string (Int.toString (length inputs)), string ", NULL, paramValues, paramLengths, paramFormats, 0);"], newline, newline, queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", - string (String.toCString query), + string (Prim.toCString query), string "\""]}] fun dmlCommon {loc, dml, mode} = @@ -888,14 +888,14 @@ fun dmlPrepared {loc, id, dml, inputs, mode} = string ", paramValues, paramLengths, paramFormats, 0);"] else box [string "PQexecParams(conn, \"", - string (String.toCString dml), + string (Prim.toCString dml), string "\", ", string (Int.toString (length inputs)), string ", NULL, paramValues, paramLengths, paramFormats, 0);"], newline, newline, dmlCommon {loc = loc, dml = box [string "\"", - string (String.toCString dml), + string (Prim.toCString dml), string "\""], mode = mode}] fun nextvalCommon {loc, query} = @@ -972,12 +972,12 @@ fun nextvalPrepared {loc, id, query} = string "\", 0, NULL, NULL, NULL, 0);"] else box [string "PQexecParams(conn, \"", - string (String.toCString query), + string (Prim.toCString query), string "\", 0, NULL, NULL, NULL, NULL, 0);"], newline, newline, nextvalCommon {loc = loc, query = box [string "\"", - string (String.toCString query), + string (Prim.toCString query), string "\""]}] fun setvalCommon {loc, query} = @@ -1030,7 +1030,7 @@ fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" else "\\" ^ StringCvt.padLeft #"0" 3 (Int.fmt StringCvt.OCT (ord ch))) - (String.toCString s) ^ "'::text" + (Prim.toCString s) ^ "'::text" fun p_cast (s, t) = s ^ "::" ^ p_sql_type t diff --git a/src/prim.sig b/src/prim.sig index fb067b3a..74147471 100644 --- a/src/prim.sig +++ b/src/prim.sig @@ -41,4 +41,7 @@ signature PRIM = sig val toString : t -> string + val toCString : string -> string + (* SML's built-in [String.toCString] gets confused by single quotes! *) + end diff --git a/src/prim.sml b/src/prim.sml index 96880487..94801e7f 100644 --- a/src/prim.sml +++ b/src/prim.sml @@ -70,12 +70,24 @@ fun pad (n, ch, s) = else str ch ^ pad (n-1, ch, s) +fun quoteDouble ch = + case ch of + #"'" => str ch + | _ => Char.toCString ch + +fun toCChar ch = + case ch of + #"\"" => str ch + | _ => Char.toCString ch + +val toCString = String.translate quoteDouble + fun p_t_GCC t = case t of Int n => string (int2s n) | Float n => string (float2s n) - | String s => box [string "\"", string (String.toCString s), string "\""] - | Char ch => box [string "'", string (Char.toCString ch), string "'"] + | String s => box [string "\"", string (toCString s), string "\""] + | Char ch => box [string "'", string (toCChar ch), string "'"] fun equal x = case x of diff --git a/src/sources b/src/sources index 5d1f099d..aebe9de6 100644 --- a/src/sources +++ b/src/sources @@ -31,15 +31,15 @@ fastcgi.sml static.sig static.sml +prim.sig +prim.sml + mysql.sig mysql.sml sqlite.sig sqlite.sml -prim.sig -prim.sml - datatype_kind.sml export.sig diff --git a/src/sqlite.sml b/src/sqlite.sml index d6f5ffec..1dc0b754 100644 --- a/src/sqlite.sml +++ b/src/sqlite.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2009-2010, Adam Chlipala + (* Copyright (c) 2009-2010, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -230,7 +230,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline] in box [string "if (sqlite3_prepare_v2(conn->conn, \"", - string (String.toCString s), + string (Prim.toCString s), string "\", -1, &conn->p", string (Int.toString i), string ", NULL) != SQLITE_OK) {", @@ -242,7 +242,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = string "msg[1023] = 0;", newline, uhoh false ("Error preparing statement: " - ^ String.toCString s ^ "<br />%s") ["msg"]], + ^ Prim.toCString s ^ "<br />%s") ["msg"]], string "}", newline] end) @@ -659,9 +659,9 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} = newline], string "if (sqlite3_prepare_v2(conn->conn, \"", - string (String.toCString query), + string (Prim.toCString query), string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ", - string (String.toCString query), + string (Prim.toCString query), string "<br />%s\", sqlite3_errmsg(conn->conn));", newline, if nested then @@ -685,7 +685,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} = newline, queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", - string (String.toCString query), + string (Prim.toCString query), string "\""]}, string "uw_pop_cleanup(ctx);", @@ -750,9 +750,9 @@ fun dmlPrepared {loc, id, dml, inputs, mode = mode} = string "if (stmt == NULL) {", newline, box [string "if (sqlite3_prepare_v2(conn->conn, \"", - string (String.toCString dml), + string (Prim.toCString dml), string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ", - string (String.toCString dml), + string (Prim.toCString dml), string "<br />%s\", sqlite3_errmsg(conn->conn));", newline, string "conn->p", @@ -771,7 +771,7 @@ fun dmlPrepared {loc, id, dml, inputs, mode = mode} = newline, dmlCommon {loc = loc, dml = box [string "\"", - string (String.toCString dml), + string (Prim.toCString dml), string "\""], mode = mode}, string "uw_pop_cleanup(ctx);", |