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

diff --git a/src/msg.sml b/src/msg.sml
index f2c4d72..bd7b5ee 100644
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -41,6 +41,75 @@ 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 sendOption f (bio, opt) =
+    case opt of
+	NONE => OpenSSL.writeInt (bio, 0)
+      | SOME x => (OpenSSL.writeInt (bio, 1);
+		   f (bio, x))
+
+fun recvOption f bio =
+    case OpenSSL.readInt bio of
+	SOME 0 => SOME NONE
+      | SOME 1 =>
+	(case f bio of
+	     SOME x => SOME (SOME x)
+	   | NONE => NONE)
+      | _ => NONE
+
+fun sendBool (bio, b) =
+    if b then
+	OpenSSL.writeInt (bio, 1)
+    else
+	OpenSSL.writeInt (bio, 0)
+
+fun recvBool bio =
+    case OpenSSL.readInt bio of
+	SOME 0 => SOME false
+      | SOME 1 => SOME true
+      | _ => NONE
+
+fun sendQuery (bio, q) =
+    case q of
+	QApt s => (OpenSSL.writeInt (bio, 0);
+		   OpenSSL.writeString (bio, s))
+      | QCron s => (OpenSSL.writeInt (bio, 1);
+		    OpenSSL.writeString (bio, s))
+      | QFtp s => (OpenSSL.writeInt (bio, 2);
+		   OpenSSL.writeString (bio, s))
+      | QTrustedPath s => (OpenSSL.writeInt (bio, 3);
+			   OpenSSL.writeString (bio, s))
+
+fun recvQuery bio =
+    case OpenSSL.readInt bio of
+	SOME n =>
+	(case n of
+	     0 => Option.map QApt (OpenSSL.readString bio)
+	   | 1 => Option.map QCron (OpenSSL.readString bio)
+	   | 2 => Option.map QFtp (OpenSSL.readString bio)
+	   | 3 => Option.map QTrustedPath (OpenSSL.readString bio)
+	   | _ => NONE)
+      | NONE => NONE
+
 fun send (bio, m) =
     case m of
 	MsgOk => OpenSSL.writeInt (bio, 1)
@@ -62,14 +131,71 @@ 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 doms => (OpenSSL.writeInt (bio, 13);
+			  sendList OpenSSL.writeString (bio, doms))
+      | MsgRegenerate => OpenSSL.writeInt (bio, 14)
+      | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
+			  OpenSSL.writeString (bio, dom))
+      | MsgCreateDbUser {dbtype, passwd} => (OpenSSL.writeInt (bio, 16);
+					     OpenSSL.writeString (bio, dbtype);
+					     sendOption OpenSSL.writeString (bio, passwd))
+      | MsgCreateDbTable {dbtype, dbname} => (OpenSSL.writeInt (bio, 17);
+					      OpenSSL.writeString (bio, dbtype);
+					      OpenSSL.writeString (bio, dbname))
+      | MsgNewMailbox {domain, user, passwd, mailbox} =>
+	(OpenSSL.writeInt (bio, 18);
+	 OpenSSL.writeString (bio, domain);
+	 OpenSSL.writeString (bio, user);
+	 OpenSSL.writeString (bio, passwd);
+	 OpenSSL.writeString (bio, mailbox))
+      | MsgPasswdMailbox {domain, user, passwd} =>
+	(OpenSSL.writeInt (bio, 19);
+	 OpenSSL.writeString (bio, domain);
+	 OpenSSL.writeString (bio, user);
+	 OpenSSL.writeString (bio, passwd))
+      | MsgRmMailbox {domain, user} =>
+	(OpenSSL.writeInt (bio, 20);
+	 OpenSSL.writeString (bio, domain);
+	 OpenSSL.writeString (bio, user))
+      | MsgListMailboxes domain =>
+	(OpenSSL.writeInt (bio, 21);
+	 OpenSSL.writeString (bio, domain))
+      | MsgMailboxes users =>
+	(OpenSSL.writeInt (bio, 22);
+	 sendList (fn (bio, {user, mailbox}) =>
+			    (OpenSSL.writeString (bio, user);
+			     OpenSSL.writeString (bio, mailbox)))
+	 (bio, users))
+      | MsgSaQuery addr => (OpenSSL.writeInt (bio, 23);
+			    OpenSSL.writeString (bio, addr))
+      | MsgSaStatus b => (OpenSSL.writeInt (bio, 24);
+			  sendBool (bio, b))
+      | MsgSaSet (addr, b) => (OpenSSL.writeInt (bio, 25);
+			       OpenSSL.writeString (bio, addr);
+			       sendBool (bio, b))
+      | MsgSmtpLogReq domain => (OpenSSL.writeInt (bio, 26);
+				 OpenSSL.writeString (bio, domain))
+      | MsgSmtpLogRes domain => (OpenSSL.writeInt (bio, 27);
+				 OpenSSL.writeString (bio, domain))
+      | MsgDbPasswd {dbtype, passwd} => (OpenSSL.writeInt (bio, 28);
+					 OpenSSL.writeString (bio, dbtype);
+					 OpenSSL.writeString (bio, passwd))
+      | MsgShutdown => OpenSSL.writeInt (bio, 29)
+      | MsgYes => OpenSSL.writeInt (bio, 30)
+      | MsgNo => OpenSSL.writeInt (bio, 31)
+      | MsgQuery q => (OpenSSL.writeInt (bio, 32);
+		       sendQuery (bio, q))
 
 fun checkIt v =
     case v of
