Password prompts for MySQL adduser

diff --git a/src/client.sig b/src/client.sig
new file mode 100644 (file)
index 0000000..8cf8cd4
--- /dev/null
+++ b/src/client.sig
@@ -0,0 +1,29 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* Code for receiving and executing configuration files *)
+
+signature CLIENT = sig
+    datatype passwd_result =
+            Passwd of string
+          | Aborted
+          | Error
+
+    val getpass : unit -> passwd_result
+    (* Standard non-echoed console password input with confirmation *)
+end

diff --git a/src/client.sml b/src/client.sml
new file mode 100644 (file)
index 0000000..863c0c0
--- /dev/null
+++ b/src/client.sml
@@ -0,0 +1,67 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* Code for receiving and executing configuration files *)
+
+structure Client :> CLIENT = struct
+
+datatype passwd_result =
+        Passwd of string
+       | Aborted
+       | Error
+
+fun getpass () =
+    let
+       val tty = Posix.FileSys.stdin
+       val termios = Posix.TTY.TC.getattr tty
+       val fields = Posix.TTY.fieldsOf termios
+
+       val termios' = Posix.TTY.termios {iflag = #iflag fields,
+                                         oflag = #oflag fields,
+                                         cflag = #cflag fields,
+                                         lflag = Posix.TTY.L.flags [Posix.TTY.L.clear (Posix.TTY.L.echo, #lflag fields),
+                                                                    Posix.TTY.L.echonl,
+                                                                    Posix.TTY.L.icanon],
+                                         cc = #cc fields,
+                                         ispeed = #ispeed fields,
+                                         ospeed = #ospeed fields}
+
+       fun reset () = Posix.TTY.TC.setattr (tty, Posix.TTY.TC.sanow, termios)
+    in
+       print "        Password: ";
+       TextIO.flushOut TextIO.stdOut;
+       Posix.TTY.TC.setattr (tty, Posix.TTY.TC.sanow, termios');
+       case TextIO.inputLine TextIO.stdIn of
+           NONE => (reset ();
+                    Aborted)
+         | SOME pass =>
+           (print "Confirm password: ";
+            TextIO.flushOut TextIO.stdOut;
+            case TextIO.inputLine TextIO.stdIn of
+                NONE => (reset ();
+                         Aborted)
+              | SOME pass' =>
+                (reset ();
+                 if pass = pass' then
+                     Passwd (String.substring (pass, 0, size pass - 1))
+                 else
+                     (print "Passwords don't match!\n";
+                      Error)))
+    end
+
+end

diff --git a/src/dbms.sig b/src/dbms.sig
index b2a74c0..1107c5e 100644 (file)
--- a/src/dbms.sig
+++ b/src/dbms.sig
@@ -22,7 +22,8 @@ signature DBMS = sig
 
     val validDbname : string -> bool
 
 
     val validDbname : string -> bool
 

-    type handler = {adduser : string -> string option,
+    type handler = {getpass : (unit -> Client.passwd_result) option,
+                   adduser : {user : string, passwd : string option} -> string option,

                    createdb : {user : string, dbname : string} -> string option}
 
     val register : string * handler -> unit
                    createdb : {user : string, dbname : string} -> string option}
 
     val register : string * handler -> unit

diff --git a/src/dbms.sml b/src/dbms.sml
index caf504a..a1f44d7 100644 (file)
--- a/src/dbms.sml
+++ b/src/dbms.sml
@@ -24,7 +24,8 @@ open DataStructures
 
 val validDbname = CharVector.all Char.isAlpha
 
 
 val validDbname = CharVector.all Char.isAlpha
 

-type handler = {adduser : string -> string option,
+type handler = {getpass : (unit -> Client.passwd_result) option,
+               adduser : {user : string, passwd : string option} -> string option,

                createdb : {user : string, dbname : string} -> string option}
               
 val dbmses : handler StringMap.map ref = ref StringMap.empty
                createdb : {user : string, dbname : string} -> string option}
               
 val dbmses : handler StringMap.map ref = ref StringMap.empty

diff --git a/src/main-dbtool.sml b/src/main-dbtool.sml
index 73a02a2..32793d7 100644 (file)
--- a/src/main-dbtool.sml
+++ b/src/main-dbtool.sml
@@ -24,9 +24,22 @@ val _ =
       | dbtype :: rest =>
        case Dbms.lookup dbtype of
            NONE => print ("Unknown database type " ^ dbtype ^ ".\n")
       | dbtype :: rest =>
        case Dbms.lookup dbtype of
            NONE => print ("Unknown database type " ^ dbtype ^ ".\n")

-         | _ =>
+         | SOME {getpass, ...} =>

            case rest of
            case rest of

-               ["adduser"] => Main.requestDbUser dbtype
+               ["adduser"] =>
+               let
+                   val pass = case getpass of
+                                  NONE => SOME NONE
+                                | SOME f =>
+                                  case f () of
+                                      Client.Passwd pass => SOME (SOME pass)
+                                    | Client.Aborted => SOME NONE
+                                    | Client.Error => NONE
+               in
+                   case pass of
+                       NONE => ()
+                     | SOME pass => Main.requestDbUser {dbtype = dbtype, passwd = pass}
+               end

              | ["createdb", dbname] =>
                if Dbms.validDbname dbname then
                    Main.requestDbTable {dbtype = dbtype, dbname = dbname}
              | ["createdb", dbname] =>
                if Dbms.validDbname dbname then
                    Main.requestDbTable {dbtype = dbtype, dbname = dbname}

diff --git a/src/main.sig b/src/main.sig
index 7e2746a..6960cf4 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -48,7 +48,7 @@ signature MAIN = sig
     val listBasis : unit -> string list
     val autodocBasis : string -> unit
 
     val listBasis : unit -> string list
     val autodocBasis : string -> unit
 

-    val requestDbUser : string -> unit
+    val requestDbUser : {dbtype : string, passwd : string option} -> unit

     val requestDbTable : {dbtype : string, dbname : string} -> unit
 
 end
     val requestDbTable : {dbtype : string, dbname : string} -> unit
 
 end

diff --git a/src/main.sml b/src/main.sml
index 5f2038d..ec98e4e 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -715,7 +715,7 @@ fun service () =
                                     handle OpenSSL.OpenSSL _ => ();
                                     loop ())
 
                                     handle OpenSSL.OpenSSL _ => ();
                                     loop ())
 

