#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

use strict;
require Exporter;
#require AutoLoader;

$W3C::Rnodes::W3CAclAgent::REVISION = '$Id: W3CAclAgent.pm,v 1.66 2006/10/19 20:22:37 eric Exp $ ';

package W3C::Rnodes::W3CAclAgent; # implements ACLAgentInterface, ACLRepositoryInterface
use W3C::Util::Object;
use W3C::Util::Exception;
use W3C::Database::DBIInterface;

use W3C::Rnodes::ACL qw($TYPE_NONE $TYPE_ALL $TYPE_USER 
			$TYPE_GROUP $TYPE_IP $TYPE_ORG $TYPE_TEMP
			$ACCESS_FULL
			%TEXT_TYPE
			$MACRO_RULEID $MACRO_RULENAME 
			$MACRO_RULEICON $MACRO_RULEDESC
			&parseDBRule &parseDBRuleId
			&buildDBRuleId);
use W3C::Rnodes::W3CWebAcls qw(@MACRO_OPTIONS);

use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(W3C::Util::NamedParmObject Exporter); # AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw($COMPILE_nothing $COMPILE_showUpdates $COMPILE_noEdit $COMPILE_showTimes);
$VERSION = 0.10;
$DSLI = 'adpO';

use vars qw($COMPILE_nothing $COMPILE_showUpdates $COMPILE_noEdit $COMPILE_showTimes);
$COMPILE_nothing = 0x00;
$COMPILE_showUpdates = 0x01;
$COMPILE_noEdit = 0x02;
$COMPILE_showTimes = 0x04;

# @parms - constructor parameters:
#   -properties - Properties object or name of props file
#   -sourceID - string identifying this agent (for logging/debugging)
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    my $props = delete $self->{-properties};
    if (!ref $props) {
	$props = new W3C::Util::Properties($props);
    }
    $self->{DB} = new W3C::Database::DBIInterface($props);

    $props->defaultToI('database', 'w3c');
    $self->{PROPERTIES} = $props;
    $self->{DATABASE} = $props->getI('database');
    if ($self->{-compileFlags} & $COMPILE_showTimes) {
	require 'sys/syscall.ph';
    }
    return $self;
}

############################## ACLAgentInterface ##############################

sub disconnect {
    my ($self) = @_;
    if ($self->{DB}) {
	$self->{DB}->disconnect();
	delete $self->{DB};
    }
}

#####
# getAclsFor - Get keys and groups with access to a resource
# $aclDB - W3C::Rnodes::AclDB
# $resourcesP - singe resource or array of resources to query
# $wildcard - character to use as wildcard while matching $resourcesP
# $recursive - interpret $wildcard as spanning directory markers
# return count of added rules
sub getAclsFor {
    my ($self, $aclDB, $resourcesP, $wildcard, $recursive) = @_;

    # Copy resources as we will be playing around with them.
    my @resources = ref $resourcesP eq 'ARRAY' ? @$resourcesP : $resourcesP;
    my $count = 0;

    my (@uris, %acls, %byAcl);
    foreach my $resource (@resources) {
	# build query string
	my $qs;
	if ($wildcard && $resource =~ m/\Q$wildcard\E/) {

	    # map wildcards to mysql wildcards
	    if ($wildcard ne '_') {
		$resource =~ s/_/\\_/g;
	    }
	    if ($wildcard ne '%') {
		$resource =~ s/%/\\%/g;
		$resource =~ s/\Q$wildcard\E/%/g;
	    }

	    # look for everything like http://domain.tl/some/dir/*
            $qs = 'select uris.uri,uris.acl from uris where uris.uri like '.$self->{DB}->escape($resource);
	    if ($resource =~ m/\A(.*?)(\/?)\%\Z/) {	# anything with a trailing wildcard
		my ($base, $forceDir) = ($1, $2);

		if (!$recursive) {
		    # and not like http://domain.tl/some/dir/*/*
		    if ($forceDir) {
			$qs .= ' and uris.uri not like '.$self->{DB}->escape($resource.'/_%');
		    } else {
			$qs .= ' and uris.uri not like '.$self->{DB}->escape($base.'_%/_%');
		    }
		}
	    }
            $qs .= ' and acl is not null';
	} else {
	    $qs = 'select uris.uri,uris.acl from uris where (uris.uri='.$self->{DB}->escape($resource).
		' or uris.uri='.$self->{DB}->escape($resource.'/').') and acl is not null';
	}

	# execute the constructed query to get current dir and immediate children
	$self->{DB}->executeQuery(\@uris,\%acls, $qs);
    }
    foreach my $uri (@uris) {
	push (@{$byAcl{$acls{$uri}}}, $uri);
    }
    my @acls = keys %byAcl;
    foreach my $acl (@acls) {
	$count += $self->addDBRuleFor($aclDB, $byAcl{$acl}, $acl, {'source' => $self->{-sourceID}});
    }
    # if there's only one acl for all the resources, return it too.
    # return the list of ACLs represented
    return $count;
}

########################### ACLRepositoryInterface ############################

#####
# setAclFor - Assign acl set id for a known resource id
# $resources - list of resources for which to set the ACL
# $acl - Access Control List to assign to these resources
# $creations - list into which to store newly created resources
# $updates - list into which to store resources with changed ACLs
sub setAclFor {
    my ($self, $resources, $acl, $creations, $updates) = @_; # is it an update or a replace? Hard to know

    # $acl may be either a macro or an array or DBEntries (ACL rules).
    if (ref $acl eq 'ARRAY' && $acl->[0]->isa('W3C::Rnodes::DBEntry')) {
	# create or find a matching set of acls rules and get the acls.id
	$acl = $self->_assureAclsFor($acl);
    } else {
	# $acl macro id is already the appropriate acls.id
    }
    foreach my $resource (@$resources) {
	eval {
	    $self->{DB}->executeSingleQuery('select id from uris where uri='.$self->{DB}->escape($resource));
	}; if ($@) {if (my $ex = &catch('W3C::Database::DBIInterface::SingleQueryException')) {
	    $self->{DB}->executeUpdate('insert into uris (uri,acl) values ('.$self->{DB}->escape($resource).','.$acl.')');
	    push (@$creations, $resource) if ($creations);
	} else {
	    die $@;
	}} else {
	    $self->{DB}->executeUpdate('update uris set acl='.$acl.' where uri='.$self->{DB}->escape($resource));
	    push (@$updates, $resource) if ($updates);
	}
    }
    $self->_setMaxResourceUpdate();
}

use vars (qw($LAST_RESOURCE_UPDATE_QS));
$LAST_RESOURCE_UPDATE_QS = 'SELECT MAX(last+0) FROM uris';

sub _setMaxResourceUpdate {
    my ($self) = @_;
    $self->{MAX_RESOURCE_UPDATE} = $self->{DB}->executeSingleQuery($LAST_RESOURCE_UPDATE_QS);
}

sub getMaxResourceUpdate {
    my ($self) = @_;
    return $self->{MAX_RESOURCE_UPDATE};
}

