X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/90dd48df1de3ea116fe2f2c0ec0fe36c71e17e5c..fe789bea628b15229156c8a4272c2b6063c9b1a0:/src/main-dbtool.sml

diff --git a/src/main-dbtool.sml b/src/main-dbtool.sml
index 73a02a2..d45d15e 100644
--- a/src/main-dbtool.sml
+++ b/src/main-dbtool.sml
@@ -18,18 +18,64 @@
 
 (* Driver for dbtool *)
 
+fun badArgs () =
+    print "Invalid command-line arguments.  See documentation at:\n\thttp://wiki.hcoop.net/MemberManual/Databases\n"
+
 val _ =
     case CommandLine.arguments () of
-	[] => print "Invalid command-line arguments\n"
+	[] => badArgs ()
       | 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
+	      | ["passwd"] =>
+		let
+		    val pass = case getpass of
+				   NONE => NONE
+				 | SOME f =>
+				   case f () of
+				       Client.Passwd pass => SOME pass
+				     | _ => NONE
+		in
+		    case pass of
+			NONE => ()
+		      | SOME pass => Main.requestDbPasswd {dbtype = dbtype, passwd = pass}
+		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}
+		else
+		    print ("Invalid database name " ^ dbname ^ ".\n")
+	      | ["grant", dbname] =>
+		if Dbms.validDbname dbname then
+		    Main.requestDbGrant {dbtype = dbtype, dbname = dbname}
 		else
 		    print ("Invalid database name " ^ dbname ^ ".\n")
-	      | _ => print "Invalid command-line arguments\n"
+	      | _ => badArgs ()