From 21d921a56a850857f6ea883c6dff6a411a659bbf Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 22 Dec 2006 04:35:56 +0000 Subject: [PATCH] Password prompts for MySQL adduser --- src/client.sig | 29 +++++++++++++++++ src/client.sml | 67 +++++++++++++++++++++++++++++++++++++++ src/dbms.sig | 3 +- src/dbms.sml | 3 +- src/main-dbtool.sml | 17 ++++++++-- src/main.sig | 2 +- src/main.sml | 4 +-- src/msg.sml | 25 +++++++++++++-- src/msgTypes.sml | 2 +- src/plugins/domtool-mysql | 2 +- src/plugins/mysql.sml | 25 +++++++++++---- src/plugins/postgres.sml | 5 +-- src/sources | 3 ++ 13 files changed, 167 insertions(+), 20 deletions(-) create mode 100644 src/client.sig create mode 100644 src/client.sml diff --git a/src/client.sig b/src/client.sig new file mode 100644 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 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 --- a/src/dbms.sig +++ b/src/dbms.sig @@ -22,7 +22,8 @@ signature DBMS = sig 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 diff --git a/src/dbms.sml b/src/dbms.sml index caf504a..a1f44d7 100644 --- a/src/dbms.sml +++ b/src/dbms.sml @@ -24,7 +24,8 @@ open DataStructures 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 diff --git a/src/main-dbtool.sml b/src/main-dbtool.sml index 73a02a2..32793d7 100644 --- 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") - | _ => + | SOME {getpass, ...} => 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} diff --git a/src/main.sig b/src/main.sig index 7e2746a..6960cf4 100644 --- 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 requestDbUser : string -> unit + val requestDbUser : {dbtype : string, passwd : string option} -> unit val requestDbTable : {dbtype : string, dbname : string} -> unit end diff --git a/src/main.sml b/src/main.sml index 5f2038d..ec98e4e 100644 --- a/src/main.sml +++ b/src/main.sml @@ -715,7 +715,7 @@ fun service () = 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); @@ -725,7 +725,7 @@ fun service () = 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 => diff --git a/src/msg.sml b/src/msg.sml index 23e8ac2..53dfbfa 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -61,6 +61,21 @@ fun recvList f bio = 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) @@ -98,8 +113,9 @@ fun send (bio, m) = | 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)) @@ -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) - | 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}) diff --git a/src/msgTypes.sml b/src/msgTypes.sml index adf1bba..5758d80 100644 --- 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. *) - | 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 *) diff --git a/src/plugins/domtool-mysql b/src/plugins/domtool-mysql index 9d02fc4..8f60e5e 100755 --- a/src/plugins/domtool-mysql +++ b/src/plugins/domtool-mysql @@ -2,7 +2,7 @@ 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." diff --git a/src/plugins/mysql.sml b/src/plugins/mysql.sml index a273875..7da242b 100644 --- a/src/plugins/mysql.sml +++ b/src/plugins/mysql.sml @@ -20,11 +20,23 @@ 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 @@ -32,7 +44,8 @@ fun createdb {user, dbname} = 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 diff --git a/src/plugins/postgres.sml b/src/plugins/postgres.sml index 87ba252..c2539eb 100644 --- a/src/plugins/postgres.sml +++ b/src/plugins/postgres.sml @@ -20,7 +20,7 @@ structure Postgres :> POSTGRES = struct -fun adduser user = +fun adduser {user, passwd} = 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" -val _ = Dbms.register ("postgres", {adduser = adduser, +val _ = Dbms.register ("postgres", {getpass = NONE, + adduser = adduser, createdb = createdb}) end diff --git a/src/sources b/src/sources index 44126a3..4578e59 100644 --- a/src/sources +++ b/src/sources @@ -46,6 +46,9 @@ defaults.sml openssl.sig openssl.sml +client.sig +client.sml + dbms.sig dbms.sml -- 2.20.1