X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d541c6185fb0f426dce0b16e85327b53635169e0..0868840155aca9662f97318b114a07ae4c8319d6:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index 2b6cd20..d0d917c 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,8 +113,27 @@ 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)) fun checkIt v = case v of @@ -150,7 +184,30 @@ 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) | _ => NONE) end