X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/90dd48df1de3ea116fe2f2c0ec0fe36c71e17e5c..1d3ef80ec822ea0fa241eb5485549ca7417e787f:/src/msg.sml?ds=sidebyside diff --git a/src/msg.sml b/src/msg.sml index 23e8ac2..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) @@ -98,11 +113,33 @@ fun send (bio, m) = | MsgRegenerate => OpenSSL.writeInt (bio, 14) | MsgRmuser dom => (OpenSSL.writeInt (bio, 15); OpenSSL.writeString (bio, dom)) - | MsgCreateDbUser s => (OpenSSL.writeInt (bio, 16); - OpenSSL.writeString (bio, s)) + | 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 @@ -153,11 +190,32 @@ fun recv bio = | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio) | 14 => SOME MsgRegenerate | 15 => Option.map MsgRmuser (OpenSSL.readString bio) - | 16 => Option.map MsgCreateDbUser (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