Testing queries on slave servers
[hcoop/zz_old/domtool2-proto.git] / src / msg.sml
CommitLineData
d330d9b8 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
21structure Msg :> MSG = struct
22
23open OpenSSL MsgTypes Slave
24
25val a2i = fn Add => 0
26 | Delete => 1
27 | Modify => 2
28
29val i2a = fn 0 => Add
30 | 1 => Delete
31 | 2 => Modify
32 | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize"
33
e2130d9c 34fun sendAcl (bio, {user, class, value}) =
35 (OpenSSL.writeString (bio, user);
36 OpenSSL.writeString (bio, class);
37 OpenSSL.writeString (bio, value))
38
39fun 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
c8a739af 44fun sendList f (bio, ls) =
45 (app (fn x =>
46 (OpenSSL.writeInt (bio, 1);
47 f (bio, x))) ls;
48 OpenSSL.writeInt (bio, 0))
49
50fun recvList f bio =
51 let
52 fun loop ls =
53 case OpenSSL.readInt bio of
54 SOME 0 => SOME (rev ls)
55 | SOME 1 =>
56 (case f bio of
57 SOME x => loop (x :: ls)
58 | NONE => NONE)
59 | _ => NONE
60 in
61 loop []
62 end
63
2bc895e7 64fun sendOption f (bio, opt) =
65 case opt of
66 NONE => OpenSSL.writeInt (bio, 0)
67 | SOME x => (OpenSSL.writeInt (bio, 1);
68 f (bio, x))
69
70fun recvOption f bio =
71 case OpenSSL.readInt bio of
72 SOME 0 => SOME NONE
73 | SOME 1 =>
74 (case f bio of
75 SOME x => SOME (SOME x)
76 | NONE => NONE)
77 | _ => NONE
78
bb8cc8c9 79fun sendBool (bio, b) =
80 if b then
81 OpenSSL.writeInt (bio, 1)
82 else
83 OpenSSL.writeInt (bio, 0)
84
85fun recvBool bio =
86 case OpenSSL.readInt bio of
87 SOME 0 => SOME false
88 | SOME 1 => SOME true
89 | _ => NONE
90
e5f8cb7b 91fun sendQuery (bio, q) =
92 case q of
93 QApt s => (OpenSSL.writeInt (bio, 0);
94 OpenSSL.writeString (bio, s))
95
96fun recvQuery bio =
97 case OpenSSL.readInt bio of
98 SOME n =>
99 (case n of
100 0 => Option.map QApt (OpenSSL.readString bio)
101 | _ => NONE)
102 | NONE => NONE
103
d330d9b8 104fun send (bio, m) =
105 case m of
106 MsgOk => OpenSSL.writeInt (bio, 1)
107 | MsgError s => (OpenSSL.writeInt (bio, 2);
108 OpenSSL.writeString (bio, s))
109 | MsgConfig s => (OpenSSL.writeInt (bio, 3);
110 OpenSSL.writeString (bio, s))
111 | MsgFile {action, domain, dir, file} =>
112 (OpenSSL.writeInt (bio, 4);
113 OpenSSL.writeInt (bio, a2i action);
114 OpenSSL.writeString (bio, domain);
115 OpenSSL.writeString (bio, dir);
116 OpenSSL.writeString (bio, file))
117 | MsgDoFiles => OpenSSL.writeInt (bio, 5)
e2130d9c 118 | MsgGrant acl => (OpenSSL.writeInt (bio, 6);
119 sendAcl (bio, acl))
d1aa6a21 120 | MsgRevoke acl => (OpenSSL.writeInt (bio, 7);
121 sendAcl (bio, acl))
646381db 122 | MsgListPerms user => (OpenSSL.writeInt (bio, 8);
123 OpenSSL.writeString (bio, user))
124 | MsgPerms classes => (OpenSSL.writeInt (bio, 9);
c8a739af 125 sendList (fn (bio, (class, values)) =>
126 (OpenSSL.writeString (bio, class);
127 sendList OpenSSL.writeString (bio, values)))
128 (bio, classes))
d0e75410 129 | MsgWhoHas {class, value} => (OpenSSL.writeInt (bio, 10);
130 OpenSSL.writeString (bio, class);
131 OpenSSL.writeString (bio, value))
132 | MsgWhoHasResponse users => (OpenSSL.writeInt (bio, 11);
c8a739af 133 sendList OpenSSL.writeString (bio, users))
134 | MsgMultiConfig codes => (OpenSSL.writeInt (bio, 12);
135 sendList OpenSSL.writeString (bio, codes))
aba1f07e 136 | MsgRmdom doms => (OpenSSL.writeInt (bio, 13);
137 sendList OpenSSL.writeString (bio, doms))
f92c6883 138 | MsgRegenerate => OpenSSL.writeInt (bio, 14)
aba1f07e 139 | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
140 OpenSSL.writeString (bio, dom))
2bc895e7 141 | MsgCreateDbUser {dbtype, passwd} => (OpenSSL.writeInt (bio, 16);
142 OpenSSL.writeString (bio, dbtype);
143 sendOption OpenSSL.writeString (bio, passwd))
d34cbcb8 144 | MsgCreateDbTable {dbtype, dbname} => (OpenSSL.writeInt (bio, 17);
145 OpenSSL.writeString (bio, dbtype);
146 OpenSSL.writeString (bio, dbname))
c45f1662 147 | MsgNewMailbox {domain, user, passwd, mailbox} =>
148 (OpenSSL.writeInt (bio, 18);
149 OpenSSL.writeString (bio, domain);
150 OpenSSL.writeString (bio, user);
151 OpenSSL.writeString (bio, passwd);
152 OpenSSL.writeString (bio, mailbox))
153 | MsgPasswdMailbox {domain, user, passwd} =>
154 (OpenSSL.writeInt (bio, 19);
155 OpenSSL.writeString (bio, domain);
156 OpenSSL.writeString (bio, user);
157 OpenSSL.writeString (bio, passwd))
158 | MsgRmMailbox {domain, user} =>
159 (OpenSSL.writeInt (bio, 20);
160 OpenSSL.writeString (bio, domain);
161 OpenSSL.writeString (bio, user))
0a58b2f3 162 | MsgListMailboxes domain =>
163 (OpenSSL.writeInt (bio, 21);
164 OpenSSL.writeString (bio, domain))
165 | MsgMailboxes users =>
166 (OpenSSL.writeInt (bio, 22);
1850d85f 167 sendList (fn (bio, {user, mailbox}) =>
168 (OpenSSL.writeString (bio, user);
169 OpenSSL.writeString (bio, mailbox)))
170 (bio, users))
bb8cc8c9 171 | MsgSaQuery addr => (OpenSSL.writeInt (bio, 23);
172 OpenSSL.writeString (bio, addr))
173 | MsgSaStatus b => (OpenSSL.writeInt (bio, 24);
174 sendBool (bio, b))
175 | MsgSaSet (addr, b) => (OpenSSL.writeInt (bio, 25);
176 OpenSSL.writeString (bio, addr);
177 sendBool (bio, b))
c685120e 178 | MsgSmtpLogReq domain => (OpenSSL.writeInt (bio, 26);
179 OpenSSL.writeString (bio, domain))
180 | MsgSmtpLogRes domain => (OpenSSL.writeInt (bio, 27);
181 OpenSSL.writeString (bio, domain))
dc6789fc 182 | MsgDbPasswd {dbtype, passwd} => (OpenSSL.writeInt (bio, 28);
183 OpenSSL.writeString (bio, dbtype);
184 OpenSSL.writeString (bio, passwd))
4c68bd31 185 | MsgShutdown => OpenSSL.writeInt (bio, 29)
8301e970 186 | MsgYes => OpenSSL.writeInt (bio, 30)
187 | MsgNo => OpenSSL.writeInt (bio, 31)
e5f8cb7b 188 | MsgQuery q => (OpenSSL.writeInt (bio, 32);
189 sendQuery (bio, q))
d330d9b8 190
191fun checkIt v =
192 case v of
193 NONE => raise OpenSSL.OpenSSL "Bad Msg format"
194 | _ => v
195
196fun recv bio =
197 case OpenSSL.readInt bio of
198 NONE => NONE
199 | SOME n =>
200 checkIt (case n of
201 1 => SOME MsgOk
202 | 2 => Option.map MsgError (OpenSSL.readString bio)
203 | 3 => Option.map MsgConfig (OpenSSL.readString bio)
204 | 4 => (case (OpenSSL.readInt bio,
205 OpenSSL.readString bio,
206 OpenSSL.readString bio,
207 OpenSSL.readString bio) of
208 (SOME action, SOME domain, SOME dir, SOME file) =>
209 SOME (MsgFile {action = i2a action,
210 domain = domain,
211 dir = dir,
212 file = file})
213 | _ => NONE)
214 | 5 => SOME MsgDoFiles
e2130d9c 215 | 6 => (case recvAcl bio of
216 SOME acl => SOME (MsgGrant acl)
217 | _ => NONE)
d1aa6a21 218 | 7 => (case recvAcl bio of
219 SOME acl => SOME (MsgRevoke acl)
220 | _ => NONE)
646381db 221 | 8 => (case OpenSSL.readString bio of
222 SOME user => SOME (MsgListPerms user)
223 | _ => NONE)
c8a739af 224 | 9 => Option.map MsgPerms
225 (recvList (fn bio =>
226 case (OpenSSL.readString bio,
227 recvList OpenSSL.readString bio) of
228 (SOME class, SOME values) => SOME (class, values)
229 | _ => NONE) bio)
d0e75410 230 | 10 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
231 (SOME class, SOME value) => SOME (MsgWhoHas {class = class, value = value})
232 | _ => NONE)
c8a739af 233 | 11 => Option.map MsgWhoHasResponse
234 (recvList OpenSSL.readString bio)
235 | 12 => Option.map MsgMultiConfig
236 (recvList OpenSSL.readString bio)
aba1f07e 237 | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio)
f92c6883 238 | 14 => SOME MsgRegenerate
aba1f07e 239 | 15 => Option.map MsgRmuser (OpenSSL.readString bio)
2bc895e7 240 | 16 => (case (OpenSSL.readString bio, recvOption OpenSSL.readString bio) of
241 (SOME dbtype, SOME passwd) =>
242 SOME (MsgCreateDbUser {dbtype = dbtype, passwd = passwd})
243 | _ => NONE)
d34cbcb8 244 | 17 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
245 (SOME dbtype, SOME dbname) =>
246 SOME (MsgCreateDbTable {dbtype = dbtype, dbname = dbname})
247 | _ => NONE)
c45f1662 248 | 18 => (case (OpenSSL.readString bio, OpenSSL.readString bio,
249 OpenSSL.readString bio, OpenSSL.readString bio) of
250 (SOME domain, SOME user, SOME passwd, SOME mailbox) =>
251 SOME (MsgNewMailbox {domain = domain, user = user,
252 passwd = passwd, mailbox = mailbox})
253 | _ => NONE)
254 | 19 => (case (OpenSSL.readString bio, OpenSSL.readString bio,
255 OpenSSL.readString bio) of
256 (SOME domain, SOME user, SOME passwd) =>
257 SOME (MsgPasswdMailbox {domain = domain, user = user,
258 passwd = passwd})
259 | _ => NONE)
260 | 20 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
261 (SOME domain, SOME user) =>
262 SOME (MsgRmMailbox {domain = domain, user = user})
263 | _ => NONE)
0a58b2f3 264 | 21 => Option.map MsgListMailboxes (OpenSSL.readString bio)
1850d85f 265 | 22 => Option.map MsgMailboxes (recvList
266 (fn bio =>
267 case (OpenSSL.readString bio,
268 OpenSSL.readString bio) of
269 (SOME user, SOME mailbox) =>
270 SOME {user = user, mailbox = mailbox}
271 | _ => NONE)
272 bio)
bb8cc8c9 273 | 23 => Option.map MsgSaQuery (OpenSSL.readString bio)
274 | 24 => Option.map MsgSaStatus (recvBool bio)
275 | 25 => (case (OpenSSL.readString bio, recvBool bio) of
276 (SOME user, SOME b) => SOME (MsgSaSet (user, b))
277 | _ => NONE)
c685120e 278 | 26 => Option.map MsgSmtpLogReq (OpenSSL.readString bio)
279 | 27 => Option.map MsgSmtpLogRes (OpenSSL.readString bio)
dc6789fc 280 | 28 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
281 (SOME dbtype, SOME passwd) =>
282 SOME (MsgDbPasswd {dbtype = dbtype, passwd = passwd})
283 | _ => NONE)
4c68bd31 284 | 29 => SOME MsgShutdown
8301e970 285 | 30 => SOME MsgYes
286 | 31 => SOME MsgNo
e5f8cb7b 287 | 32 => Option.map MsgQuery (recvQuery bio)
d330d9b8 288 | _ => NONE)
289
290end