DBMS database creation
[hcoop/domtool2.git] / src / acl.sml
CommitLineData
12adf55a
AC
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(* Per-user access control lists for resources various *)
20
21structure Acl :> ACL = struct
22
23type acl = {user : string,
24 class : string,
25 value : string}
26
27structure SM = DataStructures.StringMap
28structure SS = DataStructures.StringSet
29
30val acl : SS.set SM.map SM.map ref = ref SM.empty
31
32fun query {user, class, value} =
33 case SM.find (!acl, user) of
34 NONE => false
35 | SOME classes =>
36 case SM.find (classes, class) of
37 NONE => false
38 | SOME values => SS.member (values, value)
39
08a04eb4
AC
40fun queryAll user =
41 case SM.find (!acl, user) of
42 NONE => []
43 | SOME classes => SM.foldri (fn (class, values, out) =>
44 (class, SS.foldr (op::) [] values) :: out)
45 [] classes
46
1824f573
AC
47fun users () = SM.foldri (fn (user, _, ls) => user :: ls) [] (!acl)
48
094877b1
AC
49fun whoHas {class, value} =
50 SM.foldri (fn (user, classes, users) =>
51 case SM.find (classes, class) of
52 NONE => users
53 | SOME values =>
54 if SS.member (values, value) then
55 user :: users
56 else
57 users) [] (!acl)
58
12adf55a
AC
59fun class {user, class} =
60 case SM.find (!acl, user) of
61 NONE => SS.empty
62 | SOME classes =>
63 case SM.find (classes, class) of
64 NONE => SS.empty
65 | SOME values => values
66
e69e60cc
AC
67fun rmuser user =
68 (acl := #1 (SM.remove (!acl, user)))
69 handle NotFound => ()
70
12adf55a
AC
71fun grant {user, class, value} =
72 let
73 val classes = Option.getOpt (SM.find (!acl, user), SM.empty)
74 val values = Option.getOpt (SM.find (classes, class), SS.empty)
75 in
76 acl := SM.insert (!acl, user,
77 SM.insert (classes, class,
78 SS.add (values, value)))
79 end
80
81fun revoke {user, class, value} =
82 let
83 val classes = Option.getOpt (SM.find (!acl, user), SM.empty)
84 val values = Option.getOpt (SM.find (classes, class), SS.empty)
85
86 val values = if SS.member (values, value) then
87 SS.delete (values, value)
88 else
89 values
90 in
91 acl := SM.insert (!acl, user,
92 SM.insert (classes, class,
93 values))
94 end
95
e69e60cc
AC
96fun revokeFromAll {class, value} =
97 acl := SM.map (fn classes =>
98 case SM.find (classes, class) of
99 NONE => classes
100 | SOME values =>
101 ((SM.insert (classes, class, SS.delete (values, value)))
102 handle NotFound => classes)) (!acl)
103
12adf55a
AC
104fun read fname =
105 let
106 val inf = TextIO.openIn fname
107
108 fun users usrs =
109 case TextIO.inputLine inf of
110 NONE => usrs
111 | SOME line =>
112 case String.tokens Char.isSpace line of
113 [user] =>
114 let
115 fun classes clss =
116 case TextIO.inputLine inf of
117 NONE => clss
118 | SOME line =>
119 case String.tokens Char.isSpace line of
120 [] => clss
121 | class :: values =>
122 classes (SM.insert (clss, class,
123 foldl SS.add' SS.empty values))
124 in
125 users (SM.insert (usrs, user, classes SM.empty))
126 end
127 | _ => raise Fail "Unexpected ACL file format"
128 in
129 acl := users SM.empty
130 before TextIO.closeIn inf
131 end
132
133fun write fname =
134 let
135 val outf = TextIO.openOut fname
136
137 val writeValues = SS.app (fn value =>
138 (TextIO.output (outf, " ");
139 TextIO.output (outf, value)))
140
141 val writeClasses = SM.appi (fn (class, values) =>
e2ef704e
AC
142 if SS.isEmpty values then
143 ()
144 else
145 (TextIO.output (outf, class);
146 writeValues values;
147 TextIO.output (outf, "\n")))
12adf55a
AC
148
149 val writeUsers = SM.appi (fn (user, classes) =>
e2ef704e
AC
150 if SM.numItems classes = 0 then
151 ()
152 else
153 (TextIO.output (outf, user);
154 TextIO.output (outf, "\n");
155 writeClasses classes;
156 TextIO.output (outf, "\n")))
12adf55a
AC
157 in
158 writeUsers (!acl);
159 TextIO.closeOut outf
160 end
161
162end