| ["slave-shutdown"] => Main.requestSlaveShutdown ()
| ["slave-ping"] => OS.Process.exit (Main.requestSlavePing ())
| ["package", node, pkg] => OS.Process.exit (Main.requestApt {node = node, pkg = pkg})
+ | ["package-exists", node, pkg] => OS.Process.exit (Main.requestAptExists {node = node, pkg = pkg})
| ["cron", node, uname] => OS.Process.exit (Main.requestCron {node = node, uname = uname})
| ["ftp", node, uname] => OS.Process.exit (Main.requestFtp {node = node, uname = uname})
| ["tpe", node, uname] => OS.Process.exit (Main.requestTrustedPath {node = node, uname = uname})
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
+ MsgYes => (print "Package exists.\n";
+ OS.Process.success)
+ | MsgNo => (print "Package does not exist.\n";
+ OS.Process.failure)
+ | 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 () => ())
fun answerQuery q =
case q of
QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+ | QAptExists pkg => if Apt.exists pkg then MsgYes else 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
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
OpenSSL.writeString (bio, s))
| QFirewall s => (OpenSSL.writeInt (bio, 5);
OpenSSL.writeString (bio, s))
+ | QAptExists s => (OpenSSL.writeInt (bio, 6);
+ OpenSSL.writeString (bio, s))
fun recvQuery bio =
case OpenSSL.readInt bio of
| 3 => Option.map QTrustedPath (OpenSSL.readString bio)
| 4 => Option.map QSocket (OpenSSL.readString bio)
| 5 => Option.map QFirewall (OpenSSL.readString bio)
+ | 6 => Option.map QAptExists (OpenSSL.readString bio)
| _ => NONE)
| NONE => NONE
(* What socket permissions does this user have? *)
| QFirewall of string
(* What firewall rules does this user have? *)
+ | QAptExists of string
+ (* Does this apt package exist *)
datatype msg =
MsgOk
signature APT = sig
+ val exists : string -> bool
+ (* Does the package exist on this host? *)
+
val installed : string -> bool
(* Is the named package installed on this host? *)
fun validName s = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"-" orelse ch = #".") s
andalso (size s > 0 andalso String.sub (s, 0) <> #"-")
+
+(* Copyed from the portal, doesn't exactly go out this in the most
+ direct way, or does it? *)
+
+fun exists name =
+ validName name andalso let
+ val proc = Unix.execute ("/usr/bin/apt-cache", ["show", name])
+ val inf = Unix.textInstreamOf proc
+
+ val _ = TextIO.inputLine inf (* in every let* lies an imperative program in disguise *)
+
+ fun loop _ =
+ case TextIO.inputLine inf of
+ NONE => false
+ | SOME line =>
+ if size line >= 9 andalso String.substring (line, 0, 9) = "Section: " then
+ true
+ else if size line >= 13 andalso String.substring (line, 0, 13) = "Description: " then
+ false
+ else
+ loop ()
+ in
+ loop ()
+ before ignore (Unix.reap proc)
+ end
fun installed name =
validName name