X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/2fc6b0dd10a94cf365b48df7fe6b0518e5dabdd1..fe789bea628b15229156c8a4272c2b6063c9b1a0:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index 747572a..5eacaa2 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -23,12 +23,14 @@ structure Msg :> MSG = struct open OpenSSL MsgTypes Slave val a2i = fn Add => 0 - | Delete => 1 + | Delete true => 1 | Modify => 2 + | Delete false => 3 val i2a = fn 0 => Add - | 1 => Delete + | 1 => Delete true | 2 => Modify + | 3 => Delete false | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize" fun sendAcl (bio, {user, class, value}) = @@ -76,6 +78,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) @@ -116,9 +173,10 @@ fun send (bio, m) = | 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)) + | MsgCreateDb {dbtype, dbname, encoding} => (OpenSSL.writeInt (bio, 17); + OpenSSL.writeString (bio, dbtype); + OpenSSL.writeString (bio, dbname); + sendOption OpenSSL.writeString (bio, encoding)) | MsgNewMailbox {domain, user, passwd, mailbox} => (OpenSSL.writeInt (bio, 18); OpenSSL.writeString (bio, domain); @@ -143,6 +201,41 @@ 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)) + | MsgMysqlFixperms => OpenSSL.writeInt (bio, 38) + | MsgDescribe dom => (OpenSSL.writeInt (bio, 39); + OpenSSL.writeString (bio, dom)) + | MsgDescription s => (OpenSSL.writeInt (bio, 40); + OpenSSL.writeString (bio, s)) fun checkIt v = case v of @@ -197,9 +290,9 @@ fun recv bio = (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}) + | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio, recvOption OpenSSL.readString bio) of + (SOME dbtype, SOME dbname, SOME encoding) => + SOME (MsgCreateDb {dbtype = dbtype, dbname = dbname, encoding = encoding}) | _ => NONE) | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of @@ -226,6 +319,35 @@ 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 + | 39 => Option.map MsgDescribe (OpenSSL.readString bio) + | 40 => Option.map MsgDescription (OpenSSL.readString bio) | _ => NONE) end