Apt package installation querying of dispatcher
[hcoop/domtool2.git] / src / main.sml
index 29d2b37..0ddc508 100644 (file)
@@ -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 ()
@@ -665,6 +690,7 @@ fun regenerate context =
            end
                handle IO.Io _ => ()
                     | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
+                    | ErrorMsg.Error => print ("User " ^ user ^ " had a compilation error.\n")
     in
        app contactNode Config.nodeIps;
        Env.pre ();
@@ -1029,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"))