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
32 | _
=> raise OpenSSL
.OpenSSL
"Bad action number to deserialize"
34 fun sendAcl (bio
, {user
, class
, value
}) =
35 (OpenSSL
.writeString (bio
, user
);
36 OpenSSL
.writeString (bio
, class
);
37 OpenSSL
.writeString (bio
, value
))
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
}
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);
60 | MsgRevoke acl
=> (OpenSSL
.writeInt (bio
, 7);
65 NONE
=> raise OpenSSL
.OpenSSL
"Bad Msg format"
69 case OpenSSL
.readInt bio
of
74 |
2 => Option
.map
MsgError (OpenSSL
.readString bio
)
75 |
3 => Option
.map
MsgConfig (OpenSSL
.readString bio
)
76 |
4 => (case (OpenSSL
.readInt bio
,
77 OpenSSL
.readString bio
,
78 OpenSSL
.readString bio
,
79 OpenSSL
.readString bio
) of
80 (SOME action
, SOME domain
, SOME dir
, SOME file
) =>
81 SOME (MsgFile
{action
= i2a action
,
86 |
5 => SOME MsgDoFiles
87 |
6 => (case recvAcl bio
of
88 SOME acl
=> SOME (MsgGrant acl
)
90 |
7 => (case recvAcl bio
of
91 SOME acl
=> SOME (MsgRevoke acl
)