#!/usr/bin/perl

## W3C W3C::Rnodes::AclDB - W3C PERL Library
# An in-memory database to store ACL information for resources.

#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux

#things that need to be done:

package W3C::Rnodes::AclDB;
require 5.000;
use strict;


$W3C::Rnodes::AclDB::revision = '$Id: AclDB.pm,v 1.32 2005/03/17 05:56:53 eric Exp $ ';
$W3C::Rnodes::AclDB::VERSION = 0.98;

package W3C::Rnodes::DBEntry;
use W3C::Util::Exception;
use W3C::Rnodes::ACL qw($ACL_SCHEMA_URI);

sub new {
    my ($proto, $container, $id, $access, $attributes) = @_;
    my $class = ref($proto) || $proto;
    my $self = {CONTAINER => $container,
		ID => $id,
		ACCESS => $access, 
		Attributes => $attributes};
    bless ($self, $class);
    return $self;
}

sub copy {
    my ($self, $container) = @_;
    my $copy = new W3C::Rnodes::DBEntry($container, $self->{ID}, [@{$self->{ACCESS}}], $self->{Attributes});
    return $copy;
}

sub addAccess {
    my ($self, $access) = @_;
    if (grep {$_ eq $access} @{$self->{ACCESS}}) {
    } else {
	push (@{$self->{ACCESS}}, @$access);
    }
}

sub update {
    my ($self, $id, $access) = @_;
    ($self->{ID}, $self->{ACCESS}) = ($id, $access);
    return;
}

sub delete {
    my $self = shift;
    my $v = $self->{CONTAINER};
    for (my $i = 0; $i <= $#$$v; $i++) {
	my $dbEntry = $$v->[$i];
	if ($dbEntry == $self) {
	    splice(@$$v, $i, 1); # delete @$v[$i]
	    return 1;
	}
    }
    return 0;
}

sub id {
    my ($self) = @_;
    return $self->{ID};
}

sub access {
    my ($self) = @_;
    return @{$self->{ACCESS}};
}

sub accessStr {
    my ($self) = @_;
    my @strs;
    foreach my $str (@{$self->{ACCESS}}) {
	if ($str !~ m/^\Q$ACL_SCHEMA_URI\E(.+)/) {
	    &throw(new W3C::Util::Exception(-message => 
					    "malformed access identifier: \"$str\""));
	}
	push (@strs, $1);
    }
    return join(', ', @strs);
}

sub getRuleAttribute {
    my ($self, $attribute) = @_;
    return $self->{Attributes}{$attribute};
}
sub toString {
    my ($self) = @_;
    my @ret;
    push (@ret, 'ID: '.$self->{ID});
    push (@ret, 'ACCESS: '.$self->accessStr());
    push (@ret, 'Attributes:');
    foreach my $attribute (keys %{$self->{Attributes}}) {
	push (@ret, "  $attribute: $self->{Attributes}{$attribute}");
    }
    push (@ret, 'CONTAINER: '.@{${$self->{CONAINER}}}) if ($self->{CONAINER});
    return wantarray ? @ret: join("\n", @ret);
}

package W3C::Rnodes::AclDB;
use W3C::Rnodes::ACL qw(&parseDBRule &accessBitFieldList &accessStringList &buildDBRuleId);
use W3C::Util::Exception;

#####
# per-object data

#####
# new - prepare an empty W3C::Rnodes::AclDB

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    $self->{RESOURCES} = {};
    bless ($self, $class);
    return $self;
}

# copy - make a copy of the $self database. copy all ACLs for resources in $what

sub copy {
    my ($self, $what) = @_;
    my $class = ref($self);
    my $copy = new $class;
    if (!defined $what) {
	my @what = keys %{$self->{RESOURCES}};
	$what = \@what;
    }
    map {
	my $resource = $_;
	my $v = \$copy->{RESOURCES}{$resource};
	$$v = [];
	map {
	    my $dbEntry = $_;
	    push(@$$v, $dbEntry->copy($v));
	} @{$self->{RESOURCES}{$resource}};
    } @$what;
    $copy->copyAuth($self);
    $copy->copyResourceAttributes($self);
    return $copy;
}

