+ loop ())
+ | SOME m =>
+ case m of
+ (MsgQuery q) => (print (describeQuery q ^ "\n");
+ Msg.send (bio, answerQuery q);
+ ignore (OpenSSL.readChar bio);
+ OpenSSL.close bio;
+ loop ())
+ | MsgCreateDbUser {dbtype, passwd} =>
+ doIt (fn () =>
+ case Dbms.lookup dbtype of
+ NONE => ("Database user creation request with unknown datatype type " ^ dbtype,
+ SOME ("Unknown database type " ^ dbtype))
+ | SOME handler =>
+ case #adduser handler {user = user, passwd = passwd} of
+ NONE => ("Added " ^ dbtype ^ " user " ^ user ^ ".",
+ NONE)
+ | SOME msg =>
+ ("Error adding a " ^ dbtype ^ " user " ^ user ^ ": " ^ msg,
+ SOME ("Error adding user: " ^ msg)))
+ (fn () => ())
+
+ | MsgDbPasswd {dbtype, passwd} =>
+ doIt (fn () =>
+ case Dbms.lookup dbtype of
+ NONE => ("Database passwd request with unknown datatype type " ^ dbtype,
+ SOME ("Unknown database type " ^ dbtype))
+ | SOME handler =>
+ case #passwd handler {user = user, passwd = passwd} of
+ NONE => ("Changed " ^ dbtype ^ " password of user " ^ user ^ ".",
+ NONE)
+ | SOME msg =>
+ ("Error setting " ^ dbtype ^ " password of user " ^ user ^ ": " ^ msg,
+ SOME ("Error adding user: " ^ msg)))
+ (fn () => ())
+
+ | MsgCreateDb {dbtype, dbname, encoding} =>
+ doIt (fn () =>
+ if Dbms.validDbname dbname then
+ case Dbms.lookup dbtype of
+ NONE => ("Database creation request with unknown datatype type " ^ dbtype,
+ SOME ("Unknown database type " ^ dbtype))
+ | SOME handler =>
+ if not (Dbms.validEncoding encoding) then
+ ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.",
+ SOME "Invalid encoding")
+ else
+ case #createdb handler {user = user, dbname = dbname, encoding = encoding} of
+ NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".",
+ NONE)
+ | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+ SOME ("Error creating database: " ^ msg))
+ else
+ ("Invalid database name " ^ user ^ "_" ^ dbname,
+ SOME ("Invalid database name " ^ dbname)))
+ (fn () => ())
+
+ | MsgDropDb {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 #dropdb handler {user = user, dbname = dbname} of
+ NONE => ("Drop database " ^ user ^ "_" ^ dbname ^ ".",
+ NONE)
+ | SOME msg => ("Error dropping database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+ SOME ("Error dropping database: " ^ msg))
+ else
+ ("Invalid database name " ^ user ^ "_" ^ dbname,
+ 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 () => ())
+ | MsgMysqlFixperms =>
+ (print "Starting mysql-fixperms\n";
+ 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 () => ()))
+ | MsgFirewallRegen =>
+ doIt (fn () => (Acl.read Config.aclFile;
+ if Acl.query {user = user, class = "priv", value = "all"} then
+ if List.exists (fn x => x = host) Config.Firewall.firewallNodes then
+ if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ())
+ then
+ ("Firewall rules regenerated.", NONE)
+ else
+ ("Rules regeneration failed!", SOME "Script execution failed.")
+ else ("Node not controlled by domtool firewall.", SOME (host))
+ else
+ ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))))
+ (fn () => ())
+
+ | _ => (OpenSSL.close bio;
+ loop ())
+ end
+ end handle OpenSSL.OpenSSL s =>
+ (print ("OpenSSL error: " ^ s ^ "\n");
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ | e as OS.SysErr (s, _) =>
+ (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+ print ("System error: "^ s ^ "\n");
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ | IO.Io {function, name, ...} =>
+ (print ("IO error: " ^ function ^ ": " ^ name ^ "\n");
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ | e =>
+ (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+ print "Uncaught exception!\n";
+ OpenSSL.close bio
+ handle OpenSSL.OpenSSL _ => ();
+ loop ()))
+ handle OpenSSL.OpenSSL s =>
+ (print ("OpenSSL error: " ^ s ^ "\n");
+ loop ())
+ | e =>
+ (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+ print "Uncaught exception!\n";
+ loop ())