From 75585a67831244a20e460b7336d440d4cabe3b41 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 21 Feb 2007 03:14:52 +0000 Subject: [PATCH] Apt package installation querying of dispatcher --- src/main-admin.sml | 1 + src/main.sig | 2 ++ src/main.sml | 34 ++++++++++++++++++++++++++++++++++ src/msg.sml | 7 +++++++ src/msgTypes.sml | 5 +++++ src/plugins/apt.sig | 26 ++++++++++++++++++++++++++ src/plugins/apt.sml | 30 ++++++++++++++++++++++++++++++ src/sources | 3 +++ 8 files changed, 108 insertions(+) create mode 100644 src/plugins/apt.sig create mode 100644 src/plugins/apt.sml diff --git a/src/main-admin.sml b/src/main-admin.sml index a07c277..7062972 100644 --- 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 ()) + | ["package", node, pkg] => OS.Process.exit (Main.requestApt {node = node, pkg = pkg}) | _ => print "Invalid command-line arguments\n" diff --git a/src/main.sig b/src/main.sig index 6c00df4..52f18b6 100644 --- 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 requestApt : {node : string, pkg : string} -> OS.Process.status end diff --git a/src/main.sml b/src/main.sml index 6585144..0ddc508 100644 --- a/src/main.sml +++ b/src/main.sml @@ -604,6 +604,31 @@ fun requestSmtpLog domain = 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 () @@ -1030,6 +1055,15 @@ fun service () = 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")) diff --git a/src/msg.sml b/src/msg.sml index f05d012..555b079 100644 --- 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) + | 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 @@ -265,6 +269,9 @@ fun recv bio = 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 diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 3003a39..480c905 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -83,5 +83,10 @@ datatype msg = (* 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 diff --git a/src/plugins/apt.sig b/src/plugins/apt.sig new file mode 100644 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 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 --- a/src/sources +++ b/src/sources @@ -86,6 +86,9 @@ plugins/postgres.sml plugins/mysql.sig plugins/mysql.sml +plugins/apt.sig +plugins/apt.sml + mail/vmail.sig mail/vmail.sml -- 2.20.1