sub deleteResource {
    my ($self, $resource) = @_;
    delete $self->{RESOURCES}{$resource};
}

sub clearResources {
    my $self = shift;
    $self->{RESOURCES} = {};
    $self->{RESOURCE_ATTRIBUTES} = {};
}

sub addDBRule {
    my ($aclDB, $resourceParm, $idString, $access, $attributes) = @_;
    my @accessStrings = &accessStringList($access);
    if (ref $resourceParm ne 'ARRAY') {
	$resourceParm = [$resourceParm];
    }
    foreach my $resource (@$resourceParm) {
	my $newEntry = $aclDB->addRule($resource, $idString, [@accessStrings], undef, undef, undef, $attributes);
	if ($attributes && $newEntry) {
	    $aclDB->addResourceAttribute($resource, $attributes);
	}
    }
}

sub delDBRule {
    my ($aclDB, $resourceParm, $type, $id, $access) = @_;
    my @accessStrings = &accessStringList($access);
    my $idString = &buildDBRuleId($type, $id);
#    if (ref $resourceParm eq 'ARRAY') {
#	map {$aclDB->delRule($_, $idString, $accessString)} (@$resourceParm);
#    } else {
    $aclDB->delRule($resourceParm, $idString, [@accessStrings]);
#    }
}

sub addRule {
    my ($self, $resource, $id, $access, $replaceResource, $replaceId, $replaceAccess, $attributes) = @_;

    my $accessBits = &accessBitFieldList(@$access);
    my $v;
    $v = \$self->{RESOURCES}{$resource} if (!$replaceResource);
    if (!defined $$v) {
	$$v = [];
    } else {
	for (my $i = 0; $i < @$$v; $i++) {
	    my $dbEntry = $$v->[$i];
	    # make sure there are no duplicates
	    if ($dbEntry->id eq $id) {
		my $entryAccessBits = &accessBitFieldList($dbEntry->access);
		if ($replaceId) {
			&throw();
		    splice (@$$v, $i, 1);
		} else {
		    if ($replaceAccess) {
			&throw();
		    }
		    #$dbEntry->addAccess($access);
		    #return $dbEntry;
		}
		$accessBits &= ~$entryAccessBits;
		if (!$accessBits) {
		    return undef;
		}
	    }
	}
    }
    my $newEntry = new W3C::Rnodes::DBEntry($v, $id, [&accessStringList($accessBits)], $attributes);
    push(@$$v, $newEntry);
    return $newEntry;
}

#####
# delRule - delete one or all rules for resource matching @id, and @access
# 
# @id, and @access may be null for wildcarding
# @firstOnly - delete only the first rule
#/
sub delRule {
    my ($self, $resource, $id, $access, $firstOnly) = @_;

    my $v = \$self->{RESOURCES}{$resource};
    return -1 if (!defined $$v);
    my $deleted = 0;
  DBENTRY:
    for (my $i = 0; $i < @$$v; $i++) {
	my $dbEntry = $$v->[$i];
	next DBENTRY if (defined $id && $dbEntry->id ne $id);

	# If $access is defined and is not identical to that in $dbEntry, try the next entry.
	if (defined $access) {
	    my @sortedReferenceAccess = sort @$access;
	    my @sortedSelfAccess = sort $dbEntry->access;
	    next DBENTRY if (@sortedReferenceAccess != @sortedSelfAccess); # different lengths
	    for (my $i = 0; $i < @sortedReferenceAccess; $i++) {
		next DBENTRY if ($sortedReferenceAccess[$i] ne $sortedSelfAccess[$i]);
	    }
	}
	splice(@$$v, $i, 1); # delete @$$v[$i]
	return 1 if ($firstOnly);
	$i--;
	$deleted++;
    }
    return $deleted;
}

sub addAuth {
    my ($self, $childId, $parentId, $generation) = @_;
    $self->{AUTHORIZED_IDS}{$parentId} = [$childId, $generation];
}