@@ -104,30 +230,70 @@ 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 (recvList OpenSSL.readString bio)
+		   | 14 => SOME MsgRegenerate
+		   | 15 => Option.map MsgRmuser (OpenSSL.readString bio)
+		   | 16 => (case (OpenSSL.readString bio, recvOption OpenSSL.readString bio) of
+				(SOME dbtype, SOME passwd) =>
+				SOME (MsgCreateDbUser {dbtype = dbtype, passwd = passwd})
+			      | _ => NONE)
+		   | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
+				(SOME dbtype, SOME dbname) =>
+				SOME (MsgCreateDbTable {dbtype = dbtype, dbname = dbname})
+			      | _ => NONE)
+		   | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio,
+				  OpenSSL.readString bio, OpenSSL.readString bio) of
+				(SOME domain, SOME user, SOME passwd, SOME mailbox) =>
+				SOME (MsgNewMailbox {domain = domain, user = user,
+						     passwd = passwd, mailbox = mailbox})
+			      | _ => NONE)
+		   | 19 => (case (OpenSSL.readString bio, OpenSSL.readString bio,
+				  OpenSSL.readString bio) of
+				(SOME domain, SOME user, SOME passwd) =>
+				SOME (MsgPasswdMailbox {domain = domain, user = user,
+							passwd = passwd})
+			      | _ => NONE)
+		   | 20 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
+				(SOME domain, SOME user) =>
+				SOME (MsgRmMailbox {domain = domain, user = user})
+			      | _ => NONE)
+		   | 21 => Option.map MsgListMailboxes (OpenSSL.readString bio)
+		   | 22 => Option.map MsgMailboxes (recvList
+							(fn bio =>
+							    case (OpenSSL.readString bio,
+								  OpenSSL.readString bio) of
+								(SOME user, SOME mailbox) =>
+								SOME {user = user, mailbox = mailbox}
+							      | _ => NONE)
+							bio)
+		   | 23 => Option.map MsgSaQuery (OpenSSL.readString bio)
+		   | 24 => Option.map MsgSaStatus (recvBool bio)
+		   | 25 => (case (OpenSSL.readString bio, recvBool bio) of
+				(SOME user, SOME b) => SOME (MsgSaSet (user, b))
+			      | _ => NONE)
+		   | 26 => Option.map MsgSmtpLogReq (OpenSSL.readString bio)
+		   | 27 => Option.map MsgSmtpLogRes (OpenSSL.readString bio)
+		   | 28 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
+				(SOME dbtype, SOME passwd) =>
+				SOME (MsgDbPasswd {dbtype = dbtype, passwd = passwd})
+			      | _ => NONE)
+		   | 29 => SOME MsgShutdown
+		   | 30 => SOME MsgYes
+		   | 31 => SOME MsgNo
+		   | 32 => Option.map MsgQuery (recvQuery bio)
 		   | _ => NONE)
 	 
 end