Listing permissions
[hcoop/domtool2.git] / src / msg.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19 (* Network messages *)
20
21 structure Msg :> MSG = struct
22
23 open OpenSSL MsgTypes Slave
24
25 val a2i = fn Add => 0
26 | Delete => 1
27 | Modify => 2
28
29 val i2a = fn 0 => Add
30 | 1 => Delete
31 | 2 => Modify
32 | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize"
33
34 fun sendAcl (bio, {user, class, value}) =
35 (OpenSSL.writeString (bio, user);
36 OpenSSL.writeString (bio, class);
37 OpenSSL.writeString (bio, value))
38
39 fun recvAcl bio =
40 case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of
41 (SOME user, SOME class, SOME value) => SOME {user = user, class = class, value = value}
42 | _ => NONE
43
44 fun send (bio, m) =
45 case m of
46 MsgOk => OpenSSL.writeInt (bio, 1)
47 | MsgError s => (OpenSSL.writeInt (bio, 2);
48 OpenSSL.writeString (bio, s))
49 | MsgConfig s => (OpenSSL.writeInt (bio, 3);
50 OpenSSL.writeString (bio, s))
51 | MsgFile {action, domain, dir, file} =>
52 (OpenSSL.writeInt (bio, 4);
53 OpenSSL.writeInt (bio, a2i action);
54 OpenSSL.writeString (bio, domain);
55 OpenSSL.writeString (bio, dir);
56 OpenSSL.writeString (bio, file))
57 | MsgDoFiles => OpenSSL.writeInt (bio, 5)
58 | MsgGrant acl => (OpenSSL.writeInt (bio, 6);
59 sendAcl (bio, acl))
60 | MsgRevoke acl => (OpenSSL.writeInt (bio, 7);
61 sendAcl (bio, acl))
62 | MsgListPerms user => (OpenSSL.writeInt (bio, 8);
63 OpenSSL.writeString (bio, user))
64 | MsgPerms classes => (OpenSSL.writeInt (bio, 9);
65 app (fn (class, values) =>
66 (OpenSSL.writeInt (bio, 1);
67 OpenSSL.writeString (bio, class);
68 app (fn value =>
69 (OpenSSL.writeInt (bio, 1);
70 OpenSSL.writeString (bio, value))) values;
71 OpenSSL.writeInt (bio, 0))) classes;
72 OpenSSL.writeInt (bio, 0))
73
74 fun checkIt v =
75 case v of
76 NONE => raise OpenSSL.OpenSSL "Bad Msg format"
77 | _ => v
78
79 fun recv bio =
80 case OpenSSL.readInt bio of
81 NONE => NONE
82 | SOME n =>
83 checkIt (case n of
84 1 => SOME MsgOk
85 | 2 => Option.map MsgError (OpenSSL.readString bio)
86 | 3 => Option.map MsgConfig (OpenSSL.readString bio)
87 | 4 => (case (OpenSSL.readInt bio,
88 OpenSSL.readString bio,
89 OpenSSL.readString bio,
90 OpenSSL.readString bio) of
91 (SOME action, SOME domain, SOME dir, SOME file) =>
92 SOME (MsgFile {action = i2a action,
93 domain = domain,
94 dir = dir,
95 file = file})
96 | _ => NONE)
97 | 5 => SOME MsgDoFiles
98 | 6 => (case recvAcl bio of
99 SOME acl => SOME (MsgGrant acl)
100 | _ => NONE)
101 | 7 => (case recvAcl bio of
102 SOME acl => SOME (MsgRevoke acl)
103 | _ => NONE)
104 | 8 => (case OpenSSL.readString bio of
105 SOME user => SOME (MsgListPerms user)
106 | _ => NONE)
107 | 9 => let
108 fun loop classes =
109 case OpenSSL.readInt bio of
110 SOME 0 => SOME (MsgPerms (rev classes))
111 | SOME 1 =>
112 (case OpenSSL.readString bio of
113 SOME class =>
114 let
115 fun loop' values =
116 case OpenSSL.readInt bio of
117 SOME 0 => loop ((class, rev values) :: classes)
118 | SOME 1 =>
119 (case OpenSSL.readString bio of
120 SOME value => loop' (value :: values)
121 | NONE => NONE)
122 | _ => NONE
123 in
124 loop' []
125 end
126 | NONE => NONE)
127 | _ => NONE
128 in
129 loop []
130 end
131 | _ => NONE)
132
133 end