sub copyAuth {
    my ($self, $from) = @_;
    map {
	$self->{AUTHORIZED_IDS}{$_} = [$from->{AUTHORIZED_IDS}{$_}[0],$from->{AUTHORIZED_IDS}{$_}[1]];
    } keys %{$from->{AUTHORIZED_IDS}};
}

# RESOURCE ATTRIBUTES - associative list of properties of resources

sub addResourceAttribute {
    my ($self, $resources, $name, $value) = @_;
    $resources = [$resources] if (ref $resources ne 'ARRAY');
    foreach my $resource (@$resources) {
	if (ref $name eq 'HASH') { # copy (maybe we should just assign?)
	    map {$self->{RESOURCE_ATTRIBUTES}{$resource}{$_} = $name->{$_}} keys %$name;
	} else {
	    $self->{RESOURCE_ATTRIBUTES}{$resource}{$name} = $value;
	}
    }
}

sub deleteResourceAttribute {
    my ($self, $resources, $name) = @_;
    $resources = [$resources] if (!ref $resources);
    foreach my $resource (@$resources) {
	delete $self->{RESOURCE_ATTRIBUTES}{$resource}{$name};
    }
}

sub getResourceAttribute {
    my ($self, $resource, $name) = @_;
    if ($name) {
	return $self->{RESOURCE_ATTRIBUTES}{$resource}{$name};
    } else {
	return $self->{RESOURCE_ATTRIBUTES}{$resource};
    }
}

sub getResourcesWithAttribute {
    my ($self, $name, $value) = @_;
    my @ret;
    foreach my $resource (keys %{$self->{RESOURCES}}) {
	if ($value) {
	    push (@ret, $resource) if ($self->{RESOURCE_ATTRIBUTES}{$resource}{$name} eq $value);
	} else {
	    push (@ret, $resource) if ($self->{RESOURCE_ATTRIBUTES}{$resource}{$name});
	}
    }
    return @ret;
}

sub copyResourceAttributes {
    my ($self, $from) = @_;
    map {
	my $resource = $_;
	map {
	    $self->{RESOURCE_ATTRIBUTES}{$resource}{$_} = $from->{RESOURCE_ATTRIBUTES}{$resource}{$_};
	} keys %{$from->{RESOURCE_ATTRIBUTES}{$resource}}
    } keys %{$from->{RESOURCE_ATTRIBUTES}};
}

sub setAccessResourceAttributes {
    my ($self) = @_;
    my ($maxAccess, $minAccess) = (0, undef); # | access bits into MAX_ACCESS, ~| into MIN_ACCESS
    my %resourceBins = $self->getResourceBins;
    foreach my $bin (keys %resourceBins) {
	my ($resources, $dbEntries, undef) = @{$resourceBins{$bin}};

	my $thisAccess = 0;
	foreach my $dbEntry (@$dbEntries) {
	    if ($self->passed($dbEntry)) {
		my ($type, $name, $access) = &parseDBRule($dbEntry);
		$thisAccess |= $access;
	    }
	}
	$self->addResourceAttribute($resources, {'access', $thisAccess});
	$maxAccess |= $thisAccess;

	$minAccess = defined $minAccess ? ~(~$minAccess | ~$thisAccess) : $thisAccess;
    }
    return ($maxAccess, $minAccess);
}

sub deleteUnprivilegedResources {
    my ($self, $filter) = @_;

    foreach my $resource (keys %{$self->{RESOURCES}}) {
	my $access = $self->getResourceAttribute($resource, 'access');
	if (!($access & $filter)) {
	    $self->deleteResource($resource);
	}
    }
}

sub _includesOrEquals { # static
    my ($includer, $includee) = @_;
    if (ref $includer eq 'ARRAY') {
	map {return 1 if ($_ eq $includee);} @$includer;
	return 0;
    }
    if (ref $includer eq 'HASH') {
	map {return 1 if ($_ eq $includee);} keys %$includer;
	return 0;
    }
    if (ref $includer eq 'SCALAR') {
	return $$includer eq $includee;
    }
    return $includer eq $includee;
}

