/dylan/access.dylan

  1Module: %wiki
  2
  3//// Access Control Lists
  4
  5/*
  6
  7How ACLs work...
  8
  9There are three types of access defined:
 10
 11* read-content
 12* modify-content
 13* modify-acls
 14
 15In the future it may be useful to define additional types of access.
 16
 17Permissions may be granted to specific users, groups of users, and
 18three pre-defined groups:
 19
 20* anyone -- anyone at all
 21* trusted -- anyone who can login
 22* owner -- owner of the page
 23
 24Any access rule may be negated, so that for example "deny anyone"
 25or "deny <user>" may be specified.  In the code this is represented
 26as a sequence such as #($deny, <user>).
 27
 28If no ACLs are set for a page then the default ACLs are used instead.
 29(The defaults need to be made configurable.)
 30
 31Once you set any ACLs at all for a page, they fully determine the
 32access rights.  For example, there is no global default for everyone
 33to be able to read a page unless explicitly disabled.  This means,
 34for example, that if you want to prevent a specific group from
 35viewing a page you must specify a read-content ACL like this:
 36
 37  deny <group>
 38  allow anyone
 39
 40If "anyone" isn't included then no read access is granted to anyone
 41(including the group).
 42
 43ACLs are tested in order; the first access rule to match either
 44grants or denies the permission.  For example, if an admin or the
 45page owner wants to quickly disable a page they could simply add
 46"deny anyone" at the front of the ACLs.
 47
 48Note that admins are always allowed all access.  There is also no
 49mechanism to deny access to the owner of a page via acls.  If you
 50need to do that, disable the owner's account or change the ownership
 51of the page.
 52
 53Example: Anyone but cgay and group1 can view content
 54
 55  view-content: list(list($deny, <user cgay>),
 56                     list($deny, <group group1>),
 57                     list($allow, $anyone))
 58
 59*/
 60
 61define constant $view-content = #"view-content";
 62define constant $modify-content = #"modify-content";
 63define constant $modify-acls = #"modify-acls";
 64define constant <acl-operation> :: <type>
 65  = one-of($view-content, $modify-content, $modify-acls);
 66
 67define constant $anyone = #"anyone";
 68define constant $trusted = #"trusted";
 69define constant $owner = #"owner";
 70
 71define constant $allow = #"allow";
 72define constant $deny = #"deny";
 73
 74// The compiler barfs on this when I uncomment things.
 75//
 76define constant <rule-target> //:: <type>
 77  = type-union(<symbol>, //one-of($anyone, $trusted, $owner),
 78               <wiki-user>,
 79               <wiki-group>);
 80
 81define class <rule> (<object>)
 82  constant slot rule-action :: one-of($allow, $deny),
 83    required-init-keyword: action:;
 84  constant slot rule-target :: <rule-target>,
 85    required-init-keyword: target:;
 86end;
 87
 88define class <acls> (<object>)
 89  // Must hold this lock before modifying the values in any
 90  // of the other slots.
 91  //constant slot acls-lock :: <simple-lock> = make(<simple-lock>);
 92
 93  // The following are sequences of <rule>, but limited collections
 94  // are too broken to use in my experience. :-(
 95
 96  slot view-content-rules :: <sequence> = #(),
 97    init-keyword: view-content:;
 98  slot modify-content-rules :: <sequence> = #(),
 99    init-keyword: modify-content:;
100  slot modify-acls-rules :: <sequence> = #(),
101    init-keyword: modify-acls:;
102end class <acls>;
103
104define method make
105    (class :: subclass(<acls>), #key view-content, modify-content, modify-acls)
106 => (object :: <acls>)
107  // Make sure the ACLs can't be modified by mutating the sequences
108  // after creation.
109  apply(next-method, class,
110        view-content:   slice(view-content, 0, #f),
111        modify-content: slice(modify-content, 0, #f),
112        modify-acls:    slice(modify-acls, 0, #f),
113        #())
114end method make;
115
116define method remove-rules-for-target
117    (acls :: <acls>, target :: <rule-target>)
118  local method not-for-target (rule)
119          rule.rule-target ~= target
120        end;
121  //with-lock ($acls-lock /* acls.acls-lock */)
122    acls.view-content-rules := choose(not-for-target, acls.view-content-rules);
123    acls.modify-content-rules := choose(not-for-target, acls.modify-content-rules);
124    acls.modify-acls-rules := choose(not-for-target, acls.modify-acls-rules);
125  //end;
126end method remove-rules-for-target;
127
128// Default access controls applied to pages that don't otherwise specify
129// any ACLs.  (But admins are omnipotent.)
130//
131define constant $default-access-controls
132  = make(<acls>,
133         view-content:   list(make(<rule>, action: $allow, target: $anyone)),
134         modify-content: list(make(<rule>, action: $allow, target: $trusted)),
135         modify-acls:    list(make(<rule>, action: $allow, target: $owner)));
136
137define method has-permission?
138    (user :: false-or(<wiki-user>),
139     page :: false-or(<wiki-page>),
140     requested-operation :: <acl-operation>)
141 => (has-permission? :: <boolean>)
142  // If user is #f then they're not logged in.
143  // If page is #f then it's a new page being created.
144
145  // Admins can do anything for now.  Eventually it may be useful to have
146  // two levels of admins: those who can modify any content and those who
147  // can do anything.
148
149  // Page owner cannot be denied access either.  (If an admin wants to do
150  // that they should be able to handle it via other means, such as disabling
151  // the account or changing the page owner.)  I'm actually not totally sure
152  // this is the right design decision.  My thinking is that it's too easy
153  // for the owner to accidentally lock him/herself out, and it could generate
154  // a lot of admin requests.
155
156  if (user & (~page | administrator?(user) | page.page-owner = user))
157    #t
158  else
159    let acls :: <acls> = iff(page,
160                             page.page-access-controls,
161                             $default-access-controls);
162    let rules :: <sequence> = select (requested-operation)
163                                $view-content => acls.view-content-rules;
164                                $modify-content => acls.modify-content-rules;
165                                $modify-acls => acls.modify-acls-rules;
166                              end;
167    block (return)
168      for (rule in rules)
169        let action = rule.rule-action;
170        let target = rule.rule-target;
171        // First match wins
172        if (target = $anyone
173              | (user
174                   & (target = user
175                        | (target = $trusted & user = authenticated-user())
176                        | (target = $owner & page & page.page-owner = user)
177                        | (instance?(target, <wiki-group>)
178                             & member?(user, target.group-members)))))
179          return(action = $allow)
180        end if;
181      end for;
182      #f          // default is no permission if no rule matches
183    end block
184  end if
185end method has-permission?;
186
187// Turn a user-entered string into the internal representation of rules.
188// The string is one rule per line.  '!' means deny.  Lack of '!' means
189// allow.  e.g., "!cgay\n!foo\ntrusted".  Blank lines and '!' on a line
190// by itself are removed.  If there's an error parsing a rule, such as
191// user not found, then instead of the parsed rule a list of
192// #(original-rule, error-message) is returned.  For example:
193//   "!no-such-user"
194// =>
195//   #(#("!no-such-user", "User no-such-user not found."))
196// The caller can use this for error reporting purposes.
197//
198define method parse-rules
199    (rules :: <string>) => (rules :: <sequence>, error? :: <boolean>)
200  let error? = #f;
201  local method parse-one-rule (rule)
202    let (parsed-rule, err?) = parse-rule(rule);
203    if (parsed-rule)
204      error? := error? | err?;
205      parsed-rule
206    end
207  end;
208  values(choose(identity, map(parse-one-rule, split(rules, '\n'))),
209         error?)
210end method parse-rules;
211
212// Return two values: a parsed rule and whether or not there were any errors.
213// If there is an error, such as group not found, include
214// #(original-rule, error-message) for the erring rule.  (This is crufty and
215// should be improved.)
216//
217define method parse-rule
218    (rule :: <string>)
219 => (rule, errors? :: <boolean>)
220  let rule = strip(rule);
221  let action = $allow;
222  if (rule.size > 0)
223    if (rule[0] = '!')
224      action := $deny;
225      rule := copy-sequence(rule, start: 1);
226    end;
227    if (rule.size > 0)
228      select (as-lowercase(rule) by \=)
229        "trusted" => make(<rule>, action: action, target: $trusted);
230        "anyone" => make(<rule>, action: action, target: $anyone);
231        "owner" => make(<rule>, action: action, target: $owner);
232        otherwise =>
233          let target = find-user(rule) | find-group(rule);
234          if (target)
235            make(<rule>, action: action, target: target)
236          else
237            let msg = format-to-string("No user or group named %s was found.",
238                                       rule);
239            values(list(rule, msg), #t)
240          end;
241      end
242    end
243  end
244end method parse-rule;
245      
246// Turn the internal representation of rules into something users
247// can read and edit.
248//
249define method unparse-rules
250    (rules :: <sequence>) => (rules :: <string>)
251  join(map(unparse-rule, rules), "\n")
252end;
253
254define method unparse-rule
255    (rule :: <rule>) => (rule :: <string>)
256  let action = rule.rule-action;
257  let target = rule.rule-target;
258  concatenate(select (action)
259                $allow => "";
260                $deny  => "!";
261              end,
262              select (target by instance?)
263                <symbol> => as-lowercase(as(<string>, target));
264                <wiki-user> => target.user-name;
265                <wiki-group> => target.group-name;
266                otherwise => error("Invalid rule target: %s", target);
267              end)
268end method unparse-rule;
269
270define class <acls-page> (<wiki-dsp>)
271end;
272
273define method respond-to-get
274    (acls-page :: <acls-page>, #key title :: <string>)
275  let wiki-page = find-or-load-page(percent-decode(title));
276  if (wiki-page)
277    set-attribute(page-context(), "owner-name", wiki-page.page-owner.user-name);
278    dynamic-bind (*page* = wiki-page)
279      next-method()
280    end;
281  else
282    redirect-to(*non-existing-page-page*);
283  end;
284end method respond-to-get;
285
286// Handle the page access form submission.
287// todo -- Redisplay the user-entered text when there's an error, but with
288//         a * next to the broken entries?  <wiki:show-rules> needs to display
289//         this text instead of the actual page rules.
290//         Display an error message too.
291//
292define method respond-to-post
293    (acls-page :: <acls-page>, #key title :: <string>)
294  let wiki-page = find-or-load-page(percent-decode(title));
295  if (~wiki-page)
296    // Someone used an old URL or typed it in by hand...
297    resource-not-found-error(url: request-url(current-request()));
298  end;
299  with-query-values (view-content, modify-content, modify-acls, comment, owner-name)
300    let owner = strip(owner-name);
301    let new-owner = ~empty?(owner) & find-user(owner);
302    let owner-err? = ~empty?(owner) & ~new-owner;
303
304    let (vc-rules, vc-err?) = parse-rules(view-content);
305    let (mc-rules, mc-err?) = parse-rules(modify-content);
306    let (ma-rules, ma-err?) = parse-rules(modify-acls);
307
308    if (owner-err? | vc-err? | mc-err? | ma-err?)
309      if (owner-err?)
310        add-field-error("owner-name",
311                        "Cannot set owner to %s; user not found.", owner);
312      end;        
313      local method note-errors (rules, field-name)
314              for (rule in rules)
315                if (~instance?(rule, <rule>))
316                  let (rule, msg) = apply(values, rule);
317                  add-field-error(field-name, msg);
318                end;
319              end;
320            end;
321      note-errors(vc-rules, "view-content");
322      note-errors(mc-rules, "modify-content");
323      note-errors(ma-rules, "modify-acls");
324      respond-to-get(acls-page, title: title);
325    else
326      // todo -- Probably should save a <wiki-change> of some sort.
327      //         I haven't figured out what the Master Plan was yet.
328      if (new-owner & new-owner ~= wiki-page.page-owner)
329        wiki-page.page-owner := new-owner;
330      end;
331      wiki-page.page-access-controls := make(<acls>,
332                                             view-content: vc-rules,
333                                             modify-content: mc-rules,
334                                             modify-acls: ma-rules);
335      redirect-to(wiki-page);
336    end;
337  end;
338end method respond-to-post;
339
340// Show the unparsed ACL rules for a wiki page.  The 'name' parameter
341// determines what rules to show.  If there's a query value by the
342// same name then that is used instead because it is what the user just
343// typed into the input field and they may need to edit it.  Note that
344// this means the name of the <textarea> field must be one of "view-content"
345// "modify-content", or "modify-acls".
346//
347define tag show-rules in wiki
348    (acls-page :: <acls-page>)
349    (name :: <string>)
350  let name = as-lowercase(name);
351  let text = get-query-value(name);
352  if (text)
353    output("%s", quote-html(text));
354  else
355    let acls = *page*.page-access-controls;
356    output("%s", unparse-rules(select (name by \=)
357                                 "view-content" => acls.view-content-rules;
358                                 "modify-content" => acls.modify-content-rules;
359                                 "modify-acls" => acls.modify-acls-rules;
360                                 otherwise =>
361                                   error("Invalid rule type: %s", name);
362                               end));
363  end;
364end tag show-rules;
365
366define named-method can-view-content? in wiki
367    (page :: <wiki-dsp>)
368  has-permission?(authenticated-user(), *page*, $view-content)
369end;
370
371define named-method can-modify-content? in wiki
372    (page :: <wiki-dsp>)
373  has-permission?(authenticated-user(), *page*, $modify-content)
374end;
375
376define named-method can-modify-acls? in wiki
377    (acls-page :: <wiki-dsp>)
378  has-permission?(authenticated-user(), *page*, $modify-acls)
379end;
380