From fe789bea628b15229156c8a4272c2b6063c9b1a0 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 9 Apr 2008 14:23:57 +0000 Subject: [PATCH] Specifying encoding on database creation --- src/dbms.sig | 3 ++- src/dbms.sml | 6 +++++- src/main-dbtool.sml | 9 ++++++++- src/main.sig | 2 +- src/main.sml | 16 ++++++++++------ src/msg.sml | 13 +++++++------ src/msgTypes.sml | 2 +- src/plugins/domtool-postgres | 7 ++++++- src/plugins/mysql.sml | 9 ++++++--- src/plugins/postgres.sml | 6 ++++-- 10 files changed, 50 insertions(+), 23 deletions(-) diff --git a/src/dbms.sig b/src/dbms.sig index ab6772e..f49ec04 100644 --- a/src/dbms.sig +++ b/src/dbms.sig @@ -21,11 +21,12 @@ signature DBMS = sig val validDbname : string -> bool + val validEncoding : string option -> bool type handler = {getpass : (unit -> Client.passwd_result) option, adduser : {user : string, passwd : string option} -> string option, passwd : {user : string, passwd : string} -> string option, - createdb : {user : string, dbname : string} -> string option, + createdb : {user : string, dbname : string, encoding : string option} -> string option, dropdb : {user : string, dbname : string} -> string option, grant : {user : string, dbname : string} -> string option} diff --git a/src/dbms.sml b/src/dbms.sml index 8c34f8b..71fb664 100644 --- a/src/dbms.sml +++ b/src/dbms.sml @@ -23,11 +23,15 @@ structure Dbms :> DBMS = struct open DataStructures val validDbname = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") +fun validEncoding encoding = + case encoding of + NONE => true + | SOME e => size e > 0 andalso size e < 20 andalso CharVector.all Char.isAlphaNum e type handler = {getpass : (unit -> Client.passwd_result) option, adduser : {user : string, passwd : string option} -> string option, passwd : {user : string, passwd : string} -> string option, - createdb : {user : string, dbname : string} -> string option, + createdb : {user : string, dbname : string, encoding : string option} -> string option, dropdb : {user : string, dbname : string} -> string option, grant : {user : string, dbname : string} -> string option} diff --git a/src/main-dbtool.sml b/src/main-dbtool.sml index d9765a9..d45d15e 100644 --- a/src/main-dbtool.sml +++ b/src/main-dbtool.sml @@ -58,9 +58,16 @@ val _ = end | ["createdb", dbname] => if Dbms.validDbname dbname then - Main.requestDbTable {dbtype = dbtype, dbname = dbname} + Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = NONE} else print ("Invalid database name " ^ dbname ^ ".\n") + | ["createdb", dbname, encoding] => + if not (Dbms.validDbname dbname) then + print ("Invalid database name " ^ dbname ^ ".\n") + else if not (Dbms.validEncoding (SOME encoding)) then + print ("Invalid encoding name " ^ encoding ^ ".\n") + else + Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = SOME encoding} | ["dropdb", dbname] => if Dbms.validDbname dbname then Main.requestDbDrop {dbtype = dbtype, dbname = dbname} diff --git a/src/main.sig b/src/main.sig index 01edb0f..231fafc 100644 --- a/src/main.sig +++ b/src/main.sig @@ -58,7 +58,7 @@ signature MAIN = sig val requestDbUser : {dbtype : string, passwd : string option} -> unit val requestDbPasswd : {dbtype : string, passwd : string} -> unit - val requestDbTable : {dbtype : string, dbname : string} -> unit + val requestDbTable : {dbtype : string, dbname : string, encoding : string option} -> unit val requestDbDrop : {dbtype : string, dbname : string} -> unit val requestDbGrant : {dbtype : string, dbname : string} -> unit diff --git a/src/main.sml b/src/main.sml index 9530bcd..67e8dc0 100644 --- a/src/main.sml +++ b/src/main.sml @@ -1365,18 +1365,22 @@ fun service () = SOME ("Error adding user: " ^ msg))) (fn () => ()) - | MsgCreateDb {dbtype, dbname} => + | MsgCreateDb {dbtype, dbname, encoding} => doIt (fn () => if Dbms.validDbname dbname then case Dbms.lookup dbtype of NONE => ("Database creation request with unknown datatype type " ^ dbtype, SOME ("Unknown database type " ^ dbtype)) | SOME handler => - case #createdb handler {user = user, dbname = dbname} of - NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".", - NONE) - | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, - SOME ("Error creating database: " ^ msg)) + if not (Dbms.validEncoding encoding) then + ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.", + SOME "Invalid encoding") + else + case #createdb handler {user = user, dbname = dbname, encoding = encoding} of + NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".", + NONE) + | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg, + SOME ("Error creating database: " ^ msg)) else ("Invalid database name " ^ user ^ "_" ^ dbname, SOME ("Invalid database name " ^ dbname))) diff --git a/src/msg.sml b/src/msg.sml index a8450dd..5eacaa2 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -173,9 +173,10 @@ fun send (bio, m) = | MsgCreateDbUser {dbtype, passwd} => (OpenSSL.writeInt (bio, 16); OpenSSL.writeString (bio, dbtype); sendOption OpenSSL.writeString (bio, passwd)) - | MsgCreateDb {dbtype, dbname} => (OpenSSL.writeInt (bio, 17); - OpenSSL.writeString (bio, dbtype); - OpenSSL.writeString (bio, dbname)) + | MsgCreateDb {dbtype, dbname, encoding} => (OpenSSL.writeInt (bio, 17); + OpenSSL.writeString (bio, dbtype); + OpenSSL.writeString (bio, dbname); + sendOption OpenSSL.writeString (bio, encoding)) | MsgNewMailbox {domain, user, passwd, mailbox} => (OpenSSL.writeInt (bio, 18); OpenSSL.writeString (bio, domain); @@ -289,9 +290,9 @@ fun recv bio = (SOME dbtype, SOME passwd) => SOME (MsgCreateDbUser {dbtype = dbtype, passwd = passwd}) | _ => NONE) - | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of - (SOME dbtype, SOME dbname) => - SOME (MsgCreateDb {dbtype = dbtype, dbname = dbname}) + | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio, recvOption OpenSSL.readString bio) of + (SOME dbtype, SOME dbname, SOME encoding) => + SOME (MsgCreateDb {dbtype = dbtype, dbname = dbname, encoding = encoding}) | _ => NONE) | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 034e26a..1fd2411 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -76,7 +76,7 @@ datatype msg = * that user and no one else has rights. *) | MsgCreateDbUser of {dbtype : string, passwd : string option} (* Request creation of a user for the named DBMS type *) - | MsgCreateDb of {dbtype : string, dbname : string} + | MsgCreateDb of {dbtype : string, dbname : string, encoding : string option} (* Request creation of a DBMS database *) | MsgDropDb of {dbtype : string, dbname : string} (* Request dropping of a DBMS database *) diff --git a/src/plugins/domtool-postgres b/src/plugins/domtool-postgres index fed7bbe..214e9ac 100755 --- a/src/plugins/domtool-postgres +++ b/src/plugins/domtool-postgres @@ -11,9 +11,14 @@ case $1 in createdb) USERNAME=$2 DBNAME_BASE=$3 + ENCODING=$4 DBNAME="${USERNAME}_${DBNAME_BASE}" - sudo -u postgres createdb -O $USERNAME -D user_$USERNAME $DBNAME + if [ -n $ENCODING ]; then + ENCODING="-E $ENCODING" + fi + + sudo -u postgres createdb -O $USERNAME -D user_$USERNAME $ENCODING $DBNAME ;; dropdb) diff --git a/src/plugins/mysql.sml b/src/plugins/mysql.sml index 3cfa94f..a10fbbc 100644 --- a/src/plugins/mysql.sml +++ b/src/plugins/mysql.sml @@ -43,9 +43,12 @@ fun passwd {user, passwd} = else SOME "Password contains characters besides letters, digits, and !.-_" -fun createdb {user, dbname} = - Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) - (Slave.shellOutput [Config.MySQL.createdb, user, " ", dbname]) +fun createdb {user, dbname, encoding} = + case encoding of + SOME _ => SOME "MySQL doesn't support specifying encodings" + | NONE => + Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) + (Slave.shellOutput [Config.MySQL.createdb, user, " ", dbname]) fun dropdb {user, dbname} = Option.map (fn s => "Error executing DROP DATABASE script:\n" ^ s) diff --git a/src/plugins/postgres.sml b/src/plugins/postgres.sml index f80fcea..6465377 100644 --- a/src/plugins/postgres.sml +++ b/src/plugins/postgres.sml @@ -26,9 +26,11 @@ fun adduser {user, passwd} = fun passwd _ = SOME "We don't use PostgreSQL passwords." -fun createdb {user, dbname} = +fun createdb {user, dbname, encoding} = Option.map (fn s => "Error executing CREATE DATABASE script:\n" ^ s) - (Slave.shellOutput [Config.Postgres.createdb, user, " ", dbname]) + (Slave.shellOutput [Config.Postgres.createdb, + " ", user, " ", dbname, + case encoding of NONE => "" | SOME e => " " ^ e]) fun dropdb {user, dbname} = Option.map (fn s => "Error executing DROP DATABASE script:\n" ^ s) -- 2.20.1