X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c17d0537db6e55a6b2bbd1a459542a5fbb44a68f..1ffc47a68def0e10e393ad4d8e62b7d6f7300c01:/src/main.sml?ds=sidebyside

diff --git a/src/main.sml b/src/main.sml
index 15a5853..8cc5a3a 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 ("Description failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
 fun regenerateEither tc checker context =
     let
 	fun ifReal f =
@@ -942,7 +957,8 @@ fun regenerateEither tc checker context =
 		    in
 			if !ErrorMsg.anyErrors then
 			    (ErrorMsg.reset ();
-			     print ("User " ^ user ^ "'s configuration has errors!\n"))
+			     print ("User " ^ user ^ "'s configuration has errors!\n");
+			     ok := false)
 			else
 			    app checker files
 		    end
@@ -1417,6 +1433,20 @@ fun service () =
 						      SOME "Script execution failed."))
 				      (fn () => ())
 
+			       | MsgDescribe dom =>
+				 doIt (fn () => if not (Domain.validDomain dom) then
+						    ("Requested description of invalid domain " ^ dom,
+						     SOME "Invalid domain name")
+						else if not (Domain.yourDomain dom
+							     orelse Acl.query {user = user, class = "priv", value = "all"}) then
+						    ("Requested description of " ^ dom ^ ", but not allowed access",
+						     SOME "Access denied")
+						else
+						    (Msg.send (bio, MsgDescription (Domain.describe dom));
+						     ("Sent description of domain " ^ dom,
+						      NONE)))
+				      (fn () => ())
+
 			       | _ =>
 				 doIt (fn () => ("Unexpected command",
 						 SOME "Unexpected command"))