code: 9ferno

ref: a7080788265dd441b5446bea5c4d31fccf7dea1f
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;
}