1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, Adam Chlipala
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
.
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
.
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
.
19 (* Network messages
*)
21 structure Msg
:> MSG
= struct
23 open OpenSSL MsgTypes Slave
34 | _
=> raise OpenSSL
.OpenSSL
"Bad action number to deserialize"
36 fun sendAcl (bio
, {user
, class
, value
}) =
37 (OpenSSL
.writeString (bio
, user
);
38 OpenSSL
.writeString (bio
, class
);
39 OpenSSL
.writeString (bio
, value
))
42 case (OpenSSL
.readString bio
, OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
43 (SOME user
, SOME class
, SOME value
) => SOME
{user
= user
, class
= class
, value
= value
}
46 fun sendList
f (bio
, ls
) =
48 (OpenSSL
.writeInt (bio
, 1);
50 OpenSSL
.writeInt (bio
, 0))
55 case OpenSSL
.readInt bio
of
56 SOME
0 => SOME (rev ls
)
59 SOME x
=> loop (x
:: ls
)
66 fun sendOption
f (bio
, opt
) =
68 NONE
=> OpenSSL
.writeInt (bio
, 0)
69 | SOME x
=> (OpenSSL
.writeInt (bio
, 1);
72 fun recvOption f bio
=
73 case OpenSSL
.readInt bio
of
77 SOME x
=> SOME (SOME x
)
81 fun sendBool (bio
, b
) =
83 OpenSSL
.writeInt (bio
, 1)
85 OpenSSL
.writeInt (bio
, 0)
88 case OpenSSL
.readInt bio
of
93 fun sendSockPerm (bio
, p
) =
95 Any
=> OpenSSL
.writeInt (bio
, 0)
96 | Client
=> OpenSSL
.writeInt (bio
, 1)
97 | Server
=> OpenSSL
.writeInt (bio
, 2)
98 | Nada
=> OpenSSL
.writeInt (bio
, 3)
100 fun recvSockPerm bio
=
101 case OpenSSL
.readInt bio
of
103 | SOME
1 => SOME Client
104 | SOME
2 => SOME Server
105 | SOME
3 => SOME Nada
108 fun sendQuery (bio
, q
) =
110 QApt s
=> (OpenSSL
.writeInt (bio
, 0);
111 OpenSSL
.writeString (bio
, s
))
112 | QCron s
=> (OpenSSL
.writeInt (bio
, 1);
113 OpenSSL
.writeString (bio
, s
))
114 | QFtp s
=> (OpenSSL
.writeInt (bio
, 2);
115 OpenSSL
.writeString (bio
, s
))
116 | QTrustedPath s
=> (OpenSSL
.writeInt (bio
, 3);
117 OpenSSL
.writeString (bio
, s
))
118 | QSocket s
=> (OpenSSL
.writeInt (bio
, 4);
119 OpenSSL
.writeString (bio
, s
))
120 | QFirewall
{node
, user
} => (OpenSSL
.writeInt (bio
, 5);
121 OpenSSL
.writeString (bio
, node
);
122 OpenSSL
.writeString (bio
, user
))
123 | QAptExists s
=> (OpenSSL
.writeInt (bio
, 6);
124 OpenSSL
.writeString (bio
, s
))
127 case OpenSSL
.readInt bio
of
130 0 => Option
.map
QApt (OpenSSL
.readString bio
)
131 |
1 => Option
.map
QCron (OpenSSL
.readString bio
)
132 |
2 => Option
.map
QFtp (OpenSSL
.readString bio
)
133 |
3 => Option
.map
QTrustedPath (OpenSSL
.readString bio
)
134 |
4 => Option
.map
QSocket (OpenSSL
.readString bio
)
135 |
5 => (case ((OpenSSL
.readString bio
), (OpenSSL
.readString bio
)) of
136 (SOME node
, SOME user
) => SOME (QFirewall
{ node
= node
, user
= user
})
138 |
6 => Option
.map
QAptExists (OpenSSL
.readString bio
)
144 MsgOk
=> OpenSSL
.writeInt (bio
, 1)
145 | MsgError s
=> (OpenSSL
.writeInt (bio
, 2);
146 OpenSSL
.writeString (bio
, s
))
147 | MsgConfig s
=> (OpenSSL
.writeInt (bio
, 3);
148 OpenSSL
.writeString (bio
, s
))
149 | MsgFile
{action
, domain
, dir
, file
} =>
150 (OpenSSL
.writeInt (bio
, 4);
151 OpenSSL
.writeInt (bio
, a2i action
);
152 OpenSSL
.writeString (bio
, domain
);
153 OpenSSL
.writeString (bio
, dir
);
154 OpenSSL
.writeString (bio
, file
))
155 | MsgDoFiles
=> OpenSSL
.writeInt (bio
, 5)
156 | MsgGrant acl
=> (OpenSSL
.writeInt (bio
, 6);
158 | MsgRevoke acl
=> (OpenSSL
.writeInt (bio
, 7);
160 | MsgListPerms user
=> (OpenSSL
.writeInt (bio
, 8);
161 OpenSSL
.writeString (bio
, user
))
162 | MsgPerms classes
=> (OpenSSL
.writeInt (bio
, 9);
163 sendList (fn (bio
, (class
, values
)) =>
164 (OpenSSL
.writeString (bio
, class
);
165 sendList OpenSSL
.writeString (bio
, values
)))
167 | MsgWhoHas
{class
, value
} => (OpenSSL
.writeInt (bio
, 10);
168 OpenSSL
.writeString (bio
, class
);
169 OpenSSL
.writeString (bio
, value
))
170 | MsgWhoHasResponse users
=> (OpenSSL
.writeInt (bio
, 11);
171 sendList OpenSSL
.writeString (bio
, users
))
172 | MsgMultiConfig codes
=> (OpenSSL
.writeInt (bio
, 12);
173 sendList OpenSSL
.writeString (bio
, codes
))
174 | MsgRmdom doms
=> (OpenSSL
.writeInt (bio
, 13);
175 sendList OpenSSL
.writeString (bio
, doms
))
176 | MsgRegenerate
=> OpenSSL
.writeInt (bio
, 14)
177 | MsgRmuser dom
=> (OpenSSL
.writeInt (bio
, 15);
178 OpenSSL
.writeString (bio
, dom
))
179 | MsgCreateDbUser
{dbtype
, passwd
} => (OpenSSL
.writeInt (bio
, 16);
180 OpenSSL
.writeString (bio
, dbtype
);
181 sendOption OpenSSL
.writeString (bio
, passwd
))
182 | MsgCreateDb
{dbtype
, dbname
, encoding
} => (OpenSSL
.writeInt (bio
, 17);
183 OpenSSL
.writeString (bio
, dbtype
);
184 OpenSSL
.writeString (bio
, dbname
);
185 sendOption OpenSSL
.writeString (bio
, encoding
))
186 | MsgNewMailbox
{domain
, user
, passwd
, mailbox
} =>
187 (OpenSSL
.writeInt (bio
, 18);
188 OpenSSL
.writeString (bio
, domain
);
189 OpenSSL
.writeString (bio
, user
);
190 OpenSSL
.writeString (bio
, passwd
);
191 OpenSSL
.writeString (bio
, mailbox
))
192 | MsgPasswdMailbox
{domain
, user
, passwd
} =>
193 (OpenSSL
.writeInt (bio
, 19);
194 OpenSSL
.writeString (bio
, domain
);
195 OpenSSL
.writeString (bio
, user
);
196 OpenSSL
.writeString (bio
, passwd
))
197 | MsgRmMailbox
{domain
, user
} =>
198 (OpenSSL
.writeInt (bio
, 20);
199 OpenSSL
.writeString (bio
, domain
);
200 OpenSSL
.writeString (bio
, user
))
201 | MsgListMailboxes domain
=>
202 (OpenSSL
.writeInt (bio
, 21);
203 OpenSSL
.writeString (bio
, domain
))
204 | MsgMailboxes users
=>
205 (OpenSSL
.writeInt (bio
, 22);
206 sendList (fn (bio
, {user
, mailbox
}) =>
207 (OpenSSL
.writeString (bio
, user
);
208 OpenSSL
.writeString (bio
, mailbox
)))
210 | MsgSaQuery addr
=> (OpenSSL
.writeInt (bio
, 23);
211 OpenSSL
.writeString (bio
, addr
))
212 | MsgSaStatus b
=> (OpenSSL
.writeInt (bio
, 24);
214 |
MsgSaSet (addr
, b
) => (OpenSSL
.writeInt (bio
, 25);
215 OpenSSL
.writeString (bio
, addr
);
217 | MsgSmtpLogReq domain
=> (OpenSSL
.writeInt (bio
, 26);
218 OpenSSL
.writeString (bio
, domain
))
219 | MsgSmtpLogRes domain
=> (OpenSSL
.writeInt (bio
, 27);
220 OpenSSL
.writeString (bio
, domain
))
221 | MsgDbPasswd
{dbtype
, passwd
} => (OpenSSL
.writeInt (bio
, 28);
222 OpenSSL
.writeString (bio
, dbtype
);
223 OpenSSL
.writeString (bio
, passwd
))
224 | MsgShutdown
=> OpenSSL
.writeInt (bio
, 29)
225 | MsgYes
=> OpenSSL
.writeInt (bio
, 30)
226 | MsgNo
=> OpenSSL
.writeInt (bio
, 31)
227 | MsgQuery q
=> (OpenSSL
.writeInt (bio
, 32);
229 | MsgSocket p
=> (OpenSSL
.writeInt (bio
, 33);
230 sendSockPerm (bio
, p
))
231 | MsgFirewall ls
=> (OpenSSL
.writeInt (bio
, 34);
232 sendList OpenSSL
.writeString (bio
, ls
))
233 | MsgRegenerateTc
=> OpenSSL
.writeInt (bio
, 35)
234 | MsgDropDb
{dbtype
, dbname
} => (OpenSSL
.writeInt (bio
, 36);
235 OpenSSL
.writeString (bio
, dbtype
);
236 OpenSSL
.writeString (bio
, dbname
))
237 | MsgGrantDb
{dbtype
, dbname
} => (OpenSSL
.writeInt (bio
, 37);
238 OpenSSL
.writeString (bio
, dbtype
);
239 OpenSSL
.writeString (bio
, dbname
))
240 | MsgMysqlFixperms
=> OpenSSL
.writeInt (bio
, 38)
241 | MsgDescribe dom
=> (OpenSSL
.writeInt (bio
, 39);
242 OpenSSL
.writeString (bio
, dom
))
243 | MsgDescription s
=> (OpenSSL
.writeInt (bio
, 40);
244 OpenSSL
.writeString (bio
, s
))
245 | MsgReUsers
=> OpenSSL
.writeInt (bio
, 41)
246 | MsgVmailChanged
=> OpenSSL
.writeInt (bio
, 42)
247 | MsgFirewallRegen
=> OpenSSL
.writeInt (bio
, 43)
248 | MsgAptQuery
{section
, description
} => (OpenSSL
.writeInt (bio
, 44);
249 OpenSSL
.writeString (bio
, section
);
250 OpenSSL
.writeString (bio
, description
))
254 NONE
=> raise OpenSSL
.OpenSSL
"Bad Msg format"
258 case OpenSSL
.readInt bio
of
263 |
2 => Option
.map
MsgError (OpenSSL
.readString bio
)
264 |
3 => Option
.map
MsgConfig (OpenSSL
.readString bio
)
265 |
4 => (case (OpenSSL
.readInt bio
,
266 OpenSSL
.readString bio
,
267 OpenSSL
.readString bio
,
268 OpenSSL
.readString bio
) of
269 (SOME action
, SOME domain
, SOME dir
, SOME file
) =>
270 SOME (MsgFile
{action
= i2a action
,
275 |
5 => SOME MsgDoFiles
276 |
6 => (case recvAcl bio
of
277 SOME acl
=> SOME (MsgGrant acl
)
279 |
7 => (case recvAcl bio
of
280 SOME acl
=> SOME (MsgRevoke acl
)
282 |
8 => (case OpenSSL
.readString bio
of
283 SOME user
=> SOME (MsgListPerms user
)
285 |
9 => Option
.map MsgPerms
287 case (OpenSSL
.readString bio
,
288 recvList OpenSSL
.readString bio
) of
289 (SOME class
, SOME values
) => SOME (class
, values
)
291 |
10 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
292 (SOME class
, SOME value
) => SOME (MsgWhoHas
{class
= class
, value
= value
})
294 |
11 => Option
.map MsgWhoHasResponse
295 (recvList OpenSSL
.readString bio
)
296 |
12 => Option
.map MsgMultiConfig
297 (recvList OpenSSL
.readString bio
)
298 |
13 => Option
.map
MsgRmdom (recvList OpenSSL
.readString bio
)
299 |
14 => SOME MsgRegenerate
300 |
15 => Option
.map
MsgRmuser (OpenSSL
.readString bio
)
301 |
16 => (case (OpenSSL
.readString bio
, recvOption OpenSSL
.readString bio
) of
302 (SOME dbtype
, SOME passwd
) =>
303 SOME (MsgCreateDbUser
{dbtype
= dbtype
, passwd
= passwd
})
305 |
17 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
, recvOption OpenSSL
.readString bio
) of
306 (SOME dbtype
, SOME dbname
, SOME encoding
) =>
307 SOME (MsgCreateDb
{dbtype
= dbtype
, dbname
= dbname
, encoding
= encoding
})
309 |
18 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
,
310 OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
311 (SOME domain
, SOME user
, SOME passwd
, SOME mailbox
) =>
312 SOME (MsgNewMailbox
{domain
= domain
, user
= user
,
313 passwd
= passwd
, mailbox
= mailbox
})
315 |
19 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
,
316 OpenSSL
.readString bio
) of
317 (SOME domain
, SOME user
, SOME passwd
) =>
318 SOME (MsgPasswdMailbox
{domain
= domain
, user
= user
,
321 |
20 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
322 (SOME domain
, SOME user
) =>
323 SOME (MsgRmMailbox
{domain
= domain
, user
= user
})
325 |
21 => Option
.map
MsgListMailboxes (OpenSSL
.readString bio
)
326 |
22 => Option
.map
MsgMailboxes (recvList
328 case (OpenSSL
.readString bio
,
329 OpenSSL
.readString bio
) of
330 (SOME user
, SOME mailbox
) =>
331 SOME
{user
= user
, mailbox
= mailbox
}
334 |
23 => Option
.map
MsgSaQuery (OpenSSL
.readString bio
)
335 |
24 => Option
.map
MsgSaStatus (recvBool bio
)
336 |
25 => (case (OpenSSL
.readString bio
, recvBool bio
) of
337 (SOME user
, SOME b
) => SOME (MsgSaSet (user
, b
))
339 |
26 => Option
.map
MsgSmtpLogReq (OpenSSL
.readString bio
)
340 |
27 => Option
.map
MsgSmtpLogRes (OpenSSL
.readString bio
)
341 |
28 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
342 (SOME dbtype
, SOME passwd
) =>
343 SOME (MsgDbPasswd
{dbtype
= dbtype
, passwd
= passwd
})
345 |
29 => SOME MsgShutdown
348 |
32 => Option
.map
MsgQuery (recvQuery bio
)
349 |
33 => Option
.map
MsgSocket (recvSockPerm bio
)
350 |
34 => Option
.map
MsgFirewall (recvList OpenSSL
.readString bio
)
351 |
35 => SOME MsgRegenerateTc
352 |
36 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
353 (SOME dbtype
, SOME dbname
) =>
354 SOME (MsgDropDb
{dbtype
= dbtype
, dbname
= dbname
})
356 |
37 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
357 (SOME dbtype
, SOME dbname
) =>
358 SOME (MsgGrantDb
{dbtype
= dbtype
, dbname
= dbname
})
360 |
38 => SOME MsgMysqlFixperms
361 |
39 => Option
.map
MsgDescribe (OpenSSL
.readString bio
)
362 |
40 => Option
.map
MsgDescription (OpenSSL
.readString bio
)
363 |
41 => SOME MsgReUsers
364 |
42 => SOME MsgVmailChanged
365 |
43 => SOME MsgFirewallRegen
366 |
44 => (case (OpenSSL
.readString bio
, OpenSSL
.readString bio
) of
367 (SOME section
, SOME description
) => SOME (MsgAptQuery
{section
= section
, description
= description
})