X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/86e132be99dcdbf2271119267cea6b91eb8207c3..314ce7bdcb5f54a7d1763e8b6d405dc66cb65d2b:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index f32fa2d..ec795e3 100644
--- 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);