#!/usr/bin/perl

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

# Replicate changes to the w3c hierarchy table as maintained in the idUpdates
# table by compileAcls.

#BEGIN {unshift (@INC, '../../..');}
use lib '/usr/local/perl/modules';

package IdReplicator;
use vars qw($REVISION $VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
$REVISION = '$Id: replicateIds,v 1.67 2017/11/07 16:11:54 kahan Exp $ ';
@ISA = qw();
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 1.10;
$DSLI = 'adpO';

use strict;
use POSIX;
use English;

use W3C::Util::Exception;
use W3C::Util::Properties;
use W3C::Rnodes::W3CAclAgent;

use vars qw($REVISION $VERSION @ISA $BUSY_WAIT);

use vars qw($FILE_path $FILE_openMode_RW $FILE_openMode_RO $FILE_createMode $DEFAULT_paths);

$FILE_path = '/usr/local/WWW/';
$FILE_openMode_RW = O_CREAT|O_RDWR;
$FILE_openMode_RO = O_RDONLY;
$FILE_createMode = 0x04+0x20+0x80+0x100;

$DEFAULT_paths = {
    USERS => {DB => 'users', 
	      LAST => 'usersLast', 
	      COPYTO => undef}, 
    GROUPS => {DB => 'groups', 
	       LAST => 'groupsLast', 
	       COPYTO => undef}, 
    GROUPIDS => {DB => 'groupIds', 
		 LAST => undef, 
		 COPYTO => undef}, 
    URIS => {DB => 'uris', 
	     LAST => 'urisLast', 
	     COPYTO => undef}, 
    RENAMES => {DB => undef, 
		LAST => 'renamesLast', 
		COPYTO => undef}, 
};

use vars qw($DEFAULT_DB_FORMAT $BUSY_WAIT);
$DEFAULT_DB_FORMAT	= 'GDBM_File';
$BUSY_WAIT		= 20; # seconds to poll for dbm file write access

use vars qw($RW_read $RW_write);
$RW_read		= \ "read";
$RW_write		= \ "write";

use vars qw($DEBUG_nothing $DEBUG_showChanges 
	    $DEBUG_showQueries $DEBUG_showFiles 
	    $DEBUG_noEdit $DEBUG_quick);
$DEBUG_nothing		= 0x0000;
$DEBUG_showChanges	= 0x0010;
$DEBUG_showQueries	= 0x0020;
$DEBUG_showFiles	= 0x0040;
$DEBUG_noEdit		= 0x0080;
$DEBUG_quick		= 0x0100;

use vars qw($GROUPS_DEFAULT_DELIM $USERS_DEFAULT_DELIM $USERS_DEFAULT_QUERY $USERS_DEFAULT_TEMPLATE $ID_PACK);
$GROUPS_DEFAULT_DELIM	= ' ';
$USERS_DEFAULT_DELIM	= ':';
$USERS_DEFAULT_QUERY	= 'userDetails.passwd';
$USERS_DEFAULT_TEMPLATE	= '$data[0]';
$ID_PACK		= "L!";

use vars qw($ADDITIONAL $MISCOUNT);
($ADDITIONAL, $MISCOUNT) = (1, 2);

&main(\@ARGV);

sub main {
    my ($argv) = @_;
    eval {
	my $replicator = new IdReplicator($argv);
	$replicator->execute();
    }; if ($@) {
	if (my $ex = &catch('W3C::Util::FileNotFoundException')) {
	    my $fileName = $ex->getFilename();
	    print STDERR "$fileName does not exist: try $0 -refresh users|groups|uris|renames\n";
	} elsif ($ex = &catch('W3C::Util::Exception')) {
	    print STDERR $ex->toString();
	} else {
	    print STDERR "died with $@";
	}
    }
}

sub new {
    my ($proto, $args) = @_;
    my $class = ref $proto || $proto;
    my $self = {};
    bless ($self, $class);

    # defaults
    $self->{DEBUG} = $DEBUG_nothing;
    $self->{LAST} = {
	GROUPS => undef, 
	USERS => undef, 
	GROUPIDS => undef, 
	URIS => undef, 
	RENAMES => undef};
    $self->{EXPECT} = {
	GROUPS => undef, 
	USERS => undef, 
	URIS => undef, 
	RENAMES => undef};
    $self->{DELETES} = {
	GROUPS => [], 
	GROUPIDS => [], 
	USERS => [], 
	URIS => []};
    $self->{JUST_DO} = {
	GROUPS => undef, 
	USERS => undef, 
	URIS => undef, 
	RENAMES => undef, 
	DEFAULT_TO_ALL => 1};
    $self->{DELIM} = {
	GROUPS => $GROUPS_DEFAULT_DELIM, 
	USERS => $USERS_DEFAULT_DELIM};
    $self->{UPDATED} = {
	USERS => undef, 
	GROUPS => undef, 
	URIS => undef, 
	RENAMES => undef};
    $self->{CHECKSUM_THRESHOLD} = 0;
    $self->{CHECKSUM_RESULTS} = undef;
    $self->{DB_FORMAT} = $DEFAULT_DB_FORMAT;
    $self->{DIAGNOSE} = 0;
    $self->{REFRESH} = {};
    $self->{ACCESS} = [];

    # read parameters
    $self->readProperties();
    $self->parseArgs($args);

    # constructed states
    # give relative file paths an absolute base of $FILE_path
    foreach my $type ('USERS', 'GROUPS', 'GROUPIDS', 'URIS', 'RENAMES') {
	foreach my $spec ('DB', 'LAST', 'COPYTO') {
	    if (!defined $self->{$type}{$spec} && 
		defined $DEFAULT_paths->{$type}{$spec}) {
		$self->{$type}{$spec} = $DEFAULT_paths->{$type}{$spec};
	    }
	    if ($self->{$type}{$spec} =~ m/^[\/\.]/) {
	    } else {
		$self->{$type}{$spec} = $FILE_path.$self->{$type}{$spec};
	    }
	}
    }

    # make DB connection
    $self->{ACL} = new W3C::Rnodes::W3CAclAgent(-properties => $self->{PROPERTIES});

    return $self;
}

sub readProperties {
    my ($self) = @_;
    # load a properties file if available
    eval {
	$self->{PROPERTIES} = new W3C::Util::Properties('../../../Conf/IdReplicator.prop');
	if (my $file = $self->{PROPERTIES}->getI('file.path')) {
	    $FILE_path = $self->constructPath($file, $FILE_path);
	}
	foreach my $type ('USERS', 'GROUPS', 'GROUPIDS', 'URIS', 'RENAMES') {
	    foreach my $spec ('DB', 'LAST', 'COPYTO') {
		if (my $file = $self->{PROPERTIES}->getI("file.$type.$spec")) {
		    $self->{$type}{$spec} = $self->constructPath($file, $FILE_path);
		}
	    }
	}
	foreach my $type ('USERS', 'GROUPS') {
	    if (my $delim = $self->{PROPERTIES}->getI("file.$type.delim")) {
		$self->{DELIM}{$type} = $delim;
	    }
	}
	if (my $dbFileFormat = $self->{PROPERTIES}->getI('file.db.format')) {
	    $self->{DB_FORMAT} = $dbFileFormat;
	}
    }; if ($@) {if (my $ex = &catch('W3C::Util::FileNotFoundException')) {
	$self->{PROPERTIES} = new W3C::Util::Properties();
    } else {&throw()}}
}

sub constructPath {
    my ($self, $localName, $base) = @_;
    if ($localName =~ m/^[\.\/]/) {
	return $localName;
    } elsif ($base =~ m/\/$/) {
	return "$base$localName";
    } else {
	return "$base/$localName";
    }
}

sub parseArgs {
    my ($self, $args) = @_;
    for (my $argNo = 0; @$args; $argNo++) {
	my $arg = shift @$args;
	if ($arg =~ m/^-d(.*)$/) {
	    my ($level) = $1;
	    if ($level eq '') {
		$level = shift @$args;
	    }
	    if ($level =~ m/changes/) {
		$self->{DEBUG} |= $DEBUG_showChanges;
	    }
	    if ($level =~ m/queries/) {
		$self->{DEBUG} |= $DEBUG_showQueries;
	    }
	    if ($level =~ m/files/) {
		$self->{DEBUG} |= $DEBUG_showFiles;
	    }
	    if ($level =~ m/noedit/) {
		$self->{DEBUG} |= $DEBUG_noEdit;
	    }
	    if ($level =~ m/quick/) {
		$self->{DEBUG} |= $DEBUG_quick;
	    }
	} elsif ($arg =~ m/^path$/) {
	    $FILE_path = shift @$args;
	} elsif ($arg =~ m/^-refresh$/ && 
		 ($arg = shift @$args) && 
		 $arg =~ m/^(users|groups|uris|renames)$/) {
	    my $type = "\U$arg";
	    $self->{REFRESH}{$type} = 1;
	    $self->{JUST_DO}{$type} = 1;
	    $self->{JUST_DO}{DEFAULT_TO_ALL} = 0;
	    if ($type eq 'GROUPS') {
		$self->{REFRESH}{"GROUPIDS"} = 1;
		$self->{JUST_DO}{"GROUPIDS"} = 1;
	    }
	} elsif ($arg =~ m/^(users|groups|uris|renames)$/i) {
	    my ($type) = ("\L$1");
	    $self->{JUST_DO}{DEFAULT_TO_ALL} = 0;
	    $self->{JUST_DO}{"\U$type"} = 1;
	} elsif ($arg =~ m/^expect$/i && 
		 (shift @$args) =~ m/^(users|groups|uris|renames)$/i) {
	    my ($type) = ("\L$1");
	    $self->{JUST_DO}{DEFAULT_TO_ALL} = 0;
	    $self->{JUST_DO}{"\U$type"} = 1;
	    $self->{EXPECT}{"\U$type"} = shift @$args;
	} elsif ($arg =~ m/^delete$/i && 
		 (shift @$args) =~ m/^(user|group|uri)$/i) {
	    my ($type) = ("\U${1}S");
	    my $doomed = shift @$args;
	    push (@{$self->{DELETES}{$type}}, $doomed);
	    if ($type eq 'GROUPS') {
		push (@{$self->{DELETES}{"GROUPIDS"}}, $doomed);
	    }
	} elsif ($arg =~ m/^(users|groups|groupIds|uris|renames)(db|last|copyTo)$/i) {
	    my ($type, $spec) = ("\L$1", "\L$2");
	    $arg = shift @$args;
	    # some special cases...
	    if ($type eq 'groupIds' && $spec eq 'last') {
		$type = 'groups';
	    }
	    if ($spec eq 'last' && $arg =~ m/^\d+$/) {
		$self->{LAST}{"\U$type"} = $arg;
	    } else {
		$self->{"\U$type"}{"\U$spec"} = $arg;
	    }
	} elsif ($arg =~ m/^checksumThreshold$/) {
	    $self->{CHECKSUM_THRESHOLD} = shift @$args;
	} elsif ($arg =~ m/^diagnose$/) {
	    $self->{DIAGNOSE} = 1;
	    $self->{JUST_DO} = {};
	} elsif ($arg =~ m/^access$/i) {
	    if (@$args < 2) {
		die "Argument $argNo: \"access\" needs a principal and a resource.\n";
	    }
	    my $principal = shift @$args;
	    my $resource = shift @$args;
	    push (@{$self->{ACCESS}}, [$principal, $resource]);
	    $self->{JUST_DO} = {};
	} elsif ($arg =~ m/^db$/) {
	    $self->{DB_FORMAT} = 'DB_File';
	} elsif ($arg =~ m/^db$/) {
	    $self->{DB_FORMAT} = 'GDBM_File';
	} elsif ($arg =~ m/^db$/) {
	    $self->{DB_FORMAT} = 'NDBM_File';
	} elsif ($arg =~ m/^db$/) {
	    $self->{DB_FORMAT} = 'SDBM_File';
	} elsif ($arg =~ m/^\-*help$/) {
	    print <<EOF
Usage: $0 *options
  where options is one of:
    -d (changes|queries|files|noedit|quick) - set debug level
    -refresh (users|groups|uris|renames) - re-initialize status file
    -(db,gdbm,ndbm,sdbm) - database format
    (users|groups|uris|renames) - process users|groups|ids
    expect (users|groups|uris|renames) <NUM> - expect last entry of at
                                               least <NUM> (larger is OK)
    delete (user|group|uri) <doomed> - delete entry with the key <doomed>
    (users|groups|groupIds|uris)DB <DBfile>
	- use <DBfile> as a dbm file.
    (users|groups|groupIds|uris|renames)Last <textFile>
	- <textFile> contains last poll time.
    (users|groups|groupIds|uris|renames)Last <number>
	- <number> is the last poll time.
    (users|groups|groupIds|uris)CopyTo <DBfile2>
	- copy <DBfile> over <DBfile2> if there are changes.
    checksumThreshold <num> - checksum diffs to tolerate before failure.
      default: 0 - no diffs tolerated.
      -1: - unlimited diffs tolerated.
    diagnose - look for errors resulting in checksum mismatches.
    access <principal> <resource> - show how <principal> may access <resource>.
EOF
    ;
	    exit(0);
	} else {
	    die "can't parse argument $argNo: \"$arg\"\n  try $0 help\n";
	}
    }
}

sub execute {
    my ($self) = @_;

    # include the appropriate database type
    require "$self->{DB_FORMAT}.pm";

    # First delete anything scheduled for deletion.
    foreach my $type ('GROUPS', 'GROUPIDS', 'USERS', 'URIS') {
	my @keys = @{$self->{DELETES}{$type}};
	if (@keys) {
	    my $db = $self->openDB($type, $FILE_openMode_RW);
	    foreach my $key (@keys) {
		delete $db->{$key};
	    }
	    $self->closeDB($db);
	    $self->{UPDATED}{$type} = 1;
	}
    }

    # Process updates to the hierarchy table.
    if (($self->{JUST_DO}{GROUPS} || 
	 $self->{JUST_DO}{DEFAULT_TO_ALL}) && 
	!defined $self->{LAST}{GROUPS}) {
	$self->{LAST}{GROUPS} = $self->readLast('GROUPS');
    }
    if (defined $self->{LAST}{GROUPS} && 
	$self->{LAST}{GROUPS} ne '-') {

	# Takes the entries from idUpdates after $lastSeqNo and adds
	# or deletes them to the existing groups DBM file (creating
	# the DBM file if it doesn't exist).

	# process hierarchy updates
	my $query = "SELECT sub.value AS subName,super.value AS superName,super.id AS superId,idUpdates.type,idUpdates.action,idUpdates.g AS number,idUpdates.seqNo FROM idUpdates,ids AS sub,ids AS super WHERE sub.id=idUpdates.id AND super.id=idUpdates.groupId AND seqNo > $self->{LAST}{GROUPS} ORDER BY seqNo";
	if ($self->{DEBUG} & $DEBUG_showQueries) {
	    print STDERR "? $query\n";
	}
	my $rows = [];
	$self->{ACL}->{DB}->executeArrayQuery($rows, $query);
	my $count = scalar @$rows;
	if ($self->{DEBUG} & $DEBUG_quick) {
	    print STDERR "dropping $count group updates\n";
	    return;
	}
	if (!$count) {
	    if ($self->{DEBUG} & $DEBUG_noEdit) {
		print STDERR "no records for $self->{FILE_groupsLast} after $self->{LAST}{GROUPS}\n";
	    }
	} else {
	    my $userGroupNames = undef;
	    my $userGroupIds = undef;
	    eval {
		$userGroupNames = $self->openDB('GROUPS', $FILE_openMode_RW);
		$userGroupIds = $self->openDB('GROUPIDS', $FILE_openMode_RW);
		$self->{UPDATED}{'GROUPS'} = 1;
		$self->{UPDATED}{'GROUPIDS'} = 1;
		foreach my $row (@$rows) {
		    $self->processHierarchyUpdates($userGroupNames, 
						   $userGroupIds, $row);
		}
	    };

	    # Capture any exception.
	    my $ex = $@;

	    if ($userGroupIds) {
		$self->closeDB($userGroupIds);
		$userGroupIds = undef;
	    }

	    if ($userGroupNames) {
		$self->closeDB($userGroupNames);
		$userGroupNames = undef;
	    }
	    # Handle any exceptions encountered while processing updates.
	    if ($ex) {&throw($ex)}

	    $self->updateLast('GROUPS');
	    $self->updateLast('GROUPIDS');

	    # Warn of any checksum errors.
	    if ($self->{CHECKSUM_RESULTS}) {
		my ($expected, $actual) = @{$self->{CHECKSUM_RESULTS}};
		print STDERR "checksum mismatch: expected $expected - got $actual\n";
	    }
	}
	if (defined $self->{EXPECT}{GROUPS} && 
	    $self->{EXPECT}{GROUPS} > $self->{LAST}{GROUPS}) {
	    print STDERR "Groups: expected seqNo $self->{EXPECT}{GROUPS}  got $self->{LAST}{GROUPS}\n";
	}
	$self->copyUpdated('GROUPS');
	$self->copyUpdated('GROUPIDS');
    } elsif ($self->{DEBUG} & $DEBUG_noEdit) {
	print STDERR "no last sequence no in \"$self->{FILE_groupsLast}\"- skipping groups\n";
    }

    # Process any new or changed (for instance, new password) user records.
    if (($self->{JUST_DO}{USERS} || 
	 $self->{JUST_DO}{DEFAULT_TO_ALL}) && 
	!defined $self->{LAST}{USERS}) {
	$self->{LAST}{USERS} = $self->readLast('USERS');
    }
    if (defined $self->{LAST}{USERS} && 
	$self->{LAST}{USERS} ne '-') {
	my $last = $self->{LAST}{USERS};

	# process userDetails updates
	my $query = $self->{PROPERTIES}->getI('users.query');
	if (defined $query) {
	    # resolve variable references in queries in the conf file, ala:

	    # SELECT ids.value,userDetails.last+0,userDetails.passwd,
	    # 	     userDetails.cleartxt,substring(uris.uri,8),
	    # 	     userDetails.family,userDetails.given
	    #   FROM userDetails,ids,uris
	    #  WHERE ids.id=userDetails.id
	    #    AND userDetails.emailUrisId=uris.id
	    #    AND userDetails.passwd IS NOT NULL
	    #    AND userDetails.last > $last
	    #  ORDER BY userDetails.last

	    my $now = time; # for query evaluation
	    $query = eval "\"$query\"";
	} else {
	    my $queryData = $self->{PROPERTIES}->getI('users.query.fields');
	    # Conf-supplied set of fields to query ala:

	    # userDetails.passwd,userDetails.cleartxt,userDetails.family,userDetails.given

	    if (!defined $queryData) {
		$queryData = $USERS_DEFAULT_QUERY;
	    }
	    $query = "SELECT ids.value AS name,ids.stops as stops, userDetails.last+0,$queryData FROM userDetails,ids WHERE ids.id=userDetails.id AND userDetails.passwd IS NOT NULL AND userDetails.last > $self->{LAST}{USERS} ORDER BY userDetails.last";
	}
	if ($self->{DEBUG} & $DEBUG_showQueries) {
	    print STDERR "? $query\n";
	}

	# query the database
	my $rows = [];
	$self->{ACL}->{DB}->executeUpdate('LOCK TABLES userDetails READ,ids READ,uris READ');
	$self->{ACL}->{DB}->executeArrayQuery($rows, $query);
	my $count = scalar @$rows;
	if ($self->{DEBUG} & $DEBUG_quick) {
	    print STDERR "dropping $count user updates\n";
	    return;
	}
	if (!$count) {
	    if ($self->{DEBUG} & $DEBUG_noEdit) {
		print STDERR "no records for $self->{FILE_usersLast} after $self->{LAST}{USERS}\n";
	    }
	} else {
	    # get the time once in case we will need it later.
	    my $now = time;
    
	    my $userPasswords = undef;
	    eval {
		$userPasswords = $self->openDB('USERS', $FILE_openMode_RW);
		$self->{UPDATED}{'USERS'} = 1;

		foreach my $row (@$rows) {
		    $self->updateUserPasswordEntry($row, $userPasswords);
		}
	    };

	    # Capture any exception.
	    my $ex = $@;

	    if ($userPasswords) {
		$self->closeDB($userPasswords);
		$userPasswords = undef;
	    }

	    # Handle any exceptions encountered while processing updates.
	    if ($ex) {&throw($ex)}

	    $self->updateLast('USERS');
	    while (time <= $now+1) {
		sleep (1);
	    }
	}
	$self->{ACL}->{DB}->executeUpdate('UNLOCK TABLES');
	if (defined $self->{EXPECT}{USERS} && 
	    $self->{EXPECT}{USERS} > $self->{LAST}{USERS}) {
	    print STDERR "Users: expected last update $self->{EXPECT}{USERS}  got $self->{LAST}{USERS}\n";
	}
	$self->copyUpdated('USERS');
    } elsif ($self->{DEBUG} & $DEBUG_noEdit) {
	print STDERR "no last update date in \"$self->{FILE_usersLast}\" - skipping users\n";
    }

    # Process any new or changed (for instance, new password) user records.
    if (($self->{JUST_DO}{URIS} || 
	 $self->{JUST_DO}{DEFAULT_TO_ALL}) && 
	!defined $self->{LAST}{URIS}) {
	$self->{LAST}{URIS} = $self->readLast('URIS');
    }
    if (defined $self->{LAST}{URIS} && 
	$self->{LAST}{URIS} ne '-') {

	# process userDetails updates
	my $query = "SELECT acls.acl,acls.id,acls.access FROM uris,acls WHERE uris.acl>0 AND acls.acl=uris.acl AND uris.last >= timestamp($self->{LAST}{URIS}) GROUP BY acls.acl,acls.id,acls.access";
	if ($self->{DEBUG} & $DEBUG_showQueries) {
	    print STDERR "? $query\n";
	}

	my $aclRows = [];
	$self->{ACL}->{DB}->executeArrayQuery($aclRows, $query);
	my $aclCount = scalar @$aclRows;
	if (!$aclCount) {
	    if ($self->{DEBUG} & $DEBUG_noEdit) {
		print STDERR "no records for $self->{FILE_urisLast} after $self->{LAST}{URIS}\n";
	    }
	} else {
	    my $acls = {}; # hash of known combinations of ACLs

	    foreach my $row (@$aclRows) {
		my ($acl, $id, $access) = @$row;
		$acls->{$acl}{$id} = $access;
	    }
	    # $acls->{6}{100} = 3122;
	    # $acls->{6}{102} = 3955;

	    # Turn each acl key into a blob that is an array of
	    # integers representing a repeating pattern of
	    # (groupId, access bit field).
	    foreach my $acl (keys %$acls) {
		my @idAccessPairs = ();
		foreach my $id (keys %{$acls->{$acl}}) {
		    push (@idAccessPairs, $id, $acls->{$acl}{$id});
		}
		# replace $acls->{$acl} with a scalar
		$acls->{$acl} = pack ("$ID_PACK*", @idAccessPairs);
	    }
	    # $acls->{6} = [100 3122 102 3955];

	    my $query = "SELECT uris.uri,uris.acl,uris.last+0 FROM uris WHERE uris.acl>0 AND uris.last >= timestamp($self->{LAST}{URIS}) ORDER BY last,id";
	    if ($self->{DEBUG} & $DEBUG_showQueries) {
		print STDERR "? $query\n";
	    }

	    my $rows = [];
	    $self->{ACL}->{DB}->executeArrayQuery($rows, $query);
	    my $count = scalar @$rows;
	    if ($self->{DEBUG} & $DEBUG_quick) {
		print STDERR "dropping $count user updates\n";
		return;
	    }
	    if (!$count) {
		&throw(new W3C::Util::ProgramFlowException());
	    }
	    my $uris = undef;
	    eval {
		$uris = $self->openDB('URIS', $FILE_openMode_RW);
		$self->{UPDATED}{'URIS'} = 1;
		foreach my $row (@$rows) {
		    my ($uri, $acl, $last) = @$row;
		    $self->{LAST}{URIS} = $last;
		    my $entry = $acls->{$acl};
		    if ($self->{DEBUG} & $DEBUG_noEdit) {
		    } else {
			$uris->{$uri} = $entry;
		    }
		    if ($self->{DEBUG} & $DEBUG_showChanges) {
			my $entryString = join (' ', unpack ("$ID_PACK*", $entry));
			print STDERR ": $uri:$entryString\n";
		    }
		}
	    };

	    # Capture any exception.
	    my $ex = $@;

	    if ($uris) {
		$self->closeDB($uris);
		$uris = undef;
	    }

	    # Handle any exceptions encountered while processing updates.
	    if ($ex) {&throw($ex)}

	    $self->updateLast('URIS');
	}
	if (defined $self->{EXPECT}{URIS} && 
	    $self->{EXPECT}{URIS} > $self->{LAST}{URIS}) {
	    print STDERR "Uris: expected last update $self->{EXPECT}{URIS}  got $self->{LAST}{URIS}\n";
	}
	$self->copyUpdated('URIS');
    } elsif ($self->{DEBUG} & $DEBUG_noEdit) {
	print STDERR "no last update date in \"$self->{FILE_urisLast}\" - skipping uris\n";
    }

    # Process any new or changed (for instance, new password) user records.
    if (($self->{JUST_DO}{RENAMES} || 
	 $self->{JUST_DO}{DEFAULT_TO_ALL}) && 
	!defined $self->{LAST}{RENAMES}) {
	$self->{LAST}{RENAMES} = $self->readLast('RENAMES');
    }
    if (defined $self->{LAST}{RENAMES} && 
	$self->{LAST}{RENAMES} ne '-') {

	# process userDetails updates
	my $query = "SELECT renames.id,frum,too,seqNo FROM renames,ids WHERE ids.id = renames.id AND ids.stops = 0 AND seqNo > $self->{LAST}{RENAMES} ORDER BY seqNo";

	if ($self->{DEBUG} & $DEBUG_showQueries) {
	    print STDERR "? $query\n";
	}

	my $renameRows = {};
	$self->{ACL}->{DB}->executeHashArrayArrayQuery($renameRows, $query);
	my $renameCount = scalar %$renameRows;
	if (!$renameCount) {
	    if ($self->{DEBUG} & $DEBUG_noEdit) {
		print STDERR "no records for $self->{FILE_renamesLast} after $self->{LAST}{RENAMES}\n";
	    }
	} else {
	    my $in = join (',', keys %$renameRows);

	    my $groupQuery = "SELECT idUpdates.id,supers.value,supers.id,idUpdates.seqNo FROM idUpdates,ids AS supers WHERE idUpdates.id IN ($in) AND idUpdates.action=\"add\" AND idUpdates.groupId=supers.id";
	    my $newGroupEntries = {};
	    $self->{ACL}->{DB}->executeHashArrayArrayQuery($newGroupEntries, $groupQuery);

	    my $queryData = $self->{PROPERTIES}->getI('users.query.fields');
	    if (!defined $queryData) {
		$queryData = $USERS_DEFAULT_QUERY;
	    }
	    my $userQuery = "SELECT userDetails.id,userDetails.last+0,$queryData FROM userDetails WHERE userDetails.id IN ($in) AND userDetails.passwd IS NOT NULL ORDER BY userDetails.last";
	    my $newUserEntries = {};
	    $self->{ACL}->{DB}->executeHashArrayArrayQuery($newUserEntries, $userQuery);

	    my $userPasswords = undef;
	    my $userGroupNames = undef;
	    my $userGroupIds = undef;
	    eval {
		$userPasswords = $self->openDB('USERS', $FILE_openMode_RW);
		$userGroupNames = $self->openDB('GROUPS', $FILE_openMode_RW);
		$userGroupIds = $self->openDB('GROUPIDS', $FILE_openMode_RW);
		$self->{UPDATED}{'USERS'} = 1;
		$self->{UPDATED}{'GROUPS'} = 1;
		$self->{UPDATED}{'GROUPIDS'} = 1;
		foreach my $renameId (keys %$renameRows) {
		    foreach my $renameRow (@{$renameRows->{$renameId}}) {
			my ($frum, $too, $seqNo) = @$renameRow;
			if ($self->{DEBUG} & $DEBUG_noEdit) {
			} else {
			    delete $userPasswords->{$too};
			    delete $userPasswords->{$frum};
			    delete $userGroupNames->{$too};
			    delete $userGroupNames->{$frum};
			    delete $userGroupIds->{$too};
			    delete $userGroupIds->{$frum};
			}
			if ($self->{DEBUG} & $DEBUG_showChanges) {
			    print STDERR ": deleting $frum and $too\n";
			}

			# Drop in the new entries.
			# First the user (password) entry.
			# Huh, we need to have stops and the username too in the array to be able to call updateUserPasswordEntry
			# we use stops = 0, which is always true at this stage (previous queries ensure that)
			unshift (@{$newUserEntries->{$renameId}[0]}, '0');
			# add the username
			unshift (@{$newUserEntries->{$renameId}[0]}, $too);

			$self->updateUserPasswordEntry($newUserEntries->{$renameId}[0], $userPasswords);

			# Then all the group entries for this user.
			foreach my $newGroupEntry (@{$newGroupEntries->{$renameId}}) {
			    my ($superName, $superId, $seqNo) = @$newGroupEntry;
			    # Here we are more formal and fake a new row.
			    my $tmpRow = [$too, $superName, $superId, undef, 'add', undef, $seqNo];
			    $self->processHierarchyUpdates($userGroupNames, $userGroupIds, $tmpRow);
			}
			if ($seqNo > $self->{LAST}{RENAMES}) {
			    $self->{LAST}{RENAMES} = $seqNo;
			}
		    }
		}
	    };

	    # Capture any exception.
	    my $ex = $@;

	    if ($userPasswords) {
		$self->closeDB($userPasswords);
		$userPasswords = undef;
	    }

	    if ($userGroupNames) {
		$self->closeDB($userGroupNames);
		$userGroupNames = undef;
	    }

	    if ($userGroupIds) {
		$self->closeDB($userGroupIds);
		$userGroupIds = undef;
	    }

	    # Handle any exceptions encountered while processing updates.
	    if ($ex) {
		if (my $ex = &catch('W3C::Util::Exception')) {
		    &throw($ex);
		} else {
		    &throw(new W3C::Util::PerlException(-error => $@));
		}
	    }

	    $self->updateLast('RENAMES');
	}
	if (defined $self->{EXPECT}{RENAMES} && 
	    $self->{EXPECT}{RENAMES} > $self->{LAST}{RENAMES}) {
	    print STDERR "renames: expected last update $self->{EXPECT}{RENAMES}  got $self->{LAST}{RENAMES}\n";
	}
	$self->copyUpdated('USERS');
	$self->copyUpdated('GROUPS');
	$self->copyUpdated('GROUPIDS');
    } elsif ($self->{DEBUG} & $DEBUG_noEdit) {
	print STDERR "no last update date in \"$self->{FILE_renamesLast}\" - skipping renames\n";
    }

    # Diagnose checksum mismatches.
    if ($self->{DIAGNOSE}) {

	# Takes the entries from idUpdates after $lastSeqNo and adds
	# or deletes them to the existing groups DBM file (creating
	# the DBM file if it doesn't exist).

	# process hierarchy updates
	my $query = "SELECT ids.value,idGroupCounts.count FROM idGroupCounts,ids WHERE ids.id=idGroupCounts.id";
	if ($self->{DEBUG} & $DEBUG_showQueries) {
	    print STDERR "? $query\n";
	}
	my $rows = [];
	$self->{ACL}->{DB}->executeArrayQuery($rows, $query);
	my $count = scalar @$rows;
	if ($self->{DEBUG} & $DEBUG_quick) {
	    print STDERR "dropping $count group count lines\n";
	    return;
	}
	if (!$count) {
	    if ($self->{DEBUG} & $DEBUG_noEdit) {
		print STDERR "no records in idGroupCounts\n";
	    }
	} else {
	    my $userGroupNames = undef;
	    my $userGroupIds = undef;

	    my $errorsByNameForGroups = {};
	    my $errorsByNameForGroupIds = {};
	    my $nameCountsForGroups = {};
	    my $nameCountsForGroupIds = {};

	    eval {
		foreach my $row (@$rows) {
		    # for each row in the SQL results...
		    my ($name, $count) = @$row;
		    $nameCountsForGroups->{$name} = $count;
		    $nameCountsForGroupIds->{$name} = $count;
		}

		$userGroupNames = $self->openDB('GROUPS', $FILE_openMode_RO);
		foreach my $key (keys %$userGroupNames) {
		    # for each row in the local database...
		    if (!exists $nameCountsForGroups->{$key}) {
			$errorsByNameForGroups->{$key}{ERROR} = $ADDITIONAL;
		    } else {
			my @gNames = split ($self->{DELIM}{GROUPS}, $userGroupNames->{$key});
			if (scalar @gNames == $nameCountsForGroups->{$key}) {
			    # Counts match, expected common case.
			    delete $nameCountsForGroups->{$key};
			} else {
			    $errorsByNameForGroups->{$key}{ERROR} = $MISCOUNT;
			    $errorsByNameForGroups->{$key}{GROUPS} = [@gNames];
			}
		    }
		}

		$userGroupIds = $self->openDB('GROUPIDS', $FILE_openMode_RO);
		foreach my $key (keys %$userGroupIds) {
		    # for each row in the local database...
		    if (!exists $nameCountsForGroupIds->{$key}) {
			$errorsByNameForGroupIds->{$key}{ERROR} = $ADDITIONAL;
		    } else {
			my @gIds = unpack ("$ID_PACK*", $userGroupIds->{$key});
			if (scalar @gIds == $nameCountsForGroupIds->{$key}) {
			    # Counts match, expected common case.
			    delete $nameCountsForGroupIds->{$key};
			} else {
			    $errorsByNameForGroupIds->{$key}{ERROR} = $MISCOUNT;
			    $errorsByNameForGroupIds->{$key}{GROUPIDS} = [@gIds];
			}
		    }
		}
	    };

	    # Capture any exception.
	    my $ex = $@;

	    if ($userGroupIds) {
		$self->closeDB($userGroupIds);
		$userGroupIds = undef;
	    }

	    if ($userGroupNames) {
		$self->closeDB($userGroupNames);
		$userGroupNames = undef;
	    }

	    foreach my $key (keys %$errorsByNameForGroups) {
		my $error = $errorsByNameForGroups->{$key}{ERROR};
		my $errorSet;
		if (exists $errorsByNameForGroupIds->{$key} && 
		    $error == $errorsByNameForGroupIds->{$key}{ERROR}) {
		    $errorSet = "in databases";
		    delete $errorsByNameForGroupIds->{$key};
		    # If groups and groupIds have different miscounts,
		    # just report groups.
		} else {
		    $errorSet = "in groups database";
		}
		if ($error == $ADDITIONAL) {
		    print "Extra entry for $key $errorSet\n";
		} elsif ($error == $MISCOUNT) {
		    my $got = join (' | ', @{$errorsByNameForGroups->{$key}{GROUPS}});
		    print "Miscount for $key $errorSet, expected ", 
		    $nameCountsForGroups->{$key}, " got $got\n";
		} else {
		    print "Unknown error for $key $errorSet\n";
		}
		delete $nameCountsForGroups->{$key};
	    }

	    foreach my $key (keys %$errorsByNameForGroupIds) {
		my $error = $errorsByNameForGroupIds->{$key}{ERROR};
		if ($error == $ADDITIONAL) {
		    print "Extra entry for $key in groupids database\n";
		} elsif ($error == $MISCOUNT) {
		    my $got = join (' | ', @{$errorsByNameForGroupIds->{$key}{GROUPIDS}});
		    print "Miscount for $key in groupids database, expected ", 
		    $nameCountsForGroupIds->{$key}, " got $got\n";
		} else {
		    print "Unknown error for $key in groupids\n";
		}
		delete $nameCountsForGroupIds->{$key};
	    }

	    foreach my $key (keys %$nameCountsForGroups) {
		my $errorSet;
		if (exists $nameCountsForGroupIds->{$key}) {
		    $errorSet = "databases";
		    delete $nameCountsForGroupIds->{$key};
		    # If groups and groupIds have different miscounts,
		    # just report groups.
		} else {
		    $errorSet = "groups database";
		}
		print "No entry for $key in $errorSet, expected ", 
		$nameCountsForGroups->{$key}, "\n";
	    }

	    foreach my $key (keys %$nameCountsForGroupIds) {
		print "No entry for $key in groupIds database, expected ", 
		$nameCountsForGroupIds->{$key}, "\n";
	    }

	    # Handle any exceptions encountered while processing updates.
	    if ($ex) {
		if (my $ex = &catch('W3C::Util::Exception')) {
		    &throw($ex);
		} else {
		    &throw(new W3C::Util::PerlException(-error => $@));
		}
	    }

	}
    }

    # Show how principals may access resources.
    if (@{$self->{ACCESS}}) {
	my $userGroupIds = $self->openDB('GROUPIDS', $FILE_openMode_RO);
	my $uris = $self->openDB('URIS', $FILE_openMode_RO);
	
	foreach my $pair (@{$self->{ACCESS}}) {
	    my ($principal, $resource) = @$pair;
	    if (!exists $uris->{$resource}) {
		print "No rules for $resource\n";
	    } else {
		my @accessorIds = unpack ("$ID_PACK*", $uris->{$resource});
		if (!exists $userGroupIds->{$principal}) {
		    print "No rules for principal $principal\n";
		} else {
		    my @principalGroupIds = unpack ("$ID_PACK*", $userGroupIds->{$principal});

		    my $found = 0;
		    for (my $iAccessor = 0; $iAccessor < @accessorIds; $iAccessor+=2) {
			my $accessorId = $accessorIds[$iAccessor];
			my $access = $accessorIds[$iAccessor+1];
			my $accessStr = W3C::Rnodes::ACL::accessString($access);
			foreach my $principalGroupId (@principalGroupIds) {
			    if ($accessorId == $principalGroupId) {
				$found++;
				print "$principal has $access ($accessStr) access to $resource via id $accessorId\n";
			    }
			}
		    }
		    if (!$found) {
			print "$principal has no access to $resource\n";
		    }
		}
		$self->closeDB($uris);
		$self->closeDB($userGroupIds);
	    }
	}
    }

}

sub openDB {
    my ($self, $type, $openMode) = @_;
    my $file = $self->{$type}{DB};
    my $format = $self->{DB_FORMAT};
    my $dbm = {};
    if (!tie (%$dbm, $format, $file, $openMode, $FILE_createMode)) {
	&throw(new W3C::Util::Exception(-message => "Access to \"$file\" failed. $!"));
    }

    # Show files as they are opened.
    if ($self->{DEBUG} & $DEBUG_showFiles) {
	my $marker = $openMode == $FILE_openMode_RO ? '<' : 
	    $openMode == $FILE_openMode_RW ? '>' : "?$openMode?";
	print STDERR "|$marker $file\n";
    }

    # Refresh flags indicate that the database should be emptied out.
    if ($self->{REFRESH}{$type}) {
	foreach my $key (keys %$dbm) {
	    delete $dbm->{$key};
	}
    }

    return $dbm;
}

sub closeDB {
    my ($self, $handle) = @_;
    untie(%$handle);
}

sub processHierarchyUpdates {
    my ($self, $userGroupNames, $userGroupIds, $row) = @_;

    # dbm file has records of the form:
    #   eric:w3cteamgroup w3cmembergroup w3tpasswords
    # sql query results has records of the form:
    #   w3cteamgroup U eric del 3 1183
    #   w3ctpasswords U eric del 3 1183

    # for each row in the SQL results...
    my ($subName, $superName, $superId, $type, $action, $number, $seqNo) = @$row;
    if ($action eq 'add' || $action eq 'del') {
	if ($self->{DEBUG} & $DEBUG_noEdit) {
	} else {
	    # deconstruct the existing groups from the dbm file
	    # produce hash of the form:
	    #   ('w3tteamgroup' => undef, 'w3tmembergroup' => undef)
	    my $nameList = {map {$_, undef} 
			    split ($self->{DELIM}{GROUPS}, $userGroupNames->{$subName})};
	    my $idList = {map {$_, undef} 
			  unpack ("$ID_PACK*", $userGroupIds->{$subName})};

	    if ($action eq 'add') {
		# create a new hash entry
		$nameList->{$superName} = undef;
		$idList->{$superId} = undef;
	    } else {
		# delete existing hash entry
		delete $nameList->{$superName};
		delete $idList->{$superId};
	    }

	    if (keys %$nameList) {
		# reassemble the value (list of groups) for this key (user or ip)
		$userGroupNames->{$subName} = join ($self->{DELIM}{GROUPS}, keys %$nameList);
		$userGroupIds->{$subName} = pack ("$ID_PACK*", keys %$idList);
	    } else {
		delete $userGroupNames->{$subName};
		delete $userGroupIds->{$subName};
	    }
	}
	if ($action eq 'add') {
	    # add
	    if ($self->{DEBUG} & $DEBUG_showChanges) {
		print STDERR "> $subName:$superName\n";
	    }
	} else {
	    # del
	    if ($self->{DEBUG} & $DEBUG_showChanges) {
		print STDERR "< $subName:$superName\n";
	    }
	}
    } elsif ($action eq 'cpl') {
    } elsif ($action eq 'clr') {
	foreach my $key (keys %$userGroupNames) {
	    delete $userGroupNames->{$key};
	}
	foreach my $key (keys %$userGroupIds) {
	    delete $userGroupIds->{$key};
	}
    } elsif ($action eq 'sum') {
	my $actualCount = scalar keys %$userGroupNames;
	if ($number != $actualCount) {
	    $self->{CHECKSUM_RESULTS} = [$number, $actualCount];
	    if ($self->{CHECKSUM_THRESHOLD} == -1 || 
		abs($number - $actualCount)>$self->{CHECKSUM_THRESHOLD}) {
	    } else {
		&throw(new W3C::Util::Exception(-message => 
						"checksum mismatch: expected $number - got $actualCount\n"));
	    }
	}
    } else {
	&throw(new W3C::Util::Exception(-message => 
					"unknown action: $action"));
    }
    $self->{LAST}{GROUPS} = $seqNo;
}

# Update the user password database entry.
sub updateUserPasswordEntry {
    my ($self, $row, $userPasswords) = @_;
    my ($name, $stops, $last, @data) = @$row;
    $self->{LAST}{USERS} = $last;

    if ($stops == 0) { # add / update
	# splice password into possibly existent user entry
	my @entryData = ();
	my $template = $USERS_DEFAULT_TEMPLATE;
	if ($userPasswords->{$name}) {
	    @entryData = split($self->{DELIM}{USERS}, $userPasswords->{$name});
	    if (my $updateTemplate = $self->{PROPERTIES}->getI('users.template.update')) {
		# ala:
		# users.template.update: $data[0],undef,undef,undef,$data[1],$data[2],$data[3],$data[4],$now,undef
		$template = $updateTemplate;
	    }
	} elsif (my $newTemplate = $self->{PROPERTIES}->getI('users.template.new')) {
	    # ala:
	    # users.template.new:    $data[0],2,    0,    3,    $data[1],$data[2],$data[3],$data[4],$now,$now
	    $template = $newTemplate;
	}
	my @templateEntries = split (/\s*,\s*/, $template);
	for (my $i = 0; $i < @templateEntries; $i++) {
	    my $templateEntry = $templateEntries[$i];
	    if ($templateEntry eq 'undef' || $templateEntry eq 'NULL') {
	    } else {
		# resolve variable references
		my $now = time; # for template evaluation
		$entryData[$i] = eval $templateEntry;
	    }
	}
	my $entryString = join($self->{DELIM}{USERS}, @entryData);

	if ($self->{DEBUG} & $DEBUG_noEdit) {
	} else {
	    $userPasswords->{$name} = $entryString;
	}
	if ($self->{DEBUG} & $DEBUG_showChanges) {
	    print STDERR ": $name:$entryString\n";
	}

    } else { # delete entry
	if ($self->{DEBUG} & $DEBUG_noEdit) {
        } else {
	    delete $userPasswords->{$name};
	}
	if ($self->{DEBUG} & $DEBUG_showChanges) {
	    print STDERR ": deleted $name\n";
	}
    }
}

# Read the last update time (or sequence number) from $fileName.
sub readLast {
    my ($self, $type) = @_;
    my $fileName = $self->{$type}{LAST};
    my $refresh = $self->{REFRESH}{$type};
    my $ret = undef;
    if (defined $fileName) {
	if ($refresh) {
	    if (!open(LAST, ">$fileName")) {
		&throw(new W3C::Util::Exception(-message => "failed to open $fileName: $!"));
	    }
	    print LAST "0\n";
	    $ret = 0;
	} else {
	    if (!open(LAST, "$fileName")) {
		if (!(-e $fileName)) {
		    &throw(new W3C::Util::FileNotFoundException(-filename => 
								$fileName));
		} else {
		    &throw(new W3C::Util::Exception(-message => "failed to open $fileName: $!"));
		}
	    }
	    $ret = <LAST>;
	    chomp $ret;
	    close LAST;
	}
    }
    return $ret;
}

# Write the last update time (or sequence number) to $fileName.
# Also copy $copyFrom over $copyTo if $copyTo is set.
sub updateLast {
    my ($self, $type) = @_;
    my $fileName = $self->{$type}{LAST};
    my $last = $self->{LAST}{$type};

    if ($self->{DEBUG} & $DEBUG_noEdit) {
	print STDERR "would update $fileName with $last\n";
	return;
    }

    if (defined $last && defined $fileName) {
 	if (!open(LAST, ">$fileName")) {
	    &throw(new W3C::Util::Exception(-message => "failed to open $fileName: $!"));
	}
	print LAST "$last\n";
	close LAST;
    }
}

sub copyUpdated {
    my ($self, $type) = @_;
    if ($self->{UPDATED}{$type} && 
	defined $self->{$type}{COPYTO}) {
	my $copyTo = $self->{$type}{COPYTO};
	my $copyFrom = $self->{$type}{DB};
	my $tmpFile = "$copyTo.tmp";
	if ($self->{DB_FORMAT} eq 'NDBM_File') {
	    if (-e "$tmpFile.dir" || -e "$tmpFile.pag") {
		&throw(new W3C::Util::Exception(-message => "tmp file $tmpFile already exists"));
	    }
	    if (system('cp', '-f', "$copyFrom.dir", "$tmpFile.dir") != 0 || ($? >> 8) != 0 || 
		system('cp', '-f', "$copyFrom.pag", "$tmpFile.pag") != 0 || ($? >> 8) != 0 || 
		system('mv', '-f', "$tmpFile.dir", "$copyTo.dir") != 0 || ($? >> 8) != 0 || 
		system('mv', '-f', "$tmpFile.pag", "$copyTo.pag") != 0 || ($? >> 8) != 0) {
		&throw(new W3C::Util::Exception(-message => "Unable to replace $copyTo with $copyFrom"));
	    }
	} else {
	    if (-e $tmpFile) {
		&throw(new W3C::Util::Exception(-message => "tmp file $tmpFile already exists"));
	    }
	    if (system('cp', '-f', $copyFrom, $tmpFile) != 0 || ($? >> 8) != 0 || 
		system('mv', '-f', $tmpFile, $copyTo) != 0 || ($? >> 8) != 0) {
		&throw(new W3C::Util::Exception(-message => "Unable to replace $copyTo with $copyFrom"));
	    }
	}
	$self->{UPDATED}{$type} = undef;
    }
}

1;

__END__

=head1 NAME

replicateIds - 

=head1 SYNOPSIS

  replicateIds - Replicate changes to the w3c hierarchy table as maintained in the idUpdates table by compileAcls.

=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::(3) perl(1).

=cut