# #resources - list of resources for which to delete the ACL
sub deleteAclFor {
    my ($self, $resources, $deletions) = @_;
    foreach my $resource (@$resources) {
	eval {
	    $self->{DB}->executeSingleQuery('select id from uris where uri='.$self->{DB}->escape($resource));
	}; if ($@) {if (my $ex = &catch('W3C::Database::DBIInterface::SingleQueryException')) {
	    &throw(new W3C::Util::NoSuchResourceException(-uri => $resource));
	} else {
	    die $@;
	}} else {
	    $self->{DB}->executeUpdate('update uris set acl=null where uri='.$self->{DB}->escape($resource));
	    push (@$deletions, $resource) if ($deletions);
	}
    }
}

####
# setAuthResAttrs - Populate $aclDB with $user/$ip's group membership.
#
# returns: n>=0: number of auths added to W3C::Rnodes::AclDB
#	  undef: empty W3C::Rnodes::AclDB so no auth to check

# $aclDB - W3C::Rnodes::AclDB
# $user - web id to check for access
# $ip - ip address to check for access
sub setAuthResAttrs {
    my ($self, $aclDB, $user, $ip) = @_;
    my $count = 0;

    my $escUser = $self->{DB}->escape($user); # make palatable to wire protocol
    my @ips = @{$self->getSupernetsFor($ip)}; # 1.2.3.*   1.2.*.*   1.*.*.*
    my $ipList = "'".join("','", @ips)."'"; # '1.2.3.4','1.2.3.*',...

    my %byType;
    my %ids = $aclDB->getIds; # hash of ids that are known to $aclDB
    my @idKeys = keys %ids;

    if (@idKeys < 0) {
	# empty W3C::Rnodes::AclDB so no auth to check
	return undef;
    }

    # build HASH of form $byType{'U'} = ['eric','joe']
    foreach my $uriId (@idKeys) {
	my ($type, $dbId) = &parseDBRuleId($uriId);
	&throw(new W3C::Util::Exception("couldn't parse \"$uriId\".")) if (!defined $type);
	push(@{$byType{$type}}, $self->{DB}->escape($dbId));
    }

    # build query like:
    # SELECT child.type,child.value,parent.type,parent.value,g
    #   FROM ids AS child
    #        INNER JOIN idInclusions ON child.id=idInclusions.id
    #        INNER JOIN ids AS parent ON idInclusions.groupId=parent.id
    #  WHERE ((child.type='A' AND child.value='all')
    #         OR (child.type='U' AND child.value='ot')
    #         OR (child.type='I' AND child.value IN ('133.27.228.212','133.27.228.*','133.27.*.*','133.*.*.*')))
    #    AND child.stops=0
    #    AND ((parent.type='G' AND parent.value IN ('w3cteamgroup'))
    #         OR (parent.type='A' AND parent.value IN ('all')))

    my $userStr = defined $user ? "OR (child.type='U' AND child.value=$escUser)" : '';

    my @values;
    foreach my $type (keys %byType) {
	my $typeStr = $self->{DB}->escape($TEXT_TYPE{$type});
	my $parentsStr = join(',', @{$byType{$type}});
	push(@values, "(parent.type=$typeStr AND parent.value IN ($parentsStr))");
    }
    my $groupStr = @values ? '   AND ('.join("\n        OR ", @values).')' : '';

    # compose query
    my $query = "
SELECT child.type,child.value,parent.type,parent.value,g
  FROM ids AS child
       INNER JOIN idInclusions ON child.id=idInclusions.id
       INNER JOIN ids AS parent ON idInclusions.groupId=parent.id
 WHERE ((child.type='A' AND child.value='all')
        $userStr
        OR (child.type='I' AND child.value IN ($ipList)))
   AND child.stops=0
$groupStr";

    my @rows;
    $self->{DB}->executeArrayQuery(\@rows, $query);

    # take the resulting data:
    # +------+-------+------+--------------+------+
    # | type | value | type | value        | g    |
    # +------+-------+------+--------------+------+
    # | A    | all   | A    | all          |    0 |
    # | U    | eric  | G    | w3cteamgroup |    2 |
    # +------+-------+------+--------------+------+
    # and add auth entries to $aclDB
    foreach my $row (@rows) {
	my ($childType, $childValue, $parentType, $parentValue, $g) = (@$row);
	$aclDB->addAuth(&buildDBRuleId($childType, $childValue), &buildDBRuleId($parentType, $parentValue), $g);
	$count++;
    }

    # The person is a member of themselves, sort of, don't ya know...
    # chacl looks at the rules that apply to the current user. This says
    # that "user" rules apply to the current user.
    if ($user) {
	$aclDB->addAuth(&buildDBRuleId('U', $user), &buildDBRuleId('U', $user), 0);
    }
    return $count;
}

# $aclDB - W3C::Rnodes::AclDB
# $resource - resource to which to add the ACL
# $acl - Access Control List for $resource
# $attributes - hash of properties to assign to this resource/ACL combination
# returns count of rules added to the database

sub addDBRuleFor {
    my ($self, $aclDB, $resource, $acl, $attributes) = @_;
    my (@types, @ids, @accesses, $count);

    # select acls.type,acls.id,acls.access from acls,ids where acls.id=ids.id and acls.acl=7;
    # +------+-----+--------+
    # | type | id  | access |
    # +------+-----+--------+
    # | A    |   1 |   3122 |
    # | G    | 102 |   3955 |
    # +------+-----+--------+
    $self->{DB}->executeQuery(\@types, \@ids, \@accesses,
			'select acls.type,acls.id,acls.access from acls,ids where acls.id=ids.id and acls.acl='.$acl);

    if (ref $resource ne 'ARRAY') {
	$resource = [$resource];
    }
    foreach my $singleResource (@$resource) {
	# don't cracl anything that came from another source (like the database)
	#next if ($aclDB->getResourceAttribute($singleResource, 'source'));
	
	for (my $i = 0; $i < @types; $i++) {
	    my $type = $types[$i];
	    my $id = $ids[$i];
	    my $access = $accesses[$i];
	    my ($name, $descrip) = $self->getNameAndDescrip($type, $id); #  - maybe use this where clause: 'id=\"'.$id.'\"')
	    
	    $aclDB->addDBRule($singleResource, &buildDBRuleId($type, $name), $access, $attributes);
	    $count++;
	}
    }
    return $count;
}

#####
# getNameAndDescrip - make pretty string for user describing $id
# $id - primary key from ids table (eg 2112 for user 'eric')

sub getNameAndDescrip {
    my ($self, $type, $id) = @_;
    my ($name, $descrip);
    if ($type eq $TYPE_NONE) {
	($name,$descrip) = ('nobody', undef);
    } elsif ($type eq $TYPE_ALL) {
	($name,$descrip) = ('all', undef);
    } elsif ($type eq $TYPE_USER) {
	my (@t);
	$self->{DB}->executeWideQuery(\@t, 'select value,family,info,expire from ids,userDetails where userDetails.id=ids.id and ids.id='.$id);
	($name, $descrip) = ($t[0],join(' - ', @t[1,-1]));
    } elsif ($type eq $TYPE_GROUP) {
	my (@t);
	$self->{DB}->executeWideQuery(\@t, 'select value from ids where id='.$id);
	($name, $descrip) = ($t[0], undef);
    } elsif ($type eq $TYPE_IP) {
	my (@t);
	    $self->{DB}->executeWideQuery(\@t, 'select ip.value,grp.value from ids as ip,ids as grp where ip.sponsor=grp.id and ip.id='.$id);
	($name, $descrip) = ($t[0], @t[1,-1]);
    } elsif ($type ne $TYPE_TEMP) {
	&throw(new W3C::Util::Exception("acls database is corrupted at entry: $type,$id"));
    }
    return ($name, $descrip);
}