-                             | MsgCreateDbUser dbtype =>
+                             | MsgCreateDbUser {dbtype, passwd} =>

                                (case Dbms.lookup dbtype of
                                     NONE => ((Msg.send (bio, MsgError ("Unknown database type " ^ dbtype));
                                               print ("Database user creation request with unknown datatype type " ^ dbtype);
                                (case Dbms.lookup dbtype of
                                     NONE => ((Msg.send (bio, MsgError ("Unknown database type " ^ dbtype));
                                               print ("Database user creation request with unknown datatype type " ^ dbtype);


@@ -725,7 +725,7 @@ fun service () =
                                              handle OpenSSL.OpenSSL _ => ();
                                              loop ())
                                   | SOME handler =>
                                              handle OpenSSL.OpenSSL _ => ();
                                              loop ())
                                   | SOME handler =>

-                                    case #adduser handler user of
+                                    case #adduser handler {user = user, passwd = passwd} of

                                         NONE => ((Msg.send (bio, MsgOk);
                                                   print ("Added " ^ dbtype ^ " user " ^ user ^ ".\n"))
                                                  handle OpenSSL.OpenSSL s =>
                                         NONE => ((Msg.send (bio, MsgOk);
                                                   print ("Added " ^ dbtype ^ " user " ^ user ^ ".\n"))
                                                  handle OpenSSL.OpenSSL s =>

diff --git a/src/msg.sml b/src/msg.sml
index 23e8ac2..53dfbfa 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -61,6 +61,21 @@ fun recvList f bio =
        loop []
     end
 
        loop []
     end
 

+fun sendOption f (bio, opt) =
+    case opt of
+       NONE => OpenSSL.writeInt (bio, 0)
+      | SOME x => (OpenSSL.writeInt (bio, 1);
+                  f (bio, x))
+
+fun recvOption f bio =
+    case OpenSSL.readInt bio of
+       SOME 0 => SOME NONE
+      | SOME 1 =>
+       (case f bio of
+            SOME x => SOME (SOME x)
+          | NONE => NONE)
+      | _ => NONE
+

 fun send (bio, m) =
     case m of
        MsgOk => OpenSSL.writeInt (bio, 1)
 fun send (bio, m) =
     case m of
        MsgOk => OpenSSL.writeInt (bio, 1)


@@ -98,8 +113,9 @@ fun send (bio, m) =
       | MsgRegenerate => OpenSSL.writeInt (bio, 14)
       | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
                          OpenSSL.writeString (bio, dom))
       | MsgRegenerate => OpenSSL.writeInt (bio, 14)
       | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
                          OpenSSL.writeString (bio, dom))

-      | MsgCreateDbUser s => (OpenSSL.writeInt (bio, 16);
-                             OpenSSL.writeString (bio, s))
+      | MsgCreateDbUser {dbtype, passwd} => (OpenSSL.writeInt (bio, 16);
+                                            OpenSSL.writeString (bio, dbtype);
+                                            sendOption OpenSSL.writeString (bio, passwd))

       | MsgCreateDbTable {dbtype, dbname} => (OpenSSL.writeInt (bio, 17);
                                              OpenSSL.writeString (bio, dbtype);
                                              OpenSSL.writeString (bio, dbname))
       | MsgCreateDbTable {dbtype, dbname} => (OpenSSL.writeInt (bio, 17);
                                              OpenSSL.writeString (bio, dbtype);
                                              OpenSSL.writeString (bio, dbname))


@@ -153,7 +169,10 @@ fun recv bio =
                   | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio)
                   | 14 => SOME MsgRegenerate
                   | 15 => Option.map MsgRmuser (OpenSSL.readString bio)
                   | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio)
                   | 14 => SOME MsgRegenerate
                   | 15 => Option.map MsgRmuser (OpenSSL.readString bio)

-                  | 16 => Option.map MsgCreateDbUser (OpenSSL.readString bio)
+                  | 16 => (case (OpenSSL.readString bio, recvOption OpenSSL.readString bio) of
+                               (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 (MsgCreateDbTable {dbtype = dbtype, dbname = dbname})
                   | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
                                (SOME dbtype, SOME dbname) =>
                                SOME (MsgCreateDbTable {dbtype = dbtype, dbname = dbname})

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index adf1bba..5758d80 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -54,7 +54,7 @@ datatype msg =
        | MsgRmuser of string
        (* Remove all ACL entries for a user, and remove all domains to which
        * that user and no one else has rights. *)
        | MsgRmuser of string
        (* Remove all ACL entries for a user, and remove all domains to which
        * that user and no one else has rights. *)

-       | MsgCreateDbUser of string
+       | MsgCreateDbUser of {dbtype : string, passwd : string option}

        (* Request creation of a user for the named DBMS type *)
        | MsgCreateDbTable of {dbtype : string, dbname : string}
        (* Request creation of a DBMS table *)
        (* Request creation of a user for the named DBMS type *)
        | MsgCreateDbTable of {dbtype : string, dbname : string}
        (* Request creation of a DBMS table *)

diff --git a/src/plugins/domtool-mysql b/src/plugins/domtool-mysql
index 9d02fc4..8f60e5e 100755 (executable)
--- a/src/plugins/domtool-mysql
+++ b/src/plugins/domtool-mysql
@@ -2,7 +2,7 @@
 
 case $1 in
        adduser)
 
 case $1 in
        adduser)

-               echo "I would create MySQL user $2."
+               echo "I would create MySQL user $2 with password $3."

        ;;
        createdb)
                echo "I would create MySQL table $2_$3 for user $2."
        ;;
        createdb)
                echo "I would create MySQL table $2_$3 for user $2."

