Apt package installation querying of dispatcher

diff --git a/src/main-admin.sml b/src/main-admin.sml
index a07c277..7062972 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -48,4 +48,5 @@ val _ =
       | ["ping"] => OS.Process.exit (Main.requestPing ())
       | ["slave-shutdown"] => Main.requestSlaveShutdown ()
       | ["slave-ping"] => OS.Process.exit (Main.requestSlavePing ())
       | ["ping"] => OS.Process.exit (Main.requestPing ())
       | ["slave-shutdown"] => Main.requestSlaveShutdown ()
       | ["slave-ping"] => OS.Process.exit (Main.requestSlavePing ())

+      | ["package", node, pkg] => OS.Process.exit (Main.requestApt {node = node, pkg = pkg})

       | _ => print "Invalid command-line arguments\n"
       | _ => print "Invalid command-line arguments\n"

diff --git a/src/main.sig b/src/main.sig
index 6c00df4..52f18b6 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -68,4 +68,6 @@ signature MAIN = sig
     val requestSaSet : string * bool -> unit
 
     val requestSmtpLog : string -> unit
     val requestSaSet : string * bool -> unit
 
     val requestSmtpLog : string -> unit

+
+    val requestApt : {node : string, pkg : string} -> OS.Process.status

 end
 end

diff --git a/src/main.sml b/src/main.sml
index 6585144..0ddc508 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -604,6 +604,31 @@ fun requestSmtpLog domain =
        OpenSSL.close bio
     end
 
        OpenSSL.close bio
     end
 

+fun requestApt {node, pkg} =
+    let
+       val (_, bio) = requestBio (fn () => ())
+
+       val _ = Msg.send (bio, MsgApt 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 is installed.\n";
+                              OS.Process.success)
+                 | MsgNo => (print "Package is not installed.\n";
+                             OS.Process.failure)
+                 | MsgError s => (print ("APT query failed: " ^ s ^ "\n");
+                                  OS.Process.failure)
+                 | _ => (print "Unexpected server reply.\n";
+                         OS.Process.failure)
+    in
+       loop ()
+       before OpenSSL.close bio
+    end
+

 fun regenerate context =
     let
        val b = basis ()
 fun regenerate context =
     let
        val b = basis ()


@@ -1030,6 +1055,15 @@ fun service () =
                                               NONE)))
                                (fn () => ())
 
                                               NONE)))
                                (fn () => ())
 

+                             | MsgApt pkg =>
+                               doIt (fn () => (Msg.send (bio, if Apt.installed pkg then
+                                                                  MsgYes
+                                                              else
+                                                                  MsgNo);
+                                               ("User requested installation status of package " ^ pkg,
+                                                NONE)))
+                               (fn () => ())
+

                              | _ =>
                                doIt (fn () => ("Unexpected command",
                                                SOME "Unexpected command"))
                              | _ =>
                                doIt (fn () => ("Unexpected command",
                                                SOME "Unexpected command"))

diff --git a/src/msg.sml b/src/msg.sml
index f05d012..555b079 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -170,6 +170,10 @@ fun send (bio, m) =
                                         OpenSSL.writeString (bio, dbtype);
                                         OpenSSL.writeString (bio, passwd))
       | MsgShutdown => OpenSSL.writeInt (bio, 29)
                                         OpenSSL.writeString (bio, dbtype);
                                         OpenSSL.writeString (bio, passwd))
       | MsgShutdown => OpenSSL.writeInt (bio, 29)

+      | MsgYes => OpenSSL.writeInt (bio, 30)
+      | MsgNo => OpenSSL.writeInt (bio, 31)
+      | MsgApt s => (OpenSSL.writeInt (bio, 32);
+                    OpenSSL.writeString (bio, s))

 
 fun checkIt v =
     case v of
 
 fun checkIt v =
     case v of


@@ -265,6 +269,9 @@ fun recv bio =
                                SOME (MsgDbPasswd {dbtype = dbtype, passwd = passwd})
                              | _ => NONE)
                   | 29 => SOME MsgShutdown
                                SOME (MsgDbPasswd {dbtype = dbtype, passwd = passwd})
                              | _ => NONE)
                   | 29 => SOME MsgShutdown

+                  | 30 => SOME MsgYes
+                  | 31 => SOME MsgNo
+                  | 32 => Option.map MsgApt (OpenSSL.readString bio)

                   | _ => NONE)
         
 end
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 3003a39..480c905 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -83,5 +83,10 @@ datatype msg =
        (* Change a DBMS user's password *)
        | MsgShutdown
        (* Halt the server *)
        (* Change a DBMS user's password *)
        | MsgShutdown
        (* Halt the server *)

+       | MsgYes
+       | MsgNo
+       (* Answers to boolean queries *)
+       | MsgApt of string
+       (* Is this apt package installed on your host? *)

 
 end
 
 end

diff --git a/src/plugins/apt.sig b/src/plugins/apt.sig
new file mode 100644 (file)
index 0000000..2ab4f50
--- /dev/null
+++ b/src/plugins/apt.sig
@@ -0,0 +1,26 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* APT package database querying *)
+
+signature APT = sig
+
+    val installed : string -> bool
+    (* Is the named package installed on this host? *)
+
+end

diff --git a/src/plugins/apt.sml b/src/plugins/apt.sml
new file mode 100644 (file)
index 0000000..1c31fbd
--- /dev/null
+++ b/src/plugins/apt.sml
@@ -0,0 +1,30 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* APT package database querying *)
+
+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) <> #"-")
+                          
+fun installed name =
+    validName name
+    andalso OS.Process.isSuccess (OS.Process.system ("/usr/bin/dpkg -p " ^ name ^ " >/dev/null 2>/dev/null"))
+
+end

diff --git a/src/sources b/src/sources
index 2aff199..3e132d6 100644 (file)
--- a/src/sources
+++ b/src/sources
@@ -86,6 +86,9 @@ plugins/postgres.sml
 plugins/mysql.sig
 plugins/mysql.sml
 
 plugins/mysql.sig
 plugins/mysql.sml
 

+plugins/apt.sig
+plugins/apt.sml
+

 mail/vmail.sig
 mail/vmail.sml
 
 mail/vmail.sig
 mail/vmail.sml