#####
# getNameAndDescripByName - make pretty string for user describing $id
# $id - group name (w3cmembergroup) | user name (eric) | ip (18.29.0.74)

sub getNameAndDescripByName {
    my ($self, $type, $id) = @_;
    my ($name, $descrip);
    $id = $self->{DB}->escape($id);
    if ($type eq $TYPE_NONE) {
	($name,$descrip) = ('nobody', undef);
    } elsif ($type eq $TYPE_ALL) {
	($name,$descrip) = ('all', undef);
    } elsif ($type eq $TYPE_USER) {
	my (@t);
	$self->{DB}->executeWideQuery(\@t, 'select value,family,info,expire from ids,userDetails where userDetails.id=ids.id and ids.value='.$id);
	($name, $descrip) = ($t[0],join(' - ', @t[1,-1]));
    } elsif ($type eq $TYPE_GROUP) {
	my (@t);
	$self->{DB}->executeWideQuery(\@t, 'select value from ids where value='.$id);
	($name, $descrip) = ($t[0], undef);
    } elsif ($type eq $TYPE_IP) {
	my (@t);
	    $self->{DB}->executeWideQuery(\@t, 'select ip.value,grp.value from ids as ip,ids as grp where ip.sponsor=grp.id and ip.value='.$id);
	($name, $descrip) = ($t[0], @t[1,-1]);
    } elsif ($type ne $TYPE_TEMP) {
	&throw(new W3C::Util::Exception("acls database is corrupted at entry: $type,$id"));
    }
    return ($name, $descrip);
}

#####
# getSupernetsFor - build (1.2.3.4, 1.2.3.*, 1.2.*.*, 1.*.*.*)

sub getSupernetsFor {
    my ($self, $ip) = @_;
    my @ips = split('\.', $ip);
    my @stars = ('*', '*', '*', '*');
    my @ret;
    for (my $i = 3; $i >= 0; $i--) {
	push(@ret, join('.', @ips[0..$i], @stars[$i+1..3]));
    }
    return \@ret;
}

#####
# getAccessFor - find out if $user/$ip has at least $requiredAccess to $resource
# $requiredAccess is a bit field, see W3C::Rnodes::ACL $ACCESS_CHACL

sub getAccessFor {
    my ($self, $resource, $requiredAccess, $user, $ip) = @_;

    $resource = $self->{DB}->escape($resource);
    $requiredAccess = $ACCESS_FULL if (!defined $requiredAccess);
    my $ret = 0;
    my (@accesses);
    my $escUser = $self->{DB}->escape($user);
    my @ips = @{$self->getSupernetsFor($ip)};
    my $ipList = '\''.join('\',\'', @ips).'\'';
    $self->{DB}->executeQuery(\@accesses, 
'select acls.access from'.		# get access levels
' uris,acls,idInclusions,ids'.		# tables to cross
' where uris.uri='.$resource.		# uri to check
' and acls.acl=uris.acl'.		# and its corresponding acls
' and acls.access&'.$requiredAccess.	# at the sought level of access
' and ('.				# group checks for
'(ids.type=\'A\' and ids.value=\'all\') or '.		# keywords, 
((!defined $user) ? '' : 
'(ids.type=\'U\' and ids.value='.$escUser.') or ').	# user and 
'(ids.type=\'I\' and ids.value in ('.$ipList.'))'.	# ip
')'.					# 
' and ids.id=idInclusions.id'.		# above matched id is a member of a group
' and idInclusions.groupId=acls.id');	# included in the matched acls

    @accesses = grep {$ret |=($_ & $requiredAccess);0} @accesses;
    return $ret;
}

###################### private and non-interface methods #######################

#####
# assureAclFor - Make sure there is an acl id in the acls table for the 
#		 combination of keys and names.

sub _assureAclsFor {
    my ($self, $rules) = @_;
    my $ruleNo = 0;

    #####
    # create absurd select string that looks for matching ACL
    # select value,type,id from ids where (		| value        | type | id   |
    #    type='G' and value in ('cabal') or		| cabal        | G    |  100 |
    #    type='U' and value in ('eric') or 		| eric         | U    | 2112 |
    #    type='G' and value in ('w3cteamgroup'))	| w3cteamgroup | G    |  102 |
    # select a0.acl from 
    #    acls as a0,acls as a1,acls as a2 where 	| acl |
    #    a0.acl=a1.acl and a0.acl=a2.acl and 		+-----+
    #    a0.id=100 and a0.access=3122 and 		| 102 |
    #    a1.id=2112 and a1.access=3955 and 		|  77 |
    #    a2.id=102 and a2.access=3955			| 104 |
    # is the same as: @@@ may be too damn many joins, but I haven't seen a problem yet.
    # select a0.acl from 
    #    acls as a0,ids as i0,acls as a1,ids as i1,acls as a2,ids as i2 where 
    #    a0.acl=a1.acl and a0.acl=a2.acl and 
    #    a0.id=i0.id and i0.type='G' and i0.value in ('cabal') and a0.access=3122 and 
    #    a1.id=i1.id and i1.type='U' and i1.value in ('eric') and a1.access=3955 and 
    #    a2.id=i2.id and i2.type='G' and i2.value in ('w3cteamgroup') and a2.access=3955
#    my ($key, $gname, $equal, $joins, $match);
    my @inserts; # in case we have to create a new ACL
    {
	my ($equal, $joins, $match);
	my $where;
	{
	    my %byAccessType;
	    foreach my $rule (@$rules) {
		my ($type, $name, $access) = &parseDBRule($rule);
		push(@{$byAccessType{$access}{$type}}, $self->{DB}->escape($name));
	    }
	    foreach my $access (keys %byAccessType) {
		foreach my $type (keys %{$byAccessType{$access}}) {
		    my @ids;
		    $self->{DB}->executeQuery(\@ids,'select id from ids where type=\''.$type.'\' and value in ('.
					join(',',@{$byAccessType{$access}{$type}}).')');
		    $where .= $TEXT_TYPE{$type}.':('.join(',',@ids).') ';
		    $type = $self->{DB}->escape($type);
		    foreach my $id (@ids) {
			my $as = 'a'.($ruleNo);
			$joins .= 'acls as '.$as.',';

			if ($ruleNo > 0) {
			    $equal .= ' a0.acl='.$as.'.acl and';
			}

			$match .= ' '.$as.'.id='.$id.' and '.$as.'.access='.$access.' and';
			push(@inserts, $type.','.$id.','.$access);
			$ruleNo++;
		    }
		}
	    }
	    # clean up trailing 'and's and ','s
	    $joins =~ s/,$/ /;
	    $match =~ s/ and$//;
	    return undef if ($joins eq '');
	    my $qs = 'select a0.acl from '.$joins.'where'.$equal.$match;
	    my @acls;
	    $self->{DB}->executeQuery(\@acls, $qs);

	    #####
	    # check each acl to see if it is limited to the set we selected
	    # select acl,count(acl) from acls where acl in (102,77,104) group by acl
	    foreach my $acl (@acls) {
		my @count;
		$self->{DB}->executeQuery(\@count, 'select count(*) from acls where acl='.$acl);
		#####
		# equivilent count means identical match
		($count[0] == $ruleNo) && (return $acl);
	    }
	}
    }

    #####
    # create a new group with new id
    # I don't use function(last_insert_id()) as it is mysql specific
    # reserve a new id
    my $uniqueId = $self->{DB}->escape(int(rand(2**32))); # @@@ stick a date behind this
    $self->{DB}->executeUpdate('insert into acls (acl,type,id,access) values (null, \'T\', '.$uniqueId.', 0)');
	# || die "SQL command \"$qs\" failed: ",$self->{DB}->errstr;
    # find that acl id
    my $id = $self->{DB}->executeSingleQuery('select acl from acls where id='.$uniqueId);

    #####
    # update new entry with each gname from rules
    foreach my $insert (@inserts) {
	$self->{DB}->executeUpdate('insert into acls (acl,type,id,access) values('.$id.','.$insert.')');
    }

    #####
    # remove our temp reservation
    $self->{DB}->executeUpdate('delete from acls where acl='.$id.' and id='.$uniqueId);

    # return id of newly created group
    return $id;
}

