X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/2fc6b0dd10a94cf365b48df7fe6b0518e5dabdd1..00a077ab9685604472c9727eaf2b2be258f0268a:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index 747572a..64837b9 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -76,6 +76,61 @@ 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 sendSockPerm (bio, p) = + case p of + Any => OpenSSL.writeInt (bio, 0) + | Client => OpenSSL.writeInt (bio, 1) + | Server => OpenSSL.writeInt (bio, 2) + | Nada => OpenSSL.writeInt (bio, 3) + +fun recvSockPerm bio = + case OpenSSL.readInt bio of + SOME 0 => SOME Any + | SOME 1 => SOME Client + | SOME 2 => SOME Server + | SOME 3 => SOME Nada + | _ => 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)) + | QSocket s => (OpenSSL.writeInt (bio, 4); + OpenSSL.writeString (bio, s)) + | QFirewall s => (OpenSSL.writeInt (bio, 5); + 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) + | 4 => Option.map QSocket (OpenSSL.readString bio) + | 5 => Option.map QFirewall (OpenSSL.readString bio) + | _ => NONE) + | NONE => NONE + fun send (bio, m) = case m of MsgOk => OpenSSL.writeInt (bio, 1) @@ -143,6 +198,37 @@ fun send (bio, m) = (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)) + | MsgSocket p => (OpenSSL.writeInt (bio, 33); + sendSockPerm (bio, p)) + | MsgFirewall ls => (OpenSSL.writeInt (bio, 34); + sendList OpenSSL.writeString (bio, ls)) + | MsgRegenerateTc => OpenSSL.writeInt (bio, 35) + | MsgDropDb {dbtype, dbname} => (OpenSSL.writeInt (bio, 36); + OpenSSL.writeString (bio, dbtype); + OpenSSL.writeString (bio, dbname)) + | MsgGrantDb {dbtype, dbname} => (OpenSSL.writeInt (bio, 37); + OpenSSL.writeString (bio, dbtype); + OpenSSL.writeString (bio, dbname)) + | MsqMysqlFixperms => OpenSSL.writeInt (bio, 38) fun checkIt v = case v of @@ -226,6 +312,33 @@ fun recv bio = 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) + | 33 => Option.map MsgSocket (recvSockPerm bio) + | 34 => Option.map MsgFirewall (recvList OpenSSL.readString bio) + | 35 => SOME MsgRegenerateTc + | 36 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of + (SOME dbtype, SOME dbname) => + SOME (MsgDropDb {dbtype = dbtype, dbname = dbname}) + | _ => NONE) + | 37 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of + (SOME dbtype, SOME dbname) => + SOME (MsgGrantDb {dbtype = dbtype, dbname = dbname}) + | _ => NONE) + | 38 => SOME MsgMysqlFixperms | _ => NONE) end