X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/9f27d58f1ce0833bb5460d7ca612c74f378548a1..1ffc47a68def0e10e393ad4d8e62b7d6f7300c01:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index f05d012..5940bbe 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -88,6 +88,49 @@ fun recvBool bio = | 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) @@ -128,9 +171,9 @@ 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} => (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); @@ -170,6 +213,26 @@ fun send (bio, m) = 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 @@ -226,7 +289,7 @@ fun recv bio = | _ => NONE) | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of (SOME dbtype, SOME dbname) => - SOME (MsgCreateDbTable {dbtype = dbtype, dbname = dbname}) + SOME (MsgCreateDb {dbtype = dbtype, dbname = dbname}) | _ => NONE) | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of @@ -265,6 +328,23 @@ fun recv bio = 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