apache: enable php 8.0 support
[hcoop/domtool2.git] / 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 ()