# ----------- User functions ------------- #

sub _getUserInfo {
    my $self = shift;
    $self->{DB}->executeQuery(shift, 
			'select value from ids where type=\'U\' and stops=0 order by value');
#			'select value,name,info,expire from ids,userDetails where userDetails.id=ids.id order by value');
}

sub detailUser {
    my ($self, $user) = @_;
    my @userInfo;
    if (wantarray) {
	$self->{DB}->executeWideQuery(\@userInfo, 
				'select passwd,ac,info,userDetails.status,phone,sponsor,email,family,given from ids,userDetails where ids.id=userDetails.id and ids.value='.$self->{DB}->escape($user));
	return @userInfo;
    } else {
	$self->{DB}->executeWideQuery(\@userInfo, 
				'select family,email,ac,expire,info from ids,userDetails where ids.id=userDetails.id and ids.value='.$self->{DB}->escape($user));
	return join(' ', @userInfo);
    }
}

# --------- Org and Group functions ----------- #

sub _getOrgInfo { # Wed Oct  7 02:10:19 EDT 1998
    my $self = shift;
    $self->{DB}->executeQuery(shift, 
			'select value from ids,groupDetails where groupDetails.type=\'O\' and groupDetails.id=ids.id  and ids.stops=0 order by ids.value');
#			'select value,info from ids,groupDetails where groupDetails.type=\'O\' and groupDetails.id=ids.id order by ids.value');
}

sub detailOrg {
    my $self = shift;
    my $org = shift;
    my @orgInfo;
    $self->{DB}->executeWideQuery(\@orgInfo, 
			    'select org.id,org.expire,org.info,ac.value from ids as org,groupDetails,ids as ac where org.id=groupDetails.id and groupDetails.acRep=ac.id and org.value='.$self->{DB}->escape($org));
    my @ips;
    $self->{DB}->executeQuery(\@ips, 
			'select type,value from ids where sponsor='.$orgInfo[0]);
    return (join(' ', @orgInfo[1,2,3]), \@ips);
}

#| ip.value      | org.value  |
#+---------------+------------+
#| 18.29.0.173   | AI_lab     |
#| 204.214.157.1 | Alan_home  |
#| 18.29.0.170   | CERN-group |
sub _getIpInfo {
    my $self = shift;
    my $ipNames = shift;
    my $ipInfos = shift; # fortunately, it's a hash so we don't have to sort it too.
    $self->{DB}->executeQuery($ipNames, 
			'select value from ids where type=\'I\' and stops=0 order by value');
#    $self->{DB}->executeQuery($ipNames, $ipInfos, 
#			'select ip.value,org.value from ids as ip,ids as org where org.id=ip.sponsor order by org.value');
    # sort ips in ascending network order
    @$ipNames = sort {unpack("N", pack("C4", split('\.',$a))) <=> unpack("N", pack("C4", split('\.',$b)))} @$ipNames;
}

#| value   | expire | info |
#+---------+--------+------+
#| w3t_mit | NULL   | NULL |
sub detailIp {
    my $self = shift;
    my $ip = shift;
    my @orgInfo;
    $self->{DB}->executeWideQuery(\@orgInfo, 
			    'select org.value,ip.expire,ip.info from ids as ip,ids as org where ip.value='.
			    $self->{DB}->escape($ip).' and org.id=ip.sponsor');
    return join(' ', @orgInfo);
}

use vars qw(%INFO_FUNCS);
%INFO_FUNCS = ('group' => \&_getGroupInfo,
	       'user' => \&_getUserInfo,
	       'org' => \&_getOrgInfo,
	       'ip' => \&_getIpInfo,
	       'all' => \&_getKeyInfo,
	       'none' => \&_getKeyInfo, # Is this ever used?
	       'key' => \&_getKeyInfo);

# call one of the _getXInfo functions to set $ids with user-readable strings
sub getIds {
    my ($self, $type, $ids) = @_;
    my $getInfo = $INFO_FUNCS{$type};
    $self->$getInfo($ids);
}

#| value      | info |
#+------------+------+
#| CERN-group | NULL |
#| W3T_INRIA  | NULL |
#| W3T_KEIO   | NULL |
sub _getGroupInfo {
    my $self = shift;
    $self->{DB}->executeQuery(shift, 
			'select ids.value from ids,groupDetails where ids.id=groupDetails.id and (isnull(groupDetails.type) or groupDetails.type!=\'O\') order by ids.value');
#			'select ids.value,ids.info from ids,groupDetails where ids.id=groupDetails.id and (isnull(groupDetails.type) or groupDetails.type!=\'O\') order by ids.value');
}

sub _getKeyInfo {
    my ($self, $target) = @_;
    push (@$target, 'all');
}

sub _maybeExecuteUpdate {
    my ($self, $qs) = @_;
    if ($self->{-compileFlags} & $COMPILE_showUpdates) {
	print "$qs;\n";
    }
    my @start;
    if ($self->{-compileFlags} & $COMPILE_showTimes) {
	my $timestamp = pack('LL', ());
	syscall( &SYS_gettimeofday, $timestamp, 0) != -1 || 
	    &throw(new W3C::Util::Exception(-message => "gettimeofday: $!"));
	@start = unpack('LL', $timestamp);
    }
    if (!($self->{-compileFlags} & $COMPILE_noEdit)) {
	$self->{DB}->executeUpdate($qs);
    }
    if ($self->{-compileFlags} & $COMPILE_showTimes) {
	my $timestamp = pack('LL', ());
	syscall( &SYS_gettimeofday, $timestamp, 0) != -1 || 
	    &throw(new W3C::Util::Exception(-message => "gettimeofday: $!"));
	my @end = unpack('LL', $timestamp);
	my $usecs = (($end[0]*1000000+$end[1]) - ($start[0]*1000000+$start[1]))/1000000;
	print "$usecs usecs\n";
    }
}