# rules - all rules that match $resources, $id, and $access

sub rulesMatching {
    my ($self, $resources, $id, $access) = @_;
    my @ret;
    if (!defined $resources) {
	$resources = [$self->getResources()];
    }
    foreach my $resource (@$resources) {
	my $v = \$self->{RESOURCES}{$resource};
	if (!defined $$v) {
	    next;
	}
	my $deleted = 0;
	for (my $i = 0; $i <= $#$$v; $i++) {
	    my $dbEntry = $$v->[$i];

	    if ((!defined $id || &_includesOrEquals($id, $dbEntry->id)) && 
		(!defined $access || &_includesOrEquals($access, $dbEntry->access))) {
		push(@ret, $dbEntry);
	    }
	}
    }
    return @ret;
}

sub rulesFor {
    my ($self, $resource) = @_;
    return $self->{RESOURCES}{$resource};
}

sub getResources {
    my ($self) = @_;
    return keys %{$self->{RESOURCES}};
}

sub resourceCountNUKE {
    my $self = shift;
    my @resourceList = keys %{$self->{RESOURCES}};
    return @resourceList;
}

sub present {
    my ($self, $aclPresenter) = @_;
    $aclPresenter->startDB;
    foreach my $resource (keys %{$self->{RESOURCES}}) {
	my $v = $self->{RESOURCES}{$resource};
	$aclPresenter->startResource($v, $resource);
	for (my $i = 0; $i <= $#$v; $i++) {
	    my $dbEntry = $$v[$i];
	    $aclPresenter->addRule($dbEntry, $resource, $dbEntry->id, $dbEntry->access);
	}
	$aclPresenter->endResource($v, $resource);
    }
    $aclPresenter->endDB;
}

# collect ids (users/groups/ips) that are granted access in this ACL DB.
# returns arrays of W3C::Rnodes::DBEntries hashed by ids
# $ids{$id}[W3C::Rnodes::DBEntry...]
sub getIds {
    my ($self) = @_;
    my %ids;
    foreach my $resource (keys %{$self->{RESOURCES}}) {
	my $v = $self->{RESOURCES}{$resource};
	for (my $i = 0; $i <= $#$v; $i++) {
	    my $dbEntry = $$v[$i];
	    push(@{$ids{$dbEntry->id}}, $dbEntry);
	}
    }
    return %ids;
}

# $ids{$id}[W3C::Rnodes::DBEntry...]
sub getResourceBins {
    my ($self) = @_;
    my %bins;
    foreach my $resource (keys %{$self->{RESOURCES}}) {
	my $v = $self->{RESOURCES}{$resource};
	my $auth = 0;
	my @keys;
	for (my $i = 0; $i < @$v; $i++) {
	    my $dbEntry = $v->[$i];
	    my $key = $dbEntry->id.'->'.(join(',', sort $dbEntry->access())); # fix when I get around to 
	    push(@keys, $key);
	    $auth++ if ($self->{AUTHORIZED_IDS}{$dbEntry->id});
	}
	my $key = join('',sort @keys);
	push(@{$bins{$key}[0]}, $resource);
	$bins{$key}[1] = [@$v];
	$bins{$key}[2] = $auth;
    }
    return %bins;
}

sub passed {
    my ($self, $dbEntry) = @_;
    return $self->{AUTHORIZED_IDS}{$dbEntry->id};
}

sub passedRulesNUKE {
    my ($self, $p1) = @_;
    my @authorizedEntries;
    my $v = (ref $p1 eq 'ARRAY') ? $p1 : $self->{RESOURCES}{$p1};
    for (my $i = 0; $i <= $#$v; $i++) {
	my $dbEntry = $$v[$i];
	push(@authorizedEntries, $dbEntry) if ($self->{AUTHORIZED_IDS}{$dbEntry->id});
    }
    return @authorizedEntries;
}

sub Stringize {
    &throw(new W3C::Util::NotImplementedException());
}

sub deStringize {
    &throw(new W3C::Util::NotImplementedException());
}
sub StringizeInt {
    &throw(new W3C::Util::NotImplementedException());
}

