X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/5ee41dd039e304ae374a5f1265e32839204f14ff..08a04eb413e8ee58ee35affc5c4125b622ea75c4:/src/msg.sml diff --git a/src/msg.sml b/src/msg.sml index 43b6386..f2c4d72 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -57,6 +57,19 @@ fun send (bio, m) = | 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); + app (fn (class, values) => + (OpenSSL.writeInt (bio, 1); + OpenSSL.writeString (bio, class); + app (fn value => + (OpenSSL.writeInt (bio, 1); + OpenSSL.writeString (bio, value))) values; + OpenSSL.writeInt (bio, 0))) classes; + OpenSSL.writeInt (bio, 0)) fun checkIt v = case v of @@ -85,6 +98,36 @@ fun recv bio = | 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 => let + fun loop classes = + case OpenSSL.readInt bio of + SOME 0 => SOME (MsgPerms (rev classes)) + | SOME 1 => + (case OpenSSL.readString bio of + SOME class => + let + fun loop' values = + case OpenSSL.readInt bio of + SOME 0 => loop ((class, rev values) :: classes) + | SOME 1 => + (case OpenSSL.readString bio of + SOME value => loop' (value :: values) + | NONE => NONE) + | _ => NONE + in + loop' [] + end + | NONE => NONE) + | _ => NONE + in + loop [] + end | _ => NONE) end