src/main-dbtool.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* Driver for dbtool *)
  20
  21 fun badArgs () =
  22     print "Invalid command-line arguments.  See documentation at:\n\thttp://wiki.hcoop.net/MemberManual/Databases\n"
  23
  24 val _ =
  25     case CommandLine.arguments () of
  26         [] => badArgs ()
  27       | dbtype :: rest =>
  28         case Dbms.lookup dbtype of
  29             NONE => print ("Unknown database type " ^ dbtype ^ ".\n")
  30           | SOME {getpass, ...} =>
  31             case rest of
  32                 ["adduser"] =>
  33                 let
  34                     val pass = case getpass of
  35                                    NONE => SOME NONE
  36                                  | SOME f =>
  37                                    case f () of
  38                                        Client.Passwd pass => SOME (SOME pass)
  39                                      | Client.Aborted => SOME NONE
  40                                      | Client.Error => NONE
  41                 in
  42                     case pass of
  43                         NONE => ()
  44                       | SOME pass => Main.requestDbUser {dbtype = dbtype, passwd = pass}
  45                 end
  46               | ["passwd"] =>
  47                 let
  48                     val pass = case getpass of
  49                                    NONE => NONE
  50                                  | SOME f =>
  51                                    case f () of
  52                                        Client.Passwd pass => SOME pass
  53                                      | _ => NONE
  54                 in
  55                     case pass of
  56                         NONE => ()
  57                       | SOME pass => Main.requestDbPasswd {dbtype = dbtype, passwd = pass}
  58                 end
  59               | ["createdb", dbname] =>
  60                 if Dbms.validDbname dbname then
  61                     Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = NONE}
  62                 else
  63                     print ("Invalid database name " ^ dbname ^ ".\n")
  64               | ["createdb", dbname, encoding] =>
  65                 if not (Dbms.validDbname dbname) then
  66                     print ("Invalid database name " ^ dbname ^ ".\n")
  67                 else if not (Dbms.validEncoding (SOME encoding)) then
  68                     print ("Invalid encoding name " ^ encoding ^ ".\n")
  69                 else
  70                     Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = SOME encoding}
  71               | ["dropdb", dbname] =>
  72                 if Dbms.validDbname dbname then
  73                     Main.requestDbDrop {dbtype = dbtype, dbname = dbname}
  74                 else
  75                     print ("Invalid database name " ^ dbname ^ ".\n")
  76               | ["grant", dbname] =>
  77                 if Dbms.validDbname dbname then
  78                     Main.requestDbGrant {dbtype = dbtype, dbname = dbname}
  79                 else
  80                     print ("Invalid database name " ^ dbname ^ ".\n")
  81               | _ => badArgs ()