Add query for existence of package

Used by the portal to determine if a package exists, rather than
querying the local apt. The implementation is copied from the portal
mostly, and is probably less than ideal: I think the return value of
apt-cache could be used, but the man page is unclear and this works
so...

diff --git a/src/main-admin.sml b/src/main-admin.sml
index 2353617..2e4c74b 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -50,6 +50,7 @@ val _ =
        | ["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})

diff --git a/src/main.sml b/src/main.sml
index 28834af..6df1525 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -779,6 +779,35 @@ fun requestApt {node, pkg} =
        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 () => ())
@@ -1184,6 +1213,7 @@ fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
 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
@@ -1193,6 +1223,7 @@ fun answerQuery q =
 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

diff --git a/src/msg.sml b/src/msg.sml
index ab79885..0a50b6e 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -119,6 +119,8 @@ fun sendQuery (bio, q) =
                      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
@@ -130,6 +132,7 @@ fun recvQuery bio =
           | 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
 

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index a0b7593..dcd04cb 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -39,6 +39,8 @@ datatype query =
        (* 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

diff --git a/src/plugins/apt.sig b/src/plugins/apt.sig
index 2ab4f50..2546fd5 100644 (file)
--- a/src/plugins/apt.sig
+++ b/src/plugins/apt.sig
@@ -20,6 +20,9 @@
 
 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? *)
 

diff --git a/src/plugins/apt.sml b/src/plugins/apt.sml
index d2517e9..e97ec82 100644 (file)
--- a/src/plugins/apt.sml
+++ b/src/plugins/apt.sml
@@ -22,6 +22,31 @@ structure Apt :> APT = struct
 
 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