X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/08a04eb413e8ee58ee35affc5c4125b622ea75c4..77a8fca278b561808959fa1aa7d9f02c5cfe7720:/src/msg.sml

diff --git a/src/msg.sml b/src/msg.sml
index f2c4d72..bb6a2b1 100644
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -41,6 +41,26 @@ fun recvAcl bio =
 	(SOME user, SOME class, SOME value) => SOME {user = user, class = class, value = value}
       | _ => NONE
 
+fun sendList f (bio, ls) =
+    (app (fn x =>
+	     (OpenSSL.writeInt (bio, 1);
+	      f (bio, x))) ls;
+     OpenSSL.writeInt (bio, 0))
+
+fun recvList f bio =
+    let
+	fun loop ls =
+	    case OpenSSL.readInt bio of
+		SOME 0 => SOME (rev ls)
+	      | SOME 1 =>
+		(case f bio of
+		     SOME x => loop (x :: ls)
+		   | NONE => NONE)
+	      | _ => NONE
+    in
+	loop []
+    end
+
 fun send (bio, m) =
     case m of
 	MsgOk => OpenSSL.writeInt (bio, 1)
@@ -62,14 +82,20 @@ fun send (bio, m) =
       | MsgListPerms user => (OpenSSL.writeInt (bio, 8);
 			      OpenSSL.writeString (bio, user))
       | MsgPerms classes => (OpenSSL.writeInt (bio, 9);
-			     app (fn (class, values) =>
-				     (OpenSSL.writeInt (bio, 1);
-				      OpenSSL.writeString (bio, class);
-				      app (fn value =>
-					      (OpenSSL.writeInt (bio, 1);
-					       OpenSSL.writeString (bio, value))) values;
-				      OpenSSL.writeInt (bio, 0))) classes;
-			     OpenSSL.writeInt (bio, 0))
+			     sendList (fn (bio, (class, values)) =>
+					  (OpenSSL.writeString (bio, class);
+					   sendList OpenSSL.writeString (bio, values)))
+				      (bio, classes))
+      | MsgWhoHas {class, value} => (OpenSSL.writeInt (bio, 10);
+				     OpenSSL.writeString (bio, class);
+				     OpenSSL.writeString (bio, value))
+      | MsgWhoHasResponse users => (OpenSSL.writeInt (bio, 11);
+				    sendList OpenSSL.writeString (bio, users))
+      | MsgMultiConfig codes => (OpenSSL.writeInt (bio, 12);
+				 sendList OpenSSL.writeString (bio, codes))
+      | MsgRmdom dom => (OpenSSL.writeInt (bio, 13);
+			 OpenSSL.writeString (bio, dom))
+      | MsgRegenerate => OpenSSL.writeInt (bio, 14)
 
 fun checkIt v =
     case v of
@@ -104,30 +130,21 @@ fun recv bio =
 		   | 8 => (case OpenSSL.readString bio of
 			       SOME user => SOME (MsgListPerms user)
 			     | _ => NONE)
-		   | 9 => let
-			 fun loop classes =
-			     case OpenSSL.readInt bio of
-				 SOME 0 => SOME (MsgPerms (rev classes))
-			       | SOME 1 =>
-				 (case OpenSSL.readString bio of
-				      SOME class =>
-				      let
-					  fun loop' values =
-					      case OpenSSL.readInt bio of
-						  SOME 0 => loop ((class, rev values) :: classes)
-						| SOME 1 =>
-						  (case OpenSSL.readString bio of
-						       SOME value => loop' (value :: values)
-						     | NONE => NONE)
-						| _ => NONE
-				      in
-					  loop' []
-				      end
-				    | NONE => NONE)
-			       | _ => NONE
-		     in
-			 loop []
-		     end
+		   | 9 => Option.map MsgPerms
+				     (recvList (fn bio =>
+						   case (OpenSSL.readString bio,
+							 recvList OpenSSL.readString bio) of
+						       (SOME class, SOME values) => SOME (class, values)
+						     | _ => NONE) bio)
+		   | 10 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
+				(SOME class, SOME value) => SOME (MsgWhoHas {class = class, value = value})
+			      | _ => NONE)
+		   | 11 => Option.map MsgWhoHasResponse
+			   (recvList OpenSSL.readString bio)
+		   | 12 => Option.map MsgMultiConfig
+			   (recvList OpenSSL.readString bio)
+		   | 13 => Option.map MsgRmdom (OpenSSL.readString bio)
+		   | 14 => SOME MsgRegenerate
 		   | _ => NONE)
 	 
 end