diff --git a/src/plugins/mysql.sml b/src/plugins/mysql.sml
index a273875..7da242b 100644 (file)
--- a/src/plugins/mysql.sml
+++ b/src/plugins/mysql.sml
@@ -20,11 +20,23 @@
 
 structure MySQL :> MYSQL = struct
 
 
 structure MySQL :> MYSQL = struct
 

-fun adduser user =
-    if Slave.shell [Config.MySQL.adduser, user] then
-       NONE
-    else
-       SOME "Error executing CREATE USER script"
+val validPasswd = CharVector.all (fn ch => Char.isAlphaNum ch
+                                          orelse ch = #"!"
+                                          orelse ch = #"."
+                                          orelse ch = #"-"
+                                          orelse ch = #"_")
+
+fun adduser {user, passwd} =
+    case passwd of
+       NONE => SOME "No password given"
+      | SOME passwd =>
+       if validPasswd passwd then
+           if Slave.shell [Config.MySQL.adduser, user, " ", passwd] then
+               NONE
+           else
+               SOME "Error executing CREATE USER script"
+       else
+           SOME "Password contains characters besides letters, digits, and !.-_"

 
 fun createdb {user, dbname} =
     if Slave.shell [Config.MySQL.createdb, user, " ", dbname] then
 
 fun createdb {user, dbname} =
     if Slave.shell [Config.MySQL.createdb, user, " ", dbname] then


@@ -32,7 +44,8 @@ fun createdb {user, dbname} =
     else
        SOME "Error executing CREATE DATABASE script"
 
     else
        SOME "Error executing CREATE DATABASE script"
 

-val _ = Dbms.register ("mysql", {adduser = adduser,
+val _ = Dbms.register ("mysql", {getpass = SOME Client.getpass,
+                                adduser = adduser,

                                 createdb = createdb})
 
 end
                                 createdb = createdb})
 
 end

diff --git a/src/plugins/postgres.sml b/src/plugins/postgres.sml
index 87ba252..c2539eb 100644 (file)
--- a/src/plugins/postgres.sml
+++ b/src/plugins/postgres.sml
@@ -20,7 +20,7 @@
 
 structure Postgres :> POSTGRES = struct
 
 
 structure Postgres :> POSTGRES = struct
 

-fun adduser user =
+fun adduser {user, passwd} =

     if Slave.shell [Config.Postgres.adduser, user] then
        NONE
     else
     if Slave.shell [Config.Postgres.adduser, user] then
        NONE
     else


@@ -32,7 +32,8 @@ fun createdb {user, dbname} =
     else
        SOME "Error executing CREATE DATABASE script"
 
     else
        SOME "Error executing CREATE DATABASE script"
 

-val _ = Dbms.register ("postgres", {adduser = adduser,
+val _ = Dbms.register ("postgres", {getpass = NONE,
+                                   adduser = adduser,

                                    createdb = createdb})
 
 end
                                    createdb = createdb})
 
 end

diff --git a/src/sources b/src/sources
index 44126a3..4578e59 100644 (file)
--- a/src/sources
+++ b/src/sources
@@ -46,6 +46,9 @@ defaults.sml
 openssl.sig
 openssl.sml
 
 openssl.sig
 openssl.sml
 

+client.sig
+client.sml
+

 dbms.sig
 dbms.sml
 
 dbms.sig
 dbms.sml