# _makeSubs - read hierarchy table and index subgroup relationships by
#   %subs - list of parents by member
#   %supers - list of members by parent
#   %all - list of all elements
# also return $longest - maximum generation count from hierarchy
# $query - query to run on the hierarchy table (potentially join against other tables)

# This function records a table of the $MIN span between groups in hierarchy.
# The largest encountered $MIN span is recorded.
# $MIN note: If a shortcut is discovered on the largest $MIN, no effort is made
#	     to recalculate the next largest $MIN span.
# POSIT: Given a subgraph:
#     D
#    / \
#   /   F
#  /   /
# E   C
#  \ /
#   A
# we need to store all parents and all children of each node.
# PROOF: Add to F and C to get:
#       H
#        \
#     D   G
#    / \ /
#   /   F
#  /   /
# E   C
#  \ / \
#   A   I
#      /
#     B
# Without observing the C-F relationship, the apparent longest path is A-H (4)
# or B-D (4). If we record C-F, we get B-H (5). Add C-F last, we must record
# that all of C's children are children of all of F's parents and visa versa.
#   parents{F} = {D=>1,G=>1,H=>2}
#   children{C} = {A=>1,I=>2,B=>2}
#  +C-F ==>

#   C is a child of F and all of F's parents
#   C-1->F # immediate parent

#   C-2->G # second of F's parents
#   C-3->H # third of F's parents
#   C-2->D # first of F's parents

#   all of C's children are children of all of F's parents
#   I is a child of F and all of F's parents
#   I-2->F # second of C's children

#   I-3->G
#   I-4->H
#   I-3->D

#   A is a child of F and all of F's parents
#   A-2->F # first of C's children

#   A-3->G
#   A-4->H
#   A-3->D xx

#   B is a child of F and all of F's parents
#   B-3->F # third of C's children

#   B-4->G
#   B-5->H
#   B-4->D

my $MIN = 1; # if set, look for minimum span between nodes
sub _cIsAChildOfPAndAllOfPzParents {
    my ($self, $c, $p, $g) = @_;
    if (!exists $self->{PARENTS}{$c}{$p} || 
	($MIN ^ $self->{PARENTS}{$c}{$p} <= $g)) {
	$self->{PARENTS}{$c}{$p} = $g;
	$self->{CHILDREN}{$p}{$c} = $g;
	if ($g > $self->{LONGEST}) {
	    $self->{LONGEST} = $g;
#	    print "${g} ${c}-${g}->${p}\n";
#	} else {
#	    print "  ${c}-${g}->${p}\n";
	}
	foreach my $parent (keys %{$self->{PARENTS}{$p}}) {
	    my $gP = $self->{PARENTS}{$p}{$parent} + $g;
	    if (!exists $self->{PARENTS}{$c}{$parent} || 
		($MIN ^ $self->{PARENTS}{$c}{$parent} <= $gP)) {
		$self->{PARENTS}{$c}{$parent} = $gP;
		$self->{CHILDREN}{$parent}{$c} = $gP;
		if ($gP > $self->{LONGEST}) {
		    $self->{LONGEST} = $gP;
#		    print "${gP} ${c}-${gP}->${parent}\n";
#		} else {
#		    print "  ${c}-${gP}->${parent}\n";
		}
#		print "  ${c}-${gP}->${parent}\n";
#	    } else {
#		print "xx${c}-${gP}->${parent}\n";
	    }
	}
#    } else {
#	print "xx${c}-${g}->${p}\n";
    }
}

sub _makeSubs {
    my ($self, $query) = @_;

    my (%parents, %children, %all);
    my (@supers, @subs);

    # get list of groups containing groups
    if (1) {	# use real groups
	$self->{DB}->executeQuery(\@supers, \@subs, $query);
    } else {	# use this test map:
	my @pairs = ();
	if (0) {
	    @pairs = (['F','D'],['A','C'],['C','F']);
	} elsif (0) {
	    # test conformance with $MIN policy
	    @pairs = (['F','D'],['C','F'],['A','C'],['A','E'],['E','D']);
	} elsif (0) {
	    # test conformance with $MIN policy
	    @pairs = (['A','E'],['E','D'],['F','D'],['C','F'],['A','C']);
	} elsif (0) {
	    @pairs = (['C','F'],['A','C'],['F','D'],['A','E'],['E','D'],['G','H'],['F','G'],['B','I'],['I','C']);
	} else {
	    @pairs = (['A','C'],['F','D'],['A','E'],['E','D'],['G','H'],['F','G'],['B','I'],['I','C'],['C','F']);
	}
	foreach my $pair (@pairs) {
	    push(@subs, $pair->[0]);
	    push(@supers, $pair->[1]);
	}
    }
    $self->{LONGEST} = 0;
    $self->{CHILDREN} = \%children;
    $self->{PARENTS} = \%parents;
    for (my $i = 0; $i < @supers; $i++) {
	my $p = $supers[$i];
	my $c = $subs[$i];

#	print "$c-$p\n";
	$self->_cIsAChildOfPAndAllOfPzParents($c, $p, 1);
	foreach my $child (keys %{$self->{CHILDREN}{$c}}) {
	    $self->_cIsAChildOfPAndAllOfPzParents($child, $p, $self->{CHILDREN}{$c}{$child}+1);
	}
    }
    return (\%children, \%parents, \%all, $self->{LONGEST});
}

# _makeSubs - Read hierarchy table and index subgroup relationships by
#   %subs - list of parents by member
#   %supers - list of members by parent
#   %all - list of all elements
# where hash keys are primary keys from ids table.
# also return $longest - maximum generation count from hierarchy
sub _makeSubsById {
    my ($self) = @_;
    return $self->_makeSubs('select super,sub from hierarchy where type=\'G\'');
}

# _makeSubs - Read hierarchy table and index subgroup relationships by
#   %subs - list of parents by member
#   %supers - list of members by parent
#   %all - list of all elements
# where hash keys are web ids from ids.value.
# also return $longest - maximum generation count from hierarchy
sub _makeSubsByName {
    my ($self) = @_;
    return $self->_makeSubs('select supers.value,subs.value from hierarchy,ids as supers, ids as subs where (isnull(supers.type) or supers.type!=\'O\') and hierarchy.type=\'G\' and super=supers.id and sub=subs.id');
}

#####
# compile ACL tables - Update userAcls and ipAcls tables to reflect current 
#		       defined groups and members in the hierarchy table.

# Example 1, compiling the above structure (as ids):
#       8
#        \
#     4   7
#    / \ /
#   /   6
#  /   /
# 5   3
#  \ / \
#   1   9
#      /
#     2
# INSERT INTO ids (id,type,value) VALUES (1,'A','all'),(96,'M','ID_COMPILE'),(97,'M','ID_CLEAR'),(98,'M','ID_CHECK_SUM'),(101,'G','A'),(102,'G','B'),(103,'G','C'),(104,'G','D'),(105,'G','E'),(106,'G','F'),(107,'G','G'),(108,'G','H'),(109,'G','I'),(1001,'U','Asub'),(1002,'U','Bsub'),(1003,'U','Csub'),(1004,'U','Dsub'),(1005,'U','Esub'),(1006,'U','Fsub'),(1007,'U','Gsub'),(1008,'U','Hsub'),(1009,'U','Isub');
# INSERT INTO userDetails (id,passwd) VALUES (1001,'Asub'),(1002,'Bsub'),(1003,'Csub'),(1004,'Dsub'),(1005,'Esub'),(1006,'Fsub'),(1007,'Gsub'),(1008,'Hsub'),(1009,'Isub');
# INSERT INTO hierarchy (sub,super,type) VALUES (101,103,'G'),(101,105,'G'),(105,104,'G'),(106,104,'G'),(106,107,'G'),(107,108,'G'),(109,103,'G'),(102,109,'G'),(103,106,'G'),(1001,101,'U'),(1002,102,'U'),(1003,103,'U'),(1004,104,'U'),(1005,105,'U'),(1006,106,'U'),(1007,107,'U'),(1008,108,'U'),(1009,109,'U');

# Example 2, adding group 10 to above example data:
#       8
#        \
#     4   7
#    / \ / \
#   /   6   10
#  /   /   /
# 5   3   /
#  \ / \ /
#   1   9
#      /
#     2
# INSERT INTO ids (id,type,value) VALUES (110,'G','J'),(1010,'U','Jsub');
# INSERT INTO userDetails (id,passwd) VALUES (1010,'Jsub');
#   followed by one of
# INSERT INTO hierarchy (sub,super,type) VALUES (109,110,'G'),(110,107,'G'),(1010,110,'U');
#   or
# ./compileAcls add I < J add J < G

# quick debugger invocation
# unshift@INC,('../..');
# use W3C::Util::Properties;
# use W3C::Rnodes::W3CAclAgent;
# $p = new W3C::Util::Properties('../../Conf/chaclCGI.prop');
# $a = new W3C::Rnodes::W3CAclAgent($p);
# $a->compileAcls({});

# $flags may include:
#   -agent - agent string to note in idUpdates
#   -markIds - id and group ids to add to a compile ('cpl') marker
sub compileAcls {
    my ($self, $flags) = @_;
    my $agent = $flags->{-agent};
    # get largest generation gap in the current hierarchy
    my ($subs, $supers, $all, $longest) = $self->_makeSubsById;

    # Rebuild superGroups table to contain transitive closure of groups from hierarchy.
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('LOCK TABLES superGroups WRITE,compileSuperGroups WRITE,ids READ,hierarchy AS g1 READ,hierarchy AS g2 READ');
    }
    $self->_compileSuperGroups($longest, undef);

    # Build membership of user/ips within groups.
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('LOCK TABLES compileIdInclusions WRITE,hierarchy READ,superGroups READ,ids READ');
    }
    $self->_compileIdInclusions(undef); # compile all ids.

    if ($flags->{-clear}) {
	# Populate the idUpdates from the compileIdInclusions table.
	if (!$flags->{-nolock}) {
	    $self->_maybeExecuteUpdate('LOCK TABLES idUpdates WRITE,idInclusions WRITE,compileIdInclusions READ');
	}

	# Mark it with a 'clr' marker.
	my ($markId, $markGroupId) = $flags->{-markIds} ? @{$flags->{-markIds}} : (0, 0);
	$self->_maybeExecuteUpdate("REPLACE INTO idUpdates (id,type,groupId,g,action,agent) VALUES($markId,'T',$markGroupId,0,'clr','$agent')");

	$self->_populateIdUpdatesAndIdInclusionsFromCompileIdInclusions($agent);
	$self->_setMaxGroupUpdate();
    } else {
	# Populate the idUpdates from the compileIdInclusions table.
	if (!$flags->{-nolock}) {
	    $self->_maybeExecuteUpdate('LOCK TABLES idUpdates WRITE,idInclusions READ,compileIdInclusions READ');
	}

	# Mark it with a 'cpl' marker.
	my ($markId, $markGroupId) = $flags->{-markIds} ? @{$flags->{-markIds}} : (0, 0);
	$self->_maybeExecuteUpdate("REPLACE INTO idUpdates (id,type,groupId,g,action,agent) VALUES($markId,'T',$markGroupId,0,'cpl','$agent')");

	$self->_populateIdUpdatesFromCompileIdInclusions($agent, undef);
	$self->_setMaxGroupUpdate();

	# Move update idInclusions with the noted differences.
	if (!$flags->{-nolock}) {
	    $self->_maybeExecuteUpdate('LOCK TABLES idInclusions WRITE,compileIdInclusions WRITE,idUpdates READ');
	}
	$self->_updateIdInclusionsFromIdUpdates();
    }
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('UNLOCK TABLES');
    }
    return;
}

# $flags may include:
#   -agent - agent string to note in idUpdates
sub incrementalCompilePrincipal {
    my ($self, $add, $type, $principal, $flags) = @_;
    my $agent = $flags->{-agent};
    # build userGroups/Ips

    # Empty out idUpdates.
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('LOCK TABLES compileIdInclusions WRITE,hierarchy READ,superGroups READ,ids READ');
    }
    $self->_compileIdInclusions([$principal]); # compile all ids.

    # Populate the idUpdates from the compileIdInclusions table.
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('LOCK TABLES idUpdates WRITE,idInclusions READ,compileIdInclusions READ');
    }
    $self->_populateIdUpdatesFromCompileIdInclusions($agent, [$principal]);
    $self->_setMaxGroupUpdate();

    # Update idInclusions with the noted differences.
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('LOCK TABLES idInclusions WRITE,compileIdInclusions WRITE,idUpdates READ');
    }
    $self->_updateIdInclusionsFromIdUpdates();

    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('UNLOCK TABLES');
    }
    return;
}

sub getMaxGroupUpdate {
    my ($self) = @_;
    return $self->{MAX_GROUP_UPDATE};
}

use vars (qw($LAST_UPDATE_QS));
$LAST_UPDATE_QS = 'SELECT MAX(seqNo) FROM idUpdates';

sub _setMaxGroupUpdate {
    my ($self) = @_;
    $self->{MAX_GROUP_UPDATE} = $self->{DB}->executeSingleQuery($LAST_UPDATE_QS);
}
    
# Compile the transitive closure of hierarchy into compileSuperGroups.
sub _compileSuperGroups {
    my ($self, $longest, $groups) = @_;

    $self->_maybeExecuteUpdate('DELETE FROM superGroups');
    $self->_maybeExecuteUpdate('DELETE FROM compileSuperGroups');

    # Each group that contains anything (subgroups, users or ips) contains itself.
    $self->_maybeExecuteUpdate('INSERT INTO superGroups (sub,super,g) SELECT id,id,0 FROM ids WHERE type="G" AND stops=0');

    # copy of group/subgroup relationships from hierarhcy.
    $self->_maybeExecuteUpdate('INSERT INTO superGroups (sub,super,g) SELECT sub,super,1 FROM hierarchy AS g1 WHERE type="G" AND stops=0');

    # Record that all grandchildren are 2nd generation members of
    # their grandparents.
    $self->_maybeExecuteUpdate('INSERT INTO superGroups (sub,super,g) SELECT g1.sub,g2.super,2 FROM hierarchy AS g1,hierarchy AS g2 WHERE g1.type="G" AND g1.stops=0 AND g1.super=g2.sub AND g2.type="G" AND g2.stops=0');

    # Build joins to scan the hierarchy/superGroups for subsequent generations.
    for (my $joins = 2; $joins <= $longest + 1; $joins++) {

	# Assert that all legit subgroups of known subgroups are members of
	# the parent groups.
	my $last = $joins - 1;
	$self->_maybeExecuteUpdate("INSERT INTO compileSuperGroups (sub,super,g) SELECT g1.sub,superGroups.super,$joins FROM hierarchy AS g1,superGroups WHERE superGroups.sub=g1.super AND g1.type='G' AND g1.stops=0 and superGroups.g=$last");

	# Move the data back to superGroups. (Some RDBs do not allow
	# simultaneous query and update of the same table.)
	$self->_maybeExecuteUpdate("INSERT INTO superGroups (sub,super,g) SELECT sub,super,g FROM compileSuperGroups");
	$self->_maybeExecuteUpdate("DELETE FROM compileSuperGroups");
    }
}

# Leverage off transitive closure of hierarchy in superGroups to compile
# membership of each principal in groups.
sub _compileIdInclusions {
    my ($self, $ids) = @_;
    my $principalConstraint;
    $self->_maybeExecuteUpdate("DELETE FROM compileIdInclusions");

    # Make sure all ids that the authenticator cares about include themselves
    # in idInclusions. This includes (to date) user ids (Joe has access to
    # resource X), ips (1.2.3.4 has access to resource X), and 'A' (everyone
    # has access to resource X).
    # This is really an optimization so there doesn't have to be an extra DB
    # query to pick up ids that are included in the acl directly rather than
    # via a containing group.
    $principalConstraint = $ids ? ' AND ids.id IN ('.join (",", @$ids).')' : "";
    $self->_maybeExecuteUpdate("INSERT INTO compileIdInclusions (id,type,groupId,g) SELECT ids.id,type,ids.id,0 FROM ids WHERE type IN ('U','I','A') AND ids.stops=0$principalConstraint");

    # Add all the ids that users or ips are members of (Joe is a member of G1
    # and G1 has access to resource X or 1,2,3,4 is a member of G2 which is a
    # member of G3 which has access to resource X.
    $principalConstraint = $ids ? ' AND hierarchy.sub IN ('.join (",", @$ids).')' : "";
    $self->_maybeExecuteUpdate("INSERT INTO compileIdInclusions (id,type,groupId,g) SELECT hierarchy.sub,hierarchy.type,superGroups.super,superGroups.g+1 FROM hierarchy,superGroups WHERE hierarchy.stops=0 AND hierarchy.type IN('U','I') AND hierarchy.super=superGroups.sub$principalConstraint");
}

sub _populateIdUpdatesFromCompileIdInclusions {
    my ($self, $agent, $ids) = @_;
    my $principalConstraint;

    $principalConstraint = $ids ? ' AND compileIdInclusions.id IN ('.join (",", @$ids).')' : "";
    $self->_maybeExecuteUpdate("REPLACE INTO idUpdates (id,type,groupId,g,seqNo,action,agent) SELECT compileIdInclusions.id,compileIdInclusions.type,compileIdInclusions.groupId,compileIdInclusions.g,NULL,\"add\",\"$agent\" FROM compileIdInclusions LEFT OUTER JOIN idInclusions ON compileIdInclusions.id=idInclusions.id AND compileIdInclusions.groupId=idInclusions.groupId WHERE (idInclusions.id IS NULL OR idInclusions.g!=compileIdInclusions.g)$principalConstraint");
    $principalConstraint = $ids ? '  AND idInclusions.id IN ('.join (",", @$ids).')' : "";
    $self->_maybeExecuteUpdate("REPLACE INTO idUpdates (id,type,groupId,g,seqNo,action,agent) SELECT idInclusions.id,idInclusions.type,idInclusions.groupId,idInclusions.g,NULL,\"del\",\"$agent\" FROM idInclusions LEFT OUTER JOIN compileIdInclusions ON idInclusions.id=compileIdInclusions.id AND idInclusions.groupId=compileIdInclusions.groupId WHERE compileIdInclusions.id IS NULL$principalConstraint");
}

sub _updateIdInclusionsFromIdUpdates {
    my ($self) = @_;
    $self->_maybeExecuteUpdate("INSERT INTO idInclusions (id,type,groupId,g) SELECT id,type,groupId,g from idUpdates where idUpdates.action=\"add\"");
    $self->_maybeExecuteUpdate("REPLACE INTO idInclusions (id,type,groupId,g) SELECT id,type,groupId,-1 from idUpdates where idUpdates.action=\"del\"");
    $self->_maybeExecuteUpdate("DELETE FROM idInclusions WHERE g=-1");
}

sub _populateIdUpdatesAndIdInclusionsFromCompileIdInclusions {
    my ($self, $agent, $ids) = @_;

    $self->_maybeExecuteUpdate("DELETE FROM idUpdates WHERE action != \"clr\"");
    $self->_maybeExecuteUpdate("INSERT INTO idUpdates (id,type,groupId,g,seqNo,action,agent) SELECT compileIdInclusions.id,compileIdInclusions.type,compileIdInclusions.groupId,compileIdInclusions.g,NULL,\"add\",\"$agent\" FROM compileIdInclusions");
    $self->_maybeExecuteUpdate("DELETE FROM idInclusions");
    $self->_maybeExecuteUpdate("INSERT INTO idInclusions (id,type,groupId,g) SELECT compileIdInclusions.id,compileIdInclusions.type,compileIdInclusions.groupId,compileIdInclusions.g FROM compileIdInclusions");
}

# compileCheckSum: Calculate the total number of members of groups in 
#		   idInclusions. This number is easily checked against
#		   the number of keys in a gdbm file mirroring the
#		   data in idInclusions.
# $flags may include:
#   -id - id and group ids to add to a compile ('sum') marker
sub compileCheckSum {
    my ($self, $flags) = @_;
    my $agent = $flags->{-agent};
    my ($markId, $markGroupId) = $flags->{-markIds} ? @{$flags->{-markIds}} : (0, 0);

    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('LOCK TABLE idGroupCounts WRITE,idUpdates WRITE,idInclusions READ,ids READ');
    }
    $self->_maybeExecuteUpdate('DELETE FROM idGroupCounts');
    $self->_maybeExecuteUpdate('INSERT INTO idGroupCounts (id,count) SELECT ids.id,count(*) FROM idInclusions,ids WHERE ids.id=idInclusions.id GROUP BY idInclusions.id');
    $self->_maybeExecuteUpdate("REPLACE INTO idUpdates (id,type,groupId,g,action,agent) SELECT $markId,'T',$markGroupId,COUNT(*),'sum','$agent' FROM idGroupCounts");
    if (!$flags->{-nolock}) {
	$self->_maybeExecuteUpdate('UNLOCK TABLES');
    }
}

sub setHierarchyStop {
    my ($self, $sub_, $type, $super, $stopValue) = @_;
    $self->_maybeExecuteUpdate("REPLACE INTO hierarchy (sub,type,super,stops) VALUES ($sub_,\"$type\",$super,$stopValue)", {-ignoreDuplicateKeys => 1});
}

sub delHierarchyEntry {
    my ($self, $sub_, $super, $stopValue) = @_;
    $self->_maybeExecuteUpdate("DELETE FROM hierarchy WHERE sub=$sub_ AND super=$super", {-ignoreDuplicateKeys => 1});
}

sub getMaxRenameUpdate {
    my ($self) = @_;
    return $self->{MAX_RENAME_UPDATE};
}

use vars (qw($LAST_RENAME_UPDATE_QS));
$LAST_RENAME_UPDATE_QS = 'SELECT MAX(seqNo) FROM renames';

sub _setMaxRenameUpdate {
    my ($self) = @_;
    $self->{MAX_RENAME_UPDATE} = $self->{DB}->executeSingleQuery($LAST_RENAME_UPDATE_QS);
}
    
sub renamePrincipal {
    my ($self, $frum, $too) = @_;
    $frum =~ s/\"/\\"/g; #";
    $frum =~ s/\'/\\'/g; #';
    $too =~ s/\"/\\"/g; #";
    $too =~ s/\'/\\'/g; #';
    $self->{DB}->executeUpdate("LOCK TABLES ids WRITE, renames WRITE");
    my $id = $self->{DB}->executeSingleQuery("SELECT id FROM ids WHERE value=\"$frum\"");
    my $conflictId;
    eval {
	$conflictId = $self->{DB}->executeSingleQuery("SELECT id FROM ids WHERE value=\"$too\"");
    }; if ($@) {if (my $ex = &catch('W3C::Database::DBIInterface::SingleQueryException')) {
	# Good, that's what we want!
    } else {
	die $@;
    }} else {
	&throw(new W3C::Util::Exception(-message => "$too already exists. Will not rename $frum to $too"));
    }
    $self->{DB}->executeUpdate("UPDATE ids SET value=\"$too\" WHERE id=$id");
    $self->{DB}->executeUpdate("INSERT INTO renames (frum,too,id) VALUES (\"$frum\", \"$too\", $id)");
    $self->_setMaxRenameUpdate();
    $self->{DB}->executeUpdate("UNLOCK TABLES");
}

# Find primary key from ids table for each element (user|ip|group) in ids.
# $type is an optional type constraint.
# $ids is a hash ref with keys of ids.id or ids.value and disposable values.
# Note: this function may create more hash entries in $ids than were passed in.
#	Additional entries associate an ids.id with a value (name) and type.
sub resolveIds {
    my ($self, $type, $ids) = @_;
    my @wheres = ();
    if ($type) {
	push (@wheres, "type='$type'");
    }
    push (@wheres, 'value IN ("'. join('","',keys %$ids).'") OR id IN ("'. join('","',keys %$ids).'")');
    my (%values);
    $self->{DB}->executeHashArrayQuery(\%values,'select value,id,type from ids where '.
				       join (' AND ', @wheres));
    my %copy = %$ids;
    foreach my $value (keys %values) {
	my ($idNo, $type) = @{$values{$value}};
	if (exists $copy{$value}) {
	    $ids->{$value} = [$idNo, $type];
	    delete $copy{$value};
	}
	if (exists $copy{$idNo}) {
	    $ids->{$idNo} = [$value, $type];
	    delete $copy{$idNo};
	}
    }
    return keys %copy;
}

# get hash of parents indexed by member
sub getIdInclusionsByName {
    my $self = shift;
    return $self->{DB}->executeHashArrayQuery(shift, 'select i.value,g.value from ids as i,idInclusions,ids as g where i.id=idInclusions.id and idInclusions.groupId=g.id and g.value != \'cabal\'');
}

sub expandGroup {
    my $self = shift;
    my ($subs,$id,$hit) = (shift,shift,shift);
    foreach my $sub_ (@{$$subs{$id}}) {
	if (!defined $$hit{$sub_}) {
	    $$hit{$sub_} = $id;
	    $self->expandGroup($subs, $sub_, $hit);
	}
    }
}

# return an arbitrary slice of the parents and children for $group
# probably an oversimplification
sub groupHierarchy {
    my ($self, $group) = @_;
    my ($subs, $supers) = $self->_makeSubsByName;
    my @ret;
    for (my $current = (keys %{$supers->{$group}})[0]; 
	 defined $current; $current = (keys %{$supers->{$current}})[0]) {
	unshift(@ret, $current);
    }
    for (my $current = (keys %{$subs->{$group}})[0]; 
	 defined $current; $current = (keys %{$subs->{$current}})[0]) {
	push(@ret, $current);
    }
    return @ret;
#    return ('w3clacoregroup', 'w3cteamgroup', 'W3T_MIT', 'w3t_mit_remote');
}

########### walker stuff ############

#####
# addFileInfo - add stuff to uriInfo table;

sub addFileInfo {
    my $self = shift;
    my $id = shift;
    my $path = shift;
    my @statinfo = stat($path);
    my $owner = $statinfo[4];
    my $last = $self->{DB}->gmtimeToDatetime(gmtime($statinfo[9]));
    # see if it exists already
    if ($self->{DB}->executeSingleQuery('select count(*) from uriInfo where uri='.$id) == 1) {
	$self->{DB}->executeUpdate('update uriInfo set exst=\'Y\', touchedBy='.$owner.', touchedOn=\''.$last.'\' where uri='.$id);
    } else {
	$self->{DB}->executeUpdate('insert into uriInfo (uri,exst,touchedBy,touchedOn) values ('.$id.', \'Y\', '.$owner.', \''.$last.'\')');
    }
}

#####
# addLinkInfo - add stuff to symLinks table;

sub replaceLinkInfo {
    my $self = shift;
    my $from = shift;
    my $to = shift;
    my @statinfo = lstat($from);
    my $owner = $statinfo[4];
    my $last = $self->{DB}->gmtimeToDatetime(gmtime($statinfo[9]));
    # see if it exists already
    $self->{DB}->executeUpdate('replace into symLinks (de,a,touchedBy,touchedOn) values (\''.$from.'\', \''.$to.'\', '.$owner.', \''.$last.'\')');
}

1;

__END__

=head1 NAME

W3C::Rnodes::W3CAclAgent - 

=head1 SYNOPSIS

  use W3C::Rnodes::W3CAclAgent;

=head1 DESCRIPTION

<description>

This module is part of the W3C::Rnodes CPAN module.

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

W3C::Rnodes::ACL(3) perl(1).

=cut
