(*
* <COPYRIGHT>
* Copyright 2003 Gerd Stolpmann
*
* <GPL>
* This file is part of WTimer.
*
* WTimer 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.
*
* WTimer 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 WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: cmdline.ml,v 1.6 2003/03/23 11:59:13 gerd Exp $
* ----------------------------------------------------------------------
*
*)
(* Command-line frontend *)
open Printf
open Db_types.Types
open Db_types
open Db.Types
(* [db] is an unbound database handle. Later it will be bound to a certain
* database, but the connection will remain closed until the first real
* db access happens, i.e. the connection is established lazily.
*)
let db = Db.Connection.create()
;;
let dbconfig config =
let db_name = Get_config.option config "database-name" in
let user_name = Get_config.option config "database-user" in
let passwd = Get_config.option config "database-passwd" in
(db_name, user_name, passwd)
;;
let bind_db config =
let (db_name, user_name, passwd) = dbconfig config in
Db.Connection.bind ~db_name ~user_name ~passwd db
;;
let cmd_dbconfig() =
Arg.parse
[]
(fun _ -> raise (Arg.Bad "Unexpected argument"))
"usage: wtimer-admin dbconfig [-help]";
let config = Get_config.parse() in
let (db_name, user_name, passwd) = dbconfig config in
printf "Database name: %s\n" db_name;
printf "Database user: %s\n" user_name;
printf "Password: %s\n" passwd
;;
let cmd_users() =
Arg.parse
[]
(fun _ -> raise (Arg.Bad "Unexpected argument"))
"usage: wtimer-admin users [-help]";
let config = Get_config.parse() in
bind_db config;
let users = Db.User.list db in
printf "%-20s %s %s %s\n" "USER" "LOGIN?" "ADMIN?" "DESCRIPTION";
List.iter
(fun user ->
printf "%-20s %-6s %-6s %s\n"
(string_of_user_name user.u_name)
(string_of_bool user.u_login)
(string_of_bool user.u_admin)
user.u_description
)
users
(* TODO: order alphabetically *)
;;
let cmd_del_user() =
let users = ref [] in
Arg.parse
[]
(fun u -> users := !users @ [u])
"usage: wtimer-admin del-user [-help] user ...";
let config = Get_config.parse() in
bind_db config;
List.iter
(fun user_name ->
Db.User.delete db (User user_name);
printf "Deleted %s\n" user_name;
flush stdout;
)
!users;
Db.Connection.commit db;
printf "Committed transaction.\n"
;;
let read_password() =
let read_hidden tty =
try
flush stdout;
Unix.tcdrain Unix.stdout;
Unix.tcflush Unix.stdin Unix.TCIFLUSH;
Unix.tcsetattr Unix.stdin Unix.TCSANOW
{ tty with
Unix.c_echo = false;
Unix.c_echoe = false;
Unix.c_echok = false;
Unix.c_echonl = true;
};
let s = read_line() in
Unix.tcsetattr Unix.stdin Unix.TCSANOW tty;
s
with
any ->
Unix.tcsetattr Unix.stdin Unix.TCSANOW tty;
raise any
in
(* Is stdin a tty? *)
try
let tty = Unix.tcgetattr Unix.stdin in
print_string "Enter new password: ";
let pw1 = read_hidden tty in
print_string "Enter password again: ";
let pw2 = read_hidden tty in
if pw1 <> pw2 then begin
prerr_endline "The passwords are not identical!";
exit 1
end;
pw1
with
Unix.Unix_error(Unix.ENOTTY,_,_) ->
(* No tty, so simply read one line of input *)
read_line()
;;
let cmd_add_user() =
let login = ref false in
let admin = ref false in
let description = ref "" in
let password = ref None in
let user = ref None in
Arg.parse
["-login-true", Arg.Set login,
" The user is allowed to login";
"-login-false", Arg.Clear login,
" The user is not allowed to login (default)";
"-admin-true", Arg.Set admin,
" The user is an administrator";
"-admin-false", Arg.Clear admin,
" The user is not an administrator (default)";
"-description", Arg.String (fun s -> description := s),
"<text> Set the description to this text";
"-password", Arg.String (fun s -> password := Some s),
"<pw> Set the password to this string";
"-password-stdin", Arg.Unit (fun () -> password := Some(read_password())),
" Read the password from stdin";
]
(fun u ->
if !user = None then
user := Some u
else
raise(Arg.Bad "Too many arguments"))
"usage: wtimer-admin add-user [-help] [...options...] user";
let config = Get_config.parse() in
bind_db config;
let uname =
match !user with
Some u -> u
| None -> failwith "No user to add"
in
let user_rec = { u_name = User uname;
u_description = !description;
u_password = ( match !password with
Some pw ->
Some (Db.User.encrypt_password pw)
| None ->
None );
u_login = !login;
u_admin = !admin;
} in
Db.User.insert db user_rec;
printf "Added user %s\n" uname;
flush stdout;
Db.Connection.commit db;
printf "Committed transaction.\n"
;;
let cmd_change_user() =
let login = ref false in
let login_changed = ref false in
let admin = ref false in
let admin_changed = ref false in
let description = ref "" in
let description_changed = ref false in
let password = ref None in
let user = ref None in
Arg.parse
["-login-true", Arg.Unit(fun _ -> login := true; login_changed := true),
" The user is allowed to login";
"-login-false", Arg.Unit(fun _ -> login := false; login_changed := true),
" The user is not allowed to login";
"-admin-true", Arg.Unit(fun _ -> admin := true; admin_changed := true),
" The user is an administrator";
"-admin-false", Arg.Unit(fun _ -> admin := false; admin_changed := true),
" The user is not an administrator";
"-description", Arg.String (fun s -> description := s;
description_changed := true
),
"<text> Set the description to this text";
"-password", Arg.String (fun s -> password := Some s;
),
"<pw> Set the password to this string";
"-password-stdin", Arg.Unit (fun () -> password := Some(read_password());
),
" Read the password from stdin";
]
(fun u ->
if !user = None then
user := Some u
else
raise(Arg.Bad "Too many arguments"))
"usage: wtimer-admin change-user [-help] [...options...] user";
let config = Get_config.parse() in
bind_db config;
let uname =
match !user with
Some u -> u
| None -> failwith "No user to change"
in
let user_rec = Db.User.get db (User uname) in
let user_rec' =
{ u_name = User uname;
u_description =
if !description_changed then !description
else user_rec.u_description;
u_password =
( match !password with
Some pw ->
Some (Db.User.encrypt_password pw)
| None ->
user_rec.u_password
);
u_login =
if !login_changed then !login else user_rec.u_login;
u_admin =
if !admin_changed then !admin else user_rec.u_admin;
} in
Db.User.update db user_rec';
printf "Changed user %s\n" uname;
flush stdout;
Db.Connection.commit db;
printf "Committed transaction.\n"
;;
let cmd_sheets() =
(* CHECK: Output owner, too? *)
Arg.parse
[]
(fun _ -> raise (Arg.Bad "Unexpected argument"))
"usage: wtimer-admin sheets [-help]";
let config = Get_config.parse() in
bind_db config;
let sheets = Db.Instance.list db in
printf "%-20s %s\n" "SHEET" "DESCRIPTION";
List.iter
(fun inst ->
printf "%-20s %s\n"
(string_of_inst_name inst.i_name)
inst.i_description
)
sheets
(* TODO: order alphabetically *)
;;
let cmd_del_sheet() =
let sheets = ref [] in
Arg.parse
[]
(fun u -> sheets := !sheets @ [u])
"usage: wtimer-admin del-sheet [-help] sheet ...";
let config = Get_config.parse() in
bind_db config;
List.iter
(fun inst_name ->
Db.Instance.delete db (Instance inst_name);
printf "Deleted %s\n" inst_name;
flush stdout;
)
!sheets;
Db.Connection.commit db;
printf "Committed transaction.\n"
;;
let cmd_add_sheet() =
let sheet = ref None in
let descr = ref "" in
let owner = ref [] in
Arg.parse
[ "-description", Arg.String (fun s -> descr := s),
"<text> Set the description to this text";
"-owner", Arg.String (fun s -> owner := !owner @ [s]),
"<user> Add this user to the list of owners";
]
(fun u ->
if !sheet = None then
sheet := Some u
else
raise(Arg.Bad "Too many arguments"))
"usage: wtimer-admin add-sheet [-help] [...options...] sheet";
let config = Get_config.parse() in
bind_db config;
let inst =
{ i_name = (match !sheet with Some n -> Instance n | None -> assert false);
i_description = !descr;
} in
Db.Instance.insert db inst;
List.iter
(fun u ->
let ps =
{ p_instance = inst.i_name;
p_set = [ User u, `Owner ];
} in
Db.Permission.update db ps;
)
!owner;
printf "Inserted sheet\n";
flush stdout;
Db.Connection.commit db;
printf "Committed transaction.\n"
;;
let cmd_export_users() =
let users = ref None in
Arg.parse
[ "-user", Arg.String (fun s ->
match !users with
None -> users := Some [User s]
| Some l -> users := Some (l @ [User s])),
"<user> Only export this user (option can be repeatedly given)";
]
(fun _ -> raise(Arg.Bad "Too many arguments"))
"usage: wtimer-admin export-users [-help] [...options...]";
let config = Get_config.parse() in
bind_db config;
let out = new Netchannels.output_channel stdout in
Db_xml.export_users ?users:!users db out;
out # flush()
;;
let cmd_export_sheets() =
let sheets = ref None in
let start_date = ref None in
let end_date = ref None in
Arg.parse
[ "-sheet", Arg.String (fun s ->
match !sheets with
None -> sheets := Some [Instance s]
| Some l -> sheets := Some (l @ [Instance s])),
"<user> Only export this sheet (option can be repeatedly given)";
"-start", Arg.String (fun s ->
start_date := Some(Date.from_string s)),
"<YYYY-MM-DD> Do not export ealier entries";
"-end", Arg.String (fun s ->
end_date := Some(Date.from_string s)),
"<YYYY-MM-DD> Do not export later entries";
]
(fun _ -> raise(Arg.Bad "Too many arguments"))
"usage: wtimer-admin export-sheets [-help] [...options...]";
let config = Get_config.parse() in
bind_db config;
let out = new Netchannels.output_channel stdout in
Db_xml.export_instances
?instances:!sheets ?start_date:!start_date ?end_date:!end_date db out;
out # flush()
;;
let cmd_export_dataset() =
let users = ref None in
let sheets = ref None in
let start_date = ref None in
let end_date = ref None in
Arg.parse
[ "-user", Arg.String (fun s ->
match !users with
None -> users := Some [User s]
| Some l -> users := Some (l @ [User s])),
"<user> Only export this user (option can be repeatedly given)";
"-sheet", Arg.String (fun s ->
match !sheets with
None -> sheets := Some [Instance s]
| Some l -> sheets := Some (l @ [Instance s])),
"<user> Only export this sheet (option can be repeatedly given)";
"-start", Arg.String (fun s ->
start_date := Some(Date.from_string s)),
"<YYYY-MM-DD> Do not export ealier entries";
"-end", Arg.String (fun s ->
end_date := Some(Date.from_string s)),
"<YYYY-MM-DD> Do not export later entries";
]
(fun _ -> raise(Arg.Bad "Too many arguments"))
"usage: wtimer-admin export-dataset [-help] [...options...]";
let config = Get_config.parse() in
bind_db config;
let out = new Netchannels.output_channel stdout in
Db_xml.export_dataset
?users:!users
?instances:!sheets ?start_date:!start_date ?end_date:!end_date db out;
out # flush()
;;
let cmd_import() =
let xmlfile = ref None in
let mode = ref `Fail in
Arg.parse
[ "-overwrite", Arg.Unit (fun _ -> mode := `Overwrite),
" Overwrite existing users, sheets, and days";
"-add", Arg.Unit (fun _ -> mode := `Only_add),
" Only import new users, sheets, or days; ignore other";
"-strict", Arg.Unit (fun _ -> mode := `Fail),
" Import new users, sheets, or days; fail on overwrite (default)";
]
(fun s ->
match !xmlfile with
None -> xmlfile := Some s
| Some _ -> raise (Arg.Bad "Unexpected argument"))
"usage: wtimer-admin import [-help] file.xml";
let config = Get_config.parse() in
bind_db config;
let xmlfilename =
match !xmlfile with
Some f -> f
| None -> failwith "File name missing"
in
let inch = open_in xmlfilename in
( try
Db_xml.import ~onconflict:!mode db inch;
with
Pxp_types.Validation_error _
| Pxp_types.WF_error _
| Pxp_types.Namespace_error _
| Pxp_types.Error _
| Pxp_types.Character_not_supported
| Pxp_types.At(_,_) as error ->
let s = Pxp_types.string_of_exn error in
failwith s
);
printf "Import complete.\n";
flush stdout;
Db.Connection.commit db;
printf "Committed transaction.\n"
;;
let usage_string =
"usage: wtimer-admin <command> <options> <arguments>\n" ^
"Available commands:\n" ^
" wtimer-admin dbconfig display database configuration\n" ^
" wtimer-admin users list the users database\n" ^
" wtimer-admin del-user delete user record\n" ^
" wtimer-admin add-user add a user record\n" ^
" wtimer-admin change-user change a user record\n" ^
" wtimer-admin sheets list the sheets\n" ^
" wtimer-admin add-sheet add a sheet\n" ^
" wtimer-admin del-sheet delete a sheet\n" ^
" wtimer-admin export-users export users into XML\n" ^
" wtimer-admin export-sheets export sheets into XML\n" ^
" wtimer-admin export-dataset export users and sheets into XML\n" ^
" wtimer-admin import import an XML file\n" ^
"The commands usually take options and arguments. Use -help to get\n" ^
"more help for an individual command, e.g. wtimer-admin users -help\n"
;;
let usage() =
prerr_string usage_string;
exit 1
;;
let main() =
Sys.catch_break true;
if Array.length Sys.argv < 2 then usage();
incr Arg.current;
match Sys.argv.(1) with
"dbconfig" ->
cmd_dbconfig()
| "users" ->
cmd_users()
| "del-user" ->
cmd_del_user()
| "add-user" ->
cmd_add_user()
| "change-user" ->
cmd_change_user()
| "sheets" ->
cmd_sheets()
| "del-sheet" ->
cmd_del_sheet()
| "add-sheet" ->
cmd_add_sheet()
| "export-users" ->
cmd_export_users()
| "export-sheets" ->
cmd_export_sheets()
| "export-dataset" ->
cmd_export_dataset()
| "import" ->
cmd_import()
| "help" ->
print_string usage_string
| _ ->
usage()
;;
main();;
(* ======================================================================
* History:
*
* $Log: cmdline.ml,v $
* Revision 1.6 2003/03/23 11:59:13 gerd
* GPL
*
* Revision 1.5 2003/02/07 16:33:56 gerd
* Better XML parser errors
*
* Revision 1.4 2003/02/07 16:28:02 gerd
* import: added conflict options
*
* Revision 1.3 2003/01/28 01:07:00 gerd
* Continued.
*
* Revision 1.2 2003/01/16 01:41:55 gerd
* Added add-sheet
*
* Revision 1.1 2003/01/16 00:31:10 gerd
* Initial revision.
*
*
*)
