(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006-2009, Adam Chlipala
+ * Copyright (c) 2012,2013,2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
()
else
Option.app (Unused.check G) (#3 prog);
- Tycheck.checkFile G (Defaults.tInit prog) prog)
+ Tycheck.checkFile G prog)
end
fun basis () =
raise ErrorMsg.Error
else
let
- val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
+ val G' = Tycheck.checkFile G prog
in
if !ErrorMsg.anyErrors then
raise ErrorMsg.Error
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 () => ())
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
ok := false)
else
();
- ignore (foldl checker' (basis (), Defaults.eInit ()) files)
+ let val basis' = basis () in
+ ignore (foldl checker' (basis', Env.initialDynEnvVals basis') files)
+ end
end
else if String.isSuffix "_admin" user then
()
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
end
in
doIt (fn () => (Env.pre ();
- ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
+ let val basis' = basis () in
+ ignore (foldl doOne (basis', Env.initialDynEnvVals basis') codes)
+ end;
Env.post ();
Msg.send (bio, MsgOk);
("Configuration complete.", NONE)))
val _ = print ("Slave server starting at " ^ now () ^ "\n")
fun loop () =
- (Acl.read Config.aclFile;
- case OpenSSL.accept sock of
+ (case OpenSSL.accept sock of
NONE => ()
| SOME bio =>
let
SOME "Script execution failed."))
(fn () => ()))
| MsgFirewallRegen =>
- doIt (fn () => 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
+ 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")))
+ else
+ ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))))
(fn () => ())
| _ => (OpenSSL.close bio;
HCoop / hcoop / domtool2.git / blobdiff