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

# Constants, and human-readable strings used in W3C-specific ChACL applications.
# Also has some importer functions badly out of maintenance.

use strict;
require Exporter;
#require AutoLoader;

$W3C::Rnodes::W3CWebAcls::REVISION = '$Id: W3CWebAcls.pm,v 1.19 2005/03/17 05:56:53 eric Exp $ ';

package W3C::Rnodes::W3CWebAcls;

use W3C::Rnodes::ACL qw($ACCESS_FOR_FILESYSTEM_RW $ACCESS_FOR_FILESYSTEM_RX 
			$ACCESS_FOR_FILESYSTEM_RWX $ACCESS_FOR_FILESYSTEM_READ
			$MACRO_RULES $MACRO_RULEID $MACRO_RULENAME
			$MACRO_RULEICON $MACRO_RULEDESC
			$MACRO_RULE_TYPE $MACRO_RULE_ID
			$MACRO_RULE_ACCESS
			&parseDBRule &buildDBRuleId);

use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter); # AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw(@MACRO_OPTIONS @MACRO_LAYOUT
		&getStandardW3CMacro &standardDescToW3CMacro
		&standardW3CMacroToDesc &standardW3CMacroToIcon &standardMatch);
$VERSION = 0.10;
$DSLI = 'adpO';

use vars qw(@MACRO_USER @MACRO_TEAM @MACRO_MEMBER @MACRO_WORLD  @MACRO_AB @MACRO_OFFICE
	    @MACRO_USER_SCRIPT @MACRO_TEAM_SCRIPT @MACRO_MEMBER_SCRIPT @MACRO_WORLD_SCRIPT);

@MACRO_USER =		('user', 0x04, '/Icons/toc5off.gif', 
			 [['U', undef, 
			   $ACCESS_FOR_FILESYSTEM_RW]], 
			 'current user: RW');
@MACRO_TEAM =		('team', 0x05, '/Icons/toc3off.gif', 
			 [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RW]], 
			 'w3t_passwords: RW'); 
@MACRO_MEMBER =		('member', 0x06, '/Icons/toc2off.gif', 
			 [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RW], 
			  ['G', 'cabal', 
			   $ACCESS_FOR_FILESYSTEM_READ]], 
			 'w3t_passwords: RW  w3cmembergroup: R');
@MACRO_WORLD =		('world', 0x07, '/Icons/toc1off.gif', 
			 [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RW], 
			  ['A', 'all',
			   $ACCESS_FOR_FILESYSTEM_READ]], 
			 'w3t_passwords: RW  world: R'); 
@MACRO_AB    =          ('AB',197,'/Icons/toc5off.gif',
                         [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RW], 
                           ['G', 'w3c_AdvisoryBoard', 
			   $ACCESS_FOR_FILESYSTEM_READ]], 
			 'w3t_passwords: RW  w3cAdvisoryBoard: R');
@MACRO_OFFICE    =      ('Offices',284,'/Icons/toc5off.gif',
                         [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RW], 
                           ['G', 'w3c_offices', 
			   $ACCESS_FOR_FILESYSTEM_READ]], 
			 'w3t_passwords: RW  w3c_offices: R');
@MACRO_USER_SCRIPT =	('user-script', 0x14, '/Icons/toc5off.gif', 
			 [['U', undef, 
			   $ACCESS_FOR_FILESYSTEM_RWX]], 
			 'current user: RWX');
@MACRO_TEAM_SCRIPT =	('team-script', 0x15, '/Icons/toc3off.gif', 
			 [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RWX]], 
			 'w3t_passwords: RWX');
@MACRO_MEMBER_SCRIPT =	('member-script', 0x16, '/Icons/toc2off.gif', 
			 [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RWX], 
			  ['G', 'cabal', 
			   $ACCESS_FOR_FILESYSTEM_RX]], 
			 'w3t_passwords: RWX  w3cmembergroup: RX');
@MACRO_WORLD_SCRIPT =	('world-script', 0x17, '/Icons/toc1off.gif', 
			 [['G', 'w3t_passwords', 
			   $ACCESS_FOR_FILESYSTEM_RWX], 
			  ['A', 'all', 
			   $ACCESS_FOR_FILESYSTEM_RX]], 
			 'w3t_passwords: RWX  world: RX');

use vars qw(@MACRO_OPTIONS @MACRO_LAYOUT);
@MACRO_OPTIONS = (\@MACRO_USER, \@MACRO_TEAM, \@MACRO_MEMBER, \@MACRO_WORLD, 
		  \@MACRO_AB, \@MACRO_OFFICE, \@MACRO_USER_SCRIPT, \@MACRO_TEAM_SCRIPT, \@MACRO_MEMBER_SCRIPT, \@MACRO_WORLD_SCRIPT);
#@MACRO_LAYOUT = ([\@MACRO_USER, \@MACRO_TEAM, \@MACRO_MEMBER, \@MACRO_WORLD], 
#		 [\@MACRO_USER_SCRIPT, \@MACRO_TEAM_SCRIPT, \@MACRO_MEMBER_SCRIPT, \@MACRO_WORLD_SCRIPT]);
#@MACRO_LAYOUT = ([\@MACRO_TEAM, \@MACRO_MEMBER, \@MACRO_WORLD], 
#		 [\@MACRO_TEAM_SCRIPT, \@MACRO_MEMBER_SCRIPT, \@MACRO_WORLD_SCRIPT]);
@MACRO_LAYOUT = ([\@MACRO_TEAM, \@MACRO_MEMBER, \@MACRO_WORLD, \@MACRO_AB, \@MACRO_OFFICE]);

# ----------- StandardW3CMacro functions ------------- #
# Each AclInterface can have a set of standard ACLs that it renders special
# ways. These corespond to Team, Member, and World for the W3C ACL system.

sub getStandardW3CMacro { # static
    my ($aclDB, $user) = @_;
    my $ret = undef;
    my %resourceBins = $aclDB->getResourceBins();
    my @keys = keys %resourceBins;
    if (@keys == 1) {
	my $dbEntries = $resourceBins{$keys[0]}->[1];

	# rehash the resources in this bin by type and name
	my $byType = {};
	foreach my $dbEntry (@$dbEntries) {
	    my ($type, $name, $access) = &parseDBRule($dbEntry);
	    $byType->{$type}{$name} = $access;
	}

	my ($lastMatch, $lastDiffs, $lastApplies) = 
	    &standardMatch($aclDB, $user, $byType, [$aclDB->getResources()]);
	if (!defined $lastDiffs || $lastDiffs->rulesMatching(undef, undef, undef) == 0) {
	    $ret = $MACRO_OPTIONS[$lastMatch][$MACRO_RULEID];
	}
    }
    return $ret;
}

sub standardMatch { # static
    my ($aclCheckDB, $user, $byType, $resources) = @_;

    # store best match and how the current ACLs differ from it
    my $lastMatch = -1;
    my $lastDiffs = $aclCheckDB;
    my $lastApplies = 0;

    # walk W3C::Rnodes::W3CHttpAcl's list of rule sets
  MACRO:
    for (my $i = 0; $i < @MACRO_OPTIONS; $i++) {
	my $macro = $MACRO_OPTIONS[$i];
	my $ruleName = $macro->[$MACRO_RULENAME];
	my $rules = $macro->[$MACRO_RULES];
	my $applies = 0;

	# make local copy of diffs from aclCheckDB so we can tweak it
	my $diffs = $aclCheckDB->copy;

	# walk this rule set to see whether it is a subset of the current ACLs
	# represented by byType rules
	foreach my $rule (@$rules) {
	    my $type = $rule->[$MACRO_RULE_TYPE];
	    my $id = $rule->[$MACRO_RULE_ID];
	    my $access = $rule->[$MACRO_RULE_ACCESS];

	    # The 'user' rules have an undefined user so we check access for the
	    # current user. We know that the user will be defined if the ACL is
	    # really at 'user' level because they would have had to supply auth
	    # to prove racl rights.
	    $id = $user if (!defined $id);
	    my $curAccess = $byType->{$type}{$id};
	    if (($curAccess & $access) != $access) {
		next MACRO;
	    }

	    # see if this rule applies to us
	    if (!$applies) {
		my @entries = $diffs->rulesMatching([$resources->[0]], undef, undef);
		foreach my $dbEntry (@entries) { # (@{$diffs->rulesMatching([$resources->[0]], undef, undef)}) {
		    if ($diffs->passed($dbEntry)) {
			$applies = 1;
			last;
		    }
		}
	    }

	    # remove this rule from the diffs copy
	    if ($curAccess != $access) {
		my $newAccess = $curAccess & ($access ^ ~1);
		map {$diffs->addDBRule($_, &buildDBRuleId($type, $id), $newAccess, $diffs->getResourceAttribute($_))} @$resources;
	    }
	    map {$diffs->delDBRule($_, $type, $id, $access)} @$resources;
	}

	# if we get here, we have a match
	$lastMatch = $i;
	$lastDiffs = $diffs;
	$lastApplies = $applies;
    }
    return ($lastMatch, $lastDiffs, $lastApplies);
}

sub standardDescToW3CMacro { # static
    my ($macroName) = @_;
    foreach my $macro (@MACRO_OPTIONS) {
	if ($macroName eq $macro->[$MACRO_RULENAME]) {
	    return $macro->[$MACRO_RULEID];
	}
    }
    return undef;
}

sub standardW3CMacroToDesc { # static
    my ($macroId) = @_;
    foreach my $macro (@MACRO_OPTIONS) {
	if ($macroId == $macro->[$MACRO_RULEID]) {
	    return $macro->[$MACRO_RULEDESC];
	}
    };
    return undef;
}

sub standardW3CMacroToIcon { # static
    my ($p) = @_;
    map {
	if ($p == $_->[$MACRO_RULEID]) {
	    return $_->[$MACRO_RULEICON];
	}
    } @MACRO_OPTIONS;
    return undef;
}

# ----------- AclImport functions ------------- #

#####
# maybeAddUriEntry - check to see if the passed resource should have a uris entry

sub maybeAddUriEntry {
    my ($self, $uri, $acl, $replace) = @_;
#from httpd.conf:
# IndexIgnore is a set of filenames which directory indexing should ignore
# Format: IndexIgnore name1 name2...
#IndexIgnore */.??* *~ *# */HEADER* */README* */RCS */CVS

    return -1 if ($uri =~ m:^.*/\..*$: || $uri =~ m:^.*~$: || $uri =~ m:^.*#$: || 
		  $uri =~ m:^.*/HEADER.*$: || $uri =~ m:^.*/README.*$: || 
		  $uri =~ m:^.*/RCS/$: || $uri =~ m:^.*/CVS/$:);
    return $self->addUriEntry($uri, $acl, $replace);
}

#####
# addUriEntry - add uri entry for arg1

sub addUriEntry {
    my ($self, $uri, $acl, $replace) = @_;
    $acl = $self->getDefaultAcl($uri) if (!defined $acl);
    my (@id, %curAcl);
    if ($self->{DB}->executeQuery(\@id, \%curAcl, 'select id,acl from uris where uri=\''.$uri.'\'') == 1) {
	# replace NULL acls
	$self->{DB}->executeUpdate('update uris set acl='.$acl.' where id='.$id[0]) if ($replace || !defined($curAcl{$id[0]}));
    } else {
	# add a new entry
	$self->{DB}->executeUpdate('insert into uris (uri,acl) values (\''.$uri.'\', '.$acl.')');
	return -1 if ($self->{DB}->executeQuery(\@id, 'select id from uris where uri=\''.$uri.'\'') != 1);
    }
    return $id[0];
}

#####
# getDefaultAcl - get the default acl number for this uri
# 88 - nobody
# 0x07 - all
# 0x05 - team - <Directory ~ "/(team|Team|Plan|Project|Systems|Web|Security/Config|Repository)/">      CERN-group w3cteamgroup
# 0x06 - group - <Directory ~ "/(TandS/Member|Group|ERB|MarkUp/CoordGroup)/">			       cabal
# 0x06 - guide - <Directory ~ "/afs/w3.org/pub/WWW/Guide/">					       cabal
# 0x06 - member - <Directory ~ "/afs/w3.org/pub/WWW/(Member|member)">				       cabal
# 0x26 - partner - <Directory ~ "/afs/w3.org/pub/WWW/W3C-LA/.*Partner/">			       CERN-group w3clagroup
# 0x27 - w3cla - <Directory ~ "/afs/w3.org/pub/WWW/W3C-LA/Core/">				       CERN-group w3clacoregroup
# XXX 8 - 2 & 3 XXX
# 0x09 - other combos

#$AclInterface::NONE = 88;
#$AclInterface::ALL = 1;
#$AclInterface::TEAM = 2;
#$AclInterface::MEMBER = 5;
#$AclInterface::OTHER = 0;

sub getDefaultAcl {
    my $self = shift;
    my $uri = shift;
    my $ret = 0x07;
    if ($uri =~ m:/team/|/Team/|/Plan/|/Project/|/Systems/|/Web/|/Security/Config/|/Repository/:) {
	$ret = 0x05;
    }
    if ($uri =~ m:(/TandS/Member/|/Group/|/ERB/|/MarkUp/CoordGroup/):) {
	if ($ret == 0x05) { $ret = 0x09; } else { $ret = 0x06; }
    }
    if ($uri =~ m:^/Guide/:) {
	if ($ret == 0x05) { $ret = 0x09; } else { $ret = 0x06; }
    }
    if ($uri =~ m:^/(Member|member)/:) {
	if ($ret == 0x05) { $ret = 0x09; } else { $ret = 0x06; }
    }
    if ($uri =~ m:^/W3C-LA/.*Partner/:) {
	if ($ret == 0x05) { $ret = 0x09; } else { $ret = 0x26; }
    }
    if ($uri =~ m:^/W3C-LA/Core/:) {
	if ($ret == 0x05) { $ret = 0x09; } else { $ret = 0x27; }
    }
    return $ret;
}

1;

__END__

=head1 NAME

W3C::Rnodes::W3CWebAcls - 

=head1 SYNOPSIS

  use W3C::Rnodes::W3CWebAcls;

=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
