#Copyright Massachusetts Institute of technology, 2000.
#Written by Dominique Hazael-Massieux for the World Wide Web Consortium

# Overload of W3C::Rnodes::CvsPermAgent to set ACLs according to templates defined in the database

use strict;
require Exporter;
#require AutoLoader;

package W3C::Rnodes::W3CAclTemplateAgent;
use W3C::Util::Exception;
use W3C::Rnodes::CvsLogAgent;
use W3C::Rnodes::W3CAclAgent;
use W3C::Database::DBIInterface;
use W3C::Rnodes::ACL qw($ACCESS_FOR_FILESYSTEM_READ
			$ACCESS_FOR_FILESYSTEM_WRITE
			$ACCESS_FOR_FILESYSTEM_EXEC
			&parseURI &addDBRule
			$TYPE_NONE);


use vars qw($REVISION $VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
$REVISION = '$Id: W3CAclTemplateAgent.pm,v 1.7 2005/03/17 05:56:53 eric Exp $ ';
@ISA = qw(W3C::Rnodes::CvsLogAgent Exporter); # AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.10;
$DSLI = 'adpO';


# @parms - constructor parameters:
#   -properties - Properties object or name of props file
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    my $props = $self->{-properties};
    bless ($self, $class);
    if (!ref $props) {
	$props = new W3C::Util::Properties($props);
    }
    $self->{DB} = new W3C::Database::DBIInterface($props,-ignoreDuplicateKeys);

    $props->defaultToI('database', 'w3c');
    $self->{PROPERTIES} = $props;
    $self->{DATABASE} = $props->getI('database');
    $self->{URI_MAP} = $props->getI('map');
    return $self;
}


#almost completely transplanted from UnixPermAgent... @@@ Needs to find a better way to re-use code
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 %directories ;

    foreach my $resource (@resources) {
	# don't cracl anything that came from another source (like the database)
	#next if ($aclDB->getResourceAttribute($resource, 'source'));
	# look up rules for this resource
	my ($protocol, $host, $portStr, $path) = &parseURI($resource);
	&throw(new W3C::Util::MalformedUriException(-uri => $resource)) if (!defined $protocol);
	my @aliases = $self->{-properties}->getI('canonicalHost');
	push (@aliases, $self->{-properties}->getI('alias'));
	my $matchedAlias = undef;
	foreach my $checkAlias (@aliases) {
	    (($matchedAlias = $checkAlias) && last) if ($checkAlias =~ m/\A ~ \s* (.*) \Z/x && $host =~ m/$1/);
	    (($matchedAlias = $checkAlias) && last) if ($host =~ m/$checkAlias/);
	}
	# find the best mapping for this resource
	my ($bestRule, $mapped) = $self->_mapURI($resource);
	if (!defined $bestRule) {
	    &throw(new W3C::Rnodes::UnixPermAgent::NoMapForResourceException(-host => $host, -uri => $resource));
	}

	# redirect if that rule is for another host
	if (!$matchedAlias) {
	    &throw(new W3C::Rnodes::UnixPermAgent::NeedRedirectException(-target => $bestRule->[1], -uri => $resource));
	}

	if ($wildcard && $resource =~ m/\Q$wildcard\E/) {
	    $mapped = $self->_mapToLocalFile($mapped, 0);
	    $self->_matchWildcard($aclDB, $wildcard, $recursive, \$count, $bestRule, $mapped);
	} else {

	    # simply that the found object if it hasn't got a wildcard
	    my $isDir = -d $mapped;
	    if ($isDir) {
		if ($mapped !~ m/\/\Z/) {
		    $mapped .= '/';
		    $resource .= '/';
		}
		#next if ($aclDB->getResourceAttribute($resource, 'source'));
	    }
	    $mapped = $self->_mapToLocalFile($mapped, $isDir);
            
            if (stat($mapped)) {
                #the directory of the resource relative to the root of the web server
                my $dir = ($path =~ m-.*/-g)[0] ;
                push(@{$directories{$host}{$dir}},$resource) ;
            }
        }
    }


    #for each actual directories, create the list of subdirectories
    foreach my $host (keys(%directories)) {
        foreach my $dir (keys(%{$directories{$host}})) {
            my @subdirectories ;
            my @list=split('(?<=/) *',$dir) ;
            while (my $subdir=pop(@list)) {
                push(@subdirectories, join('',@list).$subdir) ;
            }
            
            # Select the longest directory in the templates db with its acl, matching
            my $query = "select acl,dir,LENGTH(dir) as len from uriTemplates where dir in ('" . join("','",@subdirectories) . "') and host='".$host."' order by len desc LIMIT 1;" ;
            
            my $rows = [];
            $self->{DB}->executeWideQuery($rows, $query);
            
            #Is there any ACLs to be set? If yes, we have the acl and the directory in @$rows[0] and @$rows[1]
            if (scalar @$rows > 2) {
                my $acl = @$rows[0] ;
                my $templateDir = @$rows[1];
                
                #let's create the list of possible new directories with no template ACL
                my @tobeTemplated  ;
                map {push(@tobeTemplated,$_) if ($_ gt $templateDir); } @subdirectories ;

                if ($#tobeTemplated>0) {
                    $query= "insert into uriTemplates (host,dir,acl) values ";
                    $query .= join(',',map {"('www.w3.org','$_',$acl)"} @tobeTemplated) ;
                    my $res ;
                    $self->{DB}->executeQuery($res, $query);
            }
                
                #Any resource under $templateDir has $acl as an ACL
                my $toBeACLd = \@{$directories{$host}{$dir}} ;
                foreach my $resource (@$toBeACLd) {
                    $count += $self->addDBRuleFor($aclDB, $resource, $acl, {'source'=> $self->{-sourceID}});
                }
                
            }
        }
    }
    return $count ;
}


# conversion acl id<-> acl rule
sub addDBRuleFor {
  &W3C::Rnodes::W3CAclAgent::addDBRuleFor(@_) ;
}

# need by addDBRuleFor
sub getNameAndDescrip {
    &W3C::Rnodes::W3CAclAgent::getNameAndDescrip(@_) ;
}
1;

__END__

=head1 NAME

W3C::Rnodes::W3CAclTemplateAgent - ACLImporter for W3C::Rnodes

=head1 SYNOPSIS

    use W3C::Rnodes::W3CAclTemplateAgent;
    my $templateAgent = new W3C::Rnodes::W3CAclTemplateAgent(-properties => $self->{PROPERTIES}, 
						 -sourceID => $SOURCE_template, 
						 -getFilepathMaps => sub {
						     $self->_getCVSFilepathMaps(@_)});
    $self->{ACL_IMPORTERS} = [$templateAgent];

=head1 DESCRIPTION

W3C::Rnodes::W3CAclTemplateAgent is an ACLImporter for reading ACLs from template acls in the database

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

=head1 FUTURE PLANS


=head1 AUTHOR

Dominique Hazael-Massieux <dom@w3.org>

=head1 SEE ALSO

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

=cut