#*
# parseInt - parse the output of StringizeInt (- the DELIM)
#/
sub parseInt {
    &throw(new W3C::Util::NotImplementedException());
}

#*
# StringizeString - escape DELIMs and append an EOFIELD
#/
sub StringizeString {
    &throw(new W3C::Util::NotImplementedException());
}

#*
# parseString - parse the output of StringizeString (- the DELIM)
#/
sub parseString {
    &throw(new W3C::Util::NotImplementedException());
}

#*
# editing funtionality
#/
sub update {
    my ($self, $ob, $id, $access) = (@_);
    $ob->update($id, $access);
}

sub delete {
    &throw(new W3C::Util::NotImplementedException());
}

sub toString {
    my ($self) = @_;
    my $ret = $self."\n";
    $ret .= 'RESOURCES '.$self->{RESOURCES}."\n";
    foreach my $resource (keys %{$self->{RESOURCES}}) {
	$ret .= '  '.$resource.":\n";
	$ret .= '    RESOURCE_ATTRIBUTES '.$self->{RESOURCE_ATTRIBUTES}{$resource}."\n";
	foreach my $attribute (keys %{$self->{RESOURCE_ATTRIBUTES}{$resource}}) {
	    $ret .= '      '.$attribute.': '.$self->{RESOURCE_ATTRIBUTES}{$resource}{$attribute}."\n";
	}
	$ret .= "    RULES ".$self->{RESOURCES}{$resource}."\n";
	foreach my $rule (@{$self->{RESOURCES}{$resource}}) {
	    $ret .= '      '.$rule->id.' '.$rule->accessStr."\n";
	}
    }
    my @remainingAttributes = keys %{$self->{RESOURCES}};
    ($ret .= "  remaining ATTRIBUTES\n") if ($#remainingAttributes >= $[);
    foreach my $resource (@remainingAttributes) {
	next if ($self->{RESOURCES}{$resource});
	$ret .= '  '.$resource.":\n";
	foreach my $attribute (keys %{$self->{RESOURCE_ATTRIBUTES}{$resource}}) {
	    $ret .= '      '.$attribute.': '.$self->{RESOURCE_ATTRIBUTES}{$resource}{$attribute}."\n";
	}
    }
    $ret .= 'AUTHORIZED_IDS '.$self->{AUTHORIZED_IDS}."\n";
    foreach my $id (keys %{$self->{AUTHORIZED_IDS}}) {
	$ret .= '  '.$id.': ';
	$ret .= $self->{AUTHORIZED_IDS}{$id}[0];
	$ret .= ' g'.$self->{AUTHORIZED_IDS}{$id}[1]."\n";
    }
    return $ret;
}

sub _stripXmlBase { # static
    my ($str, $xml_base) = @_;
    if ($str =~ m/^\Q$xml_base\E(.*)$/) {
	return $1;
    } else {
	return $str;
    }
}

sub toRdfXml {
    my ($self, $prefix_rdf, $prefix_acls, $xml_base) = @_;
    my @lines;
    foreach my $resource (keys %{$self->{RESOURCES}}) {
	foreach my $rule (@{$self->{RESOURCES}{$resource}}) {
	    push (@lines, "<${prefix_acls}resourceAccessRule>");
	    my $baseId = &_stripXmlBase($rule->id(), $xml_base);
	    push (@lines, "   <${prefix_acls}accessor ${prefix_rdf}resource=\"$baseId\" />");
	    my @accesses = $rule->access();
	    foreach my $access (@accesses) {
		my $baseAccess = &_stripXmlBase($access, $xml_base);
		push (@lines, "   <${prefix_acls}access ${prefix_rdf}resource=\"$baseAccess\" />");
	    }
	    my $baseResource = &_stripXmlBase($resource, $xml_base);
	    push (@lines, "   <${prefix_acls}hasAccessTo ${prefix_rdf}resource=\"$baseResource\" />");
	    push (@lines, "</${prefix_acls}resourceAccessRule>");
	}
    }
    return @lines;
}

1;

