fun requestMysqlFixperms () =
let
- val (_, bio) = requestBio (fn () => ())
+ val (_, context) = requestContext (fn () => ())
+ val bio = OpenSSL.connect true (context,
+ Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
in
Msg.send (bio, MsgMysqlFixperms);
case Msg.recv bio of
fun requestApt {node, pkg} =
let
val (user, context) = requestContext (fn () => ())
- val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
dispatcher
else
Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
before OpenSSL.close bio
end
+fun requestAptExists {node, pkg} =
+ let
+ val (user, context) = requestContext (fn () => ())
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+ dispatcher
+ else
+ Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+ val _ = Msg.send (bio, MsgQuery (QAptExists pkg))
+
+ fun loop () =
+ case Msg.recv bio of
+ NONE => (print "Server closed connection unexpectedly.\n";
+ OS.Process.failure)
+ | SOME m =>
+ case m of
+ MsgAptQuery {section,description} => (print "Package exists.\n";
+ print ("Section: " ^ section ^ "\n");
+ print ("Description: " ^ description ^ "\n");
+ OS.Process.success)
+ | MsgNo => (print "Package does not exist.\n";
+ OS.Process.failure
+ (* It might be the Wrong Thing (tm) to use MsgNo like this *))
+ | MsgError s => (print ("APT existence query failed: " ^ s ^ "\n");
+ OS.Process.failure)
+ | _ => (print "Unexpected server reply.\n";
+ OS.Process.failure)
+ in
+ loop ()
+ before OpenSSL.close bio
+ end
+
fun requestCron {node, uname} =
let
val (user, context) = requestContext (fn () => ())
- val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
dispatcher
else
Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
fun requestFtp {node, uname} =
let
val (user, context) = requestContext (fn () => ())
- val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
dispatcher
else
Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
fun requestTrustedPath {node, uname} =
let
val (user, context) = requestContext (fn () => ())
- val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
dispatcher
else
Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
fun requestSocketPerm {node, uname} =
let
val (user, context) = requestContext (fn () => ())
- val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
dispatcher
else
Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
fun requestFirewall {node, uname} =
let
val (user, context) = requestContext (fn () => ())
- val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+ val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
dispatcher
else
Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
- val _ = Msg.send (bio, MsgQuery (QFirewall uname))
+ val _ = Msg.send (bio, MsgQuery (QFirewall {node = node, user = uname}))
fun loop () =
case Msg.recv bio of
OpenSSL.close bio
end
+fun requestFirewallRegen node =
+ let
+ val (user, context) = requestContext (fn () => ())
+ val bio = OpenSSL.connect true (context, Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+ (* Only supporting on slave nodes *)
+
+ val _ = Msg.send (bio, MsgFirewallRegen)
+
+ fun handleResult () =
+ case Msg.recv bio of
+ NONE => (print "Server closed connection unexpectedly.\n";
+ OS.Process.failure)
+ | SOME m =>
+ case m of
+ MsgOk => (print "Firewall regenerated.\n";
+ OS.Process.success)
+ | MsgError s => (print ("Firewall regeneration failed: " ^ s ^ "\n");
+ OS.Process.failure)
+ | _ => (print "Unexpected server reply.\n";
+ OS.Process.failure)
+ in
+ handleResult()
+ before OpenSSL.close bio
+ end
+
structure SS = StringSet
fun domainList dname =
fun answerQuery q =
case q of
QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+ | QAptExists pkg => (case Apt.info pkg of
+ SOME {section, description} => MsgAptQuery {section = section, description = description}
+ | NONE => MsgNo)
| QCron user => if Cron.allowed user then MsgYes else MsgNo
| QFtp user => if Ftp.allowed user then MsgYes else MsgNo
| QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo
| QSocket user => MsgSocket (SocketPerm.query user)
- | QFirewall user => MsgFirewall (Firewall.query user)
+ | QFirewall {node, user} => MsgFirewall (Firewall.query (node, user))
fun describeQuery q =
case q of
QApt pkg => "Requested installation status of package " ^ pkg
+ | QAptExists pkg => "Requested if package " ^ pkg ^ " exists"
| QCron user => "Asked about cron permissions for user " ^ user
| QFtp user => "Asked about FTP permissions for user " ^ user
| QTrustedPath user => "Asked about trusted path settings for user " ^ user
| QSocket user => "Asked about socket permissions for user " ^ user
- | QFirewall user => "Asked about firewall rules for user " ^ user
+ | QFirewall {node, user} => "Asked about firewall rules on " ^ node ^ " for user " ^ user
fun doIt' loop bio f cleanup =
((case f () of
(describeQuery q,
NONE)))
(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 () => ()))
-
| MsgDescribe dom =>
doIt (fn () => if not (Domain.validDomain dom) then
("Requested description of invalid domain " ^ dom,
("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