X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c189cbe97d554b26ec6b203b4ce9f697947ecc38..1d3ef80ec822ea0fa241eb5485549ca7417e787f:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index aa5cf35..6fdda0a 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -61,6 +61,21 @@ fun recvList f bio = 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 send (bio, m) = case m of MsgOk => OpenSSL.writeInt (bio, 1) @@ -93,8 +108,38 @@ fun send (bio, m) = 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)) + | 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 OpenSSL.writeString (bio, users)) fun checkIt v = case v of @@ -142,7 +187,35 @@ fun recv bio = (recvList OpenSSL.readString bio) | 12 => Option.map MsgMultiConfig (recvList OpenSSL.readString bio) - | 13 => Option.map MsgRmdom (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 OpenSSL.readString bio) | _ => NONE) end