Specifying encoding on database creation

diff --git a/src/dbms.sig b/src/dbms.sig
index ab6772e..f49ec04 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 (file)
--- 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 (file)
--- 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)