X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/21d921a56a850857f6ea883c6dff6a411a659bbf..c9731b9b3ee43c4c8d82c31009a5870a01d3acfa:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index 53dfbfa..f05d012 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -76,6 +76,18 @@ fun recvOption f bio = | 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 send (bio, m) = case m of MsgOk => OpenSSL.writeInt (bio, 1) @@ -119,6 +131,45 @@ fun send (bio, m) = | 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) fun checkIt v = case v of @@ -177,6 +228,43 @@ fun recv bio = (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 | _ => NONE) end