Password prompts for MySQL adduser
[hcoop/domtool2.git] / src / main-dbtool.sml
index 73a02a2..32793d7 100644 (file)
@@ -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}