let
val (user, bio) = requestBio (fn () => ())
in
- Msg.send (bio, MsgCreateDbTable p);
+ Msg.send (bio, MsgCreateDb p);
case Msg.recv bio of
NONE => print "Server closed connection unexpectedly.\n"
| SOME m =>
OpenSSL.close bio
end
+fun requestDbGrant p =
+ let
+ val (user, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgGrantDb p);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => print ("You've been granted all allowed privileges to database " ^ user ^ "_" ^ #dbname p ^ ".\n")
+ | MsgError s => print ("Grant failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
fun requestListMailboxes domain =
let
val (_, bio) = requestBio (fn () => ())
case m of
MsgMailboxes users => (Msg.send (bio, MsgOk);
Vmail.Listing users)
- | MsgError s => Vmail.Error ("Creation failed: " ^ s)
+ | MsgError s => Vmail.Error ("Listing failed: " ^ s)
| _ => Vmail.Error "Unexpected server reply.")
before OpenSSL.close bio
end
OpenSSL.close bio
end
+fun requestMysqlFixperms () =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgMysqlFixperms);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => print "Permissions granted.\n"
+ | MsgError s => print ("Failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
fun requestApt {node, pkg} =
let
val (user, context) = requestContext (fn () => ())
else
()
end
- handle IO.Io _ => ()
+ handle IO.Io {name, function, ...} =>
+ (print ("IO error processing user " ^ user ^ ": " ^ function ^ ": " ^ name ^ "\n");
+ ok := false)
| OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
ok := false)
| ErrorMsg.Error => (ErrorMsg.reset ();
SOME ("Error adding user: " ^ msg)))
(fn () => ())
- | MsgCreateDbTable {dbtype, dbname} =>
+ | MsgCreateDb {dbtype, dbname} =>
doIt (fn () =>
if Dbms.validDbname dbname then
case Dbms.lookup dbtype of
SOME ("Invalid database name " ^ dbname)))
(fn () => ())
+ | MsgGrantDb {dbtype, dbname} =>
+ doIt (fn () =>
+ if Dbms.validDbname dbname then
+ case Dbms.lookup dbtype of
+ NONE => ("Database drop request with unknown datatype type " ^ dbtype,
+ SOME ("Unknown database type " ^ dbtype))
+ | SOME handler =>
+ case #grant handler {user = user, dbname = dbname} of
+ NONE => ("Grant permissions to database " ^ user ^ "_" ^ dbname ^ ".",
+ NONE)
+ | SOME msg => ("Error granting permissions to database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+ SOME ("Error granting permissions to database: " ^ msg))
+ else
+ ("Invalid database name " ^ user ^ "_" ^ dbname,
+ SOME ("Invalid database name " ^ dbname)))
+ (fn () => ())
+
| MsgListMailboxes domain =>
doIt (fn () =>
if not (Domain.yourDomain domain) then
SOME "Invalid password; may only contain printable, non-space characters")
else if not (Domain.yourPath mailbox) then
("User wasn't authorized to add a mailbox at " ^ mailbox,
- SOME "You're not authorized to use that mailbox location.")
+ SOME ("You're not authorized to use that mailbox location. ("
+ ^ mailbox ^ ")"))
else
case Vmail.add {requester = user,
domain = domain, user = emailUser,
NONE)))
(fn () => ())
+ | MsgMysqlFixperms =>
+ doIt (fn () => if OS.Process.isSuccess
+ (OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
+ ("Requested mysql-fixperms",
+ NONE)
+ else
+ ("Requested mysql-fixperms, but execution failed!",
+ SOME "Script execution failed."))
+ (fn () => ())
+
| _ =>
doIt (fn () => ("Unexpected command",
SOME "Unexpected command"))