X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/36e42cb86393a7b9e333ecd7edfbdd16c7d9a1ac..77a8fca278b561808959fa1aa7d9f02c5cfe7720:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index 4dcc3ff..bb6a2b1 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -31,6 +31,36 @@ val i2a = fn 0 => Add | 2 => Modify | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize" +fun sendAcl (bio, {user, class, value}) = + (OpenSSL.writeString (bio, user); + OpenSSL.writeString (bio, class); + OpenSSL.writeString (bio, value)) + +fun recvAcl bio = + case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of + (SOME user, SOME class, SOME value) => SOME {user = user, class = class, value = value} + | _ => NONE + +fun sendList f (bio, ls) = + (app (fn x => + (OpenSSL.writeInt (bio, 1); + f (bio, x))) ls; + OpenSSL.writeInt (bio, 0)) + +fun recvList f bio = + let + fun loop ls = + case OpenSSL.readInt bio of + SOME 0 => SOME (rev ls) + | SOME 1 => + (case f bio of + SOME x => loop (x :: ls) + | NONE => NONE) + | _ => NONE + in + loop [] + end + fun send (bio, m) = case m of MsgOk => OpenSSL.writeInt (bio, 1) @@ -45,6 +75,27 @@ fun send (bio, m) = OpenSSL.writeString (bio, dir); OpenSSL.writeString (bio, file)) | MsgDoFiles => OpenSSL.writeInt (bio, 5) + | MsgGrant acl => (OpenSSL.writeInt (bio, 6); + sendAcl (bio, acl)) + | MsgRevoke acl => (OpenSSL.writeInt (bio, 7); + sendAcl (bio, acl)) + | MsgListPerms user => (OpenSSL.writeInt (bio, 8); + OpenSSL.writeString (bio, user)) + | MsgPerms classes => (OpenSSL.writeInt (bio, 9); + sendList (fn (bio, (class, values)) => + (OpenSSL.writeString (bio, class); + sendList OpenSSL.writeString (bio, values))) + (bio, classes)) + | MsgWhoHas {class, value} => (OpenSSL.writeInt (bio, 10); + OpenSSL.writeString (bio, class); + OpenSSL.writeString (bio, value)) + | MsgWhoHasResponse users => (OpenSSL.writeInt (bio, 11); + sendList OpenSSL.writeString (bio, users)) + | MsgMultiConfig codes => (OpenSSL.writeInt (bio, 12); + sendList OpenSSL.writeString (bio, codes)) + | MsgRmdom dom => (OpenSSL.writeInt (bio, 13); + OpenSSL.writeString (bio, dom)) + | MsgRegenerate => OpenSSL.writeInt (bio, 14) fun checkIt v = case v of @@ -70,6 +121,30 @@ fun recv bio = file = file}) | _ => NONE) | 5 => SOME MsgDoFiles + | 6 => (case recvAcl bio of + SOME acl => SOME (MsgGrant acl) + | _ => NONE) + | 7 => (case recvAcl bio of + SOME acl => SOME (MsgRevoke acl) + | _ => NONE) + | 8 => (case OpenSSL.readString bio of + SOME user => SOME (MsgListPerms user) + | _ => NONE) + | 9 => Option.map MsgPerms + (recvList (fn bio => + case (OpenSSL.readString bio, + recvList OpenSSL.readString bio) of + (SOME class, SOME values) => SOME (class, values) + | _ => NONE) bio) + | 10 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of + (SOME class, SOME value) => SOME (MsgWhoHas {class = class, value = value}) + | _ => NONE) + | 11 => Option.map MsgWhoHasResponse + (recvList OpenSSL.readString bio) + | 12 => Option.map MsgMultiConfig + (recvList OpenSSL.readString bio) + | 13 => Option.map MsgRmdom (OpenSSL.readString bio) + | 14 => SOME MsgRegenerate | _ => NONE) end