From a95a01077068e27009d4240aa0fc0c8f58908c6b Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Wed, 21 Feb 2007 03:43:07 +0000
Subject: [PATCH 1/1] Testing queries on slave servers

---
 src/main.sml     | 36 +++++++++++++++++++++++++-----------
 src/msg.sml      | 19 ++++++++++++++++---
 src/msgTypes.sml |  8 ++++++--
 3 files changed, 47 insertions(+), 16 deletions(-)

diff --git a/src/main.sml b/src/main.sml
index 0ddc508..19fe40c 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -606,9 +606,13 @@ fun requestSmtpLog domain =
 
 fun requestApt {node, pkg} =
     let
-	val (_, bio) = requestBio (fn () => ())
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect (context, if node = Config.masterNode then
+						dispatcher
+					    else
+						Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
-	val _ = Msg.send (bio, MsgApt pkg)
+	val _ = Msg.send (bio, MsgQuery (QApt pkg))
 
 	fun loop () =
 	    case Msg.recv bio of
@@ -712,6 +716,14 @@ fun rmuser user =
 
 fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
 
+fun answerQuery q =
+    case q of
+	QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+
+fun describeQuery q =
+    case q of
+	QApt pkg => "Requested installation status of package " ^ pkg
+
 fun service () =
     let
 	val () = Acl.read Config.aclFile
@@ -1055,12 +1067,9 @@ 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,
+			      | MsgQuery q =>
+				doIt (fn () => (Msg.send (bio, answerQuery q);
+						(describeQuery q,
 						 NONE)))
 				(fn () => ())
 
@@ -1134,9 +1143,14 @@ fun slave () =
 			  | _ => (OpenSSL.close bio;
 				  loop ())
 		    else
-			(print "Not authorized!\n";
-			 OpenSSL.close bio;
-			 loop ())
+			case Msg.recv bio of
+			    SOME (MsgQuery q) => (print (describeQuery q ^ "\n");
+						  Msg.send (bio, answerQuery q);
+						  ignore (OpenSSL.readChar bio);
+						  OpenSSL.close bio;
+						  loop ())
+			  | _ => (OpenSSL.close bio;
+				  loop ())
 		end handle OpenSSL.OpenSSL s =>
 			   (print ("OpenSSL error: "^ s ^ "\n");
 			    OpenSSL.close bio
diff --git a/src/msg.sml b/src/msg.sml
index 555b079..5bf11f3 100644
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -88,6 +88,19 @@ fun recvBool bio =
       | SOME 1 => SOME true
       | _ => NONE
 
+fun sendQuery (bio, q) =
+    case q of
+	QApt s => (OpenSSL.writeInt (bio, 0);
+		   OpenSSL.writeString (bio, s))
+
+fun recvQuery bio =
+    case OpenSSL.readInt bio of
+	SOME n =>
+	(case n of
+	     0 => Option.map QApt (OpenSSL.readString bio)
+	   | _ => NONE)
+      | NONE => NONE
+
 fun send (bio, m) =
     case m of
 	MsgOk => OpenSSL.writeInt (bio, 1)
@@ -172,8 +185,8 @@ fun send (bio, m) =
       | 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))
+      | MsgQuery q => (OpenSSL.writeInt (bio, 32);
+		       sendQuery (bio, q))
 
 fun checkIt v =
     case v of
@@ -271,7 +284,7 @@ fun recv bio =
 		   | 29 => SOME MsgShutdown
 		   | 30 => SOME MsgYes
 		   | 31 => SOME MsgNo
-		   | 32 => Option.map MsgApt (OpenSSL.readString bio)
+		   | 32 => Option.map MsgQuery (recvQuery bio)
 		   | _ => NONE)
 	 
 end
diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 480c905..1ef2538 100644
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -20,6 +20,10 @@
 
 structure MsgTypes = struct
 
+datatype query =
+	 QApt of string
+       (* Is this apt package installed? *)
+
 datatype msg =
 	 MsgOk
        (* Your request was processed successfully. *)
@@ -86,7 +90,7 @@ datatype msg =
        | MsgYes
        | MsgNo
        (* Answers to boolean queries *)
-       | MsgApt of string
-       (* Is this apt package installed on your host? *)
+       | MsgQuery of query
+       (* Ask for host-specific information *)
 
 end
-- 
2.20.1