Adding domain description

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index f32fa2d..ec795e3 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -873,6 +873,21 @@ fun requestFirewall {node, uname} =
        before OpenSSL.close bio
     end
 
+fun requestDescribe dom =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgDescribe dom);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgDescription s => print s
+             | MsgError s => print ("Describe failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 fun regenerateEither tc checker context =
     let
        fun ifReal f =
@@ -1417,6 +1432,16 @@ fun service () =
                                                      SOME "Script execution failed."))
                                      (fn () => ())
 
+                              | MsgDescribe dom =>
+                                doIt (fn () => (if Domain.validDomain dom then
+                                                    (Msg.send (bio, MsgDescription (Domain.describe dom));
+                                                     ("Requested description of domain " ^ dom,
+                                                      NONE))
+                                                else
+                                                    ("Requested description of invalid domain " ^ dom,
+                                                     SOME "Invalid domain name")))
+                                     (fn () => ())
+
                               | _ =>
                                 doIt (fn () => ("Unexpected command",
                                                 SOME "Unexpected command"))
@@ -1441,6 +1466,11 @@ fun service () =
                         OpenSSL.close bio
                         handle OpenSSL.OpenSSL _ => ();
                         loop ())
+                     | OS.Path.InvalidArc =>
+                       (print "Invalid arc\n";
+                        OpenSSL.close bio
+                        handle OpenSSL.OpenSSL _ => ();
+                        loop ())
                      | e =>
                        (print "Unknown exception in main loop!\n";
                         app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);