ref: fcccaf74c54ecd44b7e8bf45a7b0c99572f6a949
dir: /appl/spree/lib/allow.b/
implement Allow; include "sys.m"; sys: Sys; include "draw.m"; include "sets.m"; sets: Sets; Set, set, None: import sets; include "../spree.m"; spree: Spree; Attributes, Range, Object, Clique, Member, rand: import spree; include "allow.m"; Action: adt { tag: int; member: ref Member; action: string; }; actions: list of Action; clique: ref Clique; init(srvmod: Spree, g: ref Clique) { sys = load Sys Sys->PATH; sets = load Sets Sets->PATH; (clique, spree) = (g, srvmod); } ILLEGALNAME: con "/"; # illegal char in member names, ahem. archive(archiveobj: ref Object) { i := 0; for (al := actions; al != nil; al = tl al) { a := hd al; pname: string; if (a.member != nil) pname = a.member.name; else pname = ILLEGALNAME; archiveobj.setattr( "allow" + string i++, sys->sprint("%d %s %s", a.tag, pname, a.action), None ); } } unarchive(archiveobj: ref Object) { for (i := 0; (s := archiveobj.getattr("allow" + string i)) != nil; i++) { (n, toks) := sys->tokenize(s, " "); p: ref Member = nil; if (hd tl toks != ILLEGALNAME) { # if the member is no longer around, ignore the action. XXX do we still need to do this? if ((p = clique.membernamed(hd tl toks)) == nil) continue; } sys->print("allow: adding action %d, %ux, %s\n", int hd toks, p, concat(tl tl toks)); actions = Action(int hd toks, p, concat(tl tl toks)) :: actions; } } add(tag: int, member: ref Member, action: string) { # sys->print("allow: add %d, member %ux, action: %s\n", tag, member, action); actions = (tag, member, action) :: actions; } del(tag: int, member: ref Member) { # sys->print("allow: del %d\n", tag); na: list of Action; for (a := actions; a != nil; a = tl a) { action := hd a; if (action.tag == tag && (member == nil || action.member == member)) continue; na = action :: na; } actions = na; } action(member: ref Member, cmd: string): (string, int, list of string) { for (al := actions; al != nil; al = tl al) { a := hd al; if (a.member == nil || a.member == member) { (e, v) := match(member, a.action, cmd); if (e != nil || v != nil) return (e, a.tag, v); } } return ("you can't do that", -1, nil); } match(member: ref Member, pat, action: string): (string, list of string) { # sys->print("allow: matching pat: '%s' against action '%s'\n", pat, action); toks: list of string; na := len action; if (na > 0 && action[na - 1] == '\n') na--; (i, j) := (0, 0); for (;;) { for (; i < len pat; i++) if (pat[i] != ' ') break; for (; j < na; j++) if (action[j] != ' ') break; for (i1 := i; i1 < len pat; i1++) if (pat[i1] == ' ') break; for (j1 := j; j1 < na; j1++) if (action[j1] == ' ') break; if (i == i1) { if (j == j1) break; return (nil, nil); } if (j == j1) { if (pat == "&") break; return (nil, nil); } pw := pat[i : i1]; w := action[j : j1]; case pw[0] { '*' => toks = w :: toks; '&' => toks = w :: toks; pat = "&"; i1 = 0; '%' => (ok, nw) := checkformat(member, pw[1], w); if (!ok) return ("invalid field value", nil); toks = nw :: toks; * => if (w != pw) return (nil, nil); toks = w :: toks; } (i, j) = (i1, j1); } return (nil, revs(toks)); } revs(l: list of string): list of string { m: list of string; for (; l != nil; l = tl l) m = hd l :: m; return m; } checkformat(p: ref Member, fmt: int, w: string): (int, string) { case fmt { 'o' => # object id if (isnum(w) && (o := p.obj(int w)) != nil) return (1, string o.id); 'd' => # integer if (isnum(w)) return (1, w); 'p' => # member id if (isnum(w) && (member := clique.member(int w)) != nil) return (1, w); } return (0, nil); } isnum(w: string): int { # XXX lazy for the time being... if (w != nil && ((w[0] >= '0' && w[0] <= '9') || w[0] == '-')) return 1; return 0; } concat(v: list of string): string { if (v == nil) return nil; s := hd v; for (v = tl v; v != nil; v = tl v) s += " " + hd v; return s; }