#!/usr/bin/perl

# Copyright Massachusetts Institute of technology, 2000.
# Written by Dominique Hazael-Massieux, much inspired from code written by Eric Prud'hommeaux

# Update the idInclusions table to reflect changes to the hierarchy table.
# Reflect these updates to idUpdates for use by replicateIds.

require 5.002;

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

package autoCracler;

use strict;
use W3C::Rnodes::W3CAclTemplateAgent;
use W3C::Util::Properties;
use W3C::Util::Exception;
use W3C::Rnodes::AclDB;
use CGI qw(unescape);

# constants
use vars qw($FREQUENCY $PROP_LOCATION $PROP_NOTIFY_TO 
	    $PROP_NOTIFY_FROM $PROP_NOTIFY_SUBJ $MAIL_NOTIFY_BODY
	    $ID_CHECK_SUM $ID_CLEAR $ID_COMPILE);
$FREQUENCY = 10;
$PROP_LOCATION = '../../../Conf/chacl.prop';
$PROP_NOTIFY_TO = 'notify.mail.to';
$PROP_NOTIFY_FROM = 'notify.mail.from';
$PROP_NOTIFY_SUBJ = 'notify.mail.subjectPrefix';
$MAIL_NOTIFY_BODY = 'blah blah blah';
$ID_COMPILE = 96;
$ID_CLEAR = 97;
$ID_CHECK_SUM = 98;

use vars qw($SOURCE_aclDB $SOURCE_Templates);
$SOURCE_aclDB = 0x10;
$SOURCE_Templates = 0x20;

eval {
    &main(\@ARGV);
}; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) {
    die $ex->toString;
} else {
    die new W3C::Util::PerlException->toString;
}}

sub main {
    my ($argv) = @_;
    my $setter = new autoCracler($argv);

    eval {
	$setter->execute();
    };
    $setter->disconnect;
    if ($@) {
	die $@;
    }
}

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

    $self->{ACL} = undef;		# Connection to the ACL database.
    $self->{AGENT} = 'autoCracler';	# Agent name for notes in idUpdates.
    $self->{NOLOCK} = 0;		# If set, compileAcls won't lock tables.
    $self->{FILEPATH} = undef ;
    $self->{FILES} = () ;
    $self->{VERBOSE} = 0 ;
    $self->{NEWDIR} = undef ;
    $self->parseArgs($argv);
    $self->{PROPERTIES} = new W3C::Util::Properties($PROP_LOCATION);
    $self->makeDatabaseConnection();
    $self->{ACL_DB} = new W3C::Rnodes::AclDB;
    return $self;
}

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

    $self->{ACL} = new W3C::Rnodes::W3CAclTemplateAgent(
                                                        -properties => $self->{PROPERTIES},
                                                        -getFilepathMaps => sub {$self->_getCVSFilepathMaps(@_)},
                                                        -sourceID => $SOURCE_Templates);
}

sub parseArgs {
    my ($self, $argv) = @_;

    for (my $argNo = 0; @$argv; $argNo++) {
	my $arg = shift @$argv;
        if ($arg =~ m/^\-*help$/) {
	    print &usage();
	    exit(0);
	} elsif ($arg =~ m/^\-*verbose$/) {
            $self->{VERBOSE} = 1 ;
	} elsif ($arg =~ m/^\-*newdir$/) {
            $self->{NEWDIR} = 1 ;
        } else {
            if (! $self->{FILEPATH}) { # Directory not yet defined, first real argument
                $_ = $arg ;
                s/^"//; #"
                s/"$//; #"
                s/\\"/"/; 
                $self->{FILEPATH} = $_.'/' ;
            } else {
                $_ = $arg ;
                s/^"//; #"
                s/"$//; #"
                s/\\"/"/; 
                push(@{$self->{FILES}},$_) ;
            }
        }
    }

    if (!$self->{FILEPATH} || (!$self->{NEWDIR} && !$self->{FILES})) {
	    print &usage();
	    exit(0);
    }

}

sub usage { # static
    return <<EOF
Usage: $0 [--verbose] [--newdir] directory [filename]*
    where directory a path to a directory relative to http://www.w3.org/ root, and filename is in http://www.w3.org/directory/. The --newdir option specifies if the directory must be included as being cracled (it is an error to have no filenmaes nor the --newdir option).
EOF
    ;
}

sub execute {
    my ($self) = @_;
    my $Acl = $self->{ACL};

    my @resources ;
    foreach my $filename (@{$self->{FILES}}) {
        my $uri = $self->_mapFromLocalFile($self->{FILEPATH}.$filename) ;
        if ($uri) {
            push(@resources,$uri) ;
            if ($self->{VERBOSE}) {
                warn $uri." added to the resources list\n" ;
            }
        } elsif ($self->{VERBOSE}) {
            warn $filename." could not be matched to a URI\n" ;
        }
    }

    # getting the list of ACLs to be created
    my $count ;
    if ((scalar @resources) > 0 ) {
        $count = $Acl->getAclsFor($self->{ACL_DB},\@resources,'',undef) ;
    } elsif ($self->{VERBOSE}) {
        warn "No resources to be chacled." ;
    }
    if ($count) {
        #Getting the list of ACLs already set in the repository
        $self->{ACL_REPOSITORY} = new W3C::Rnodes::W3CAclAgent(-properties => $self->{PROPERTIES}, -sourceID => $SOURCE_aclDB);
        my $aclDB = new W3C::Rnodes::AclDB;
        my $overlap = $self->{ACL_REPOSITORY}->getAclsFor($aclDB,$self->{ACL_DB}->getResources(),'',undef) ;
        
        #removing them from our local resource list
        if ($overlap) {
            foreach my $resource ($aclDB->getResources()) {
                $self->{ACL_DB}->deleteResource($resource);
                if ($self->{VERBOSE}) {
                    warn $resource." already cracled, will not be changed" ;
                }
            }
        }

        # creating the real ACLs in the repository
        my %resourceBins = $self->{ACL_DB}->getResourceBins;
        foreach my $bin (keys %resourceBins) {
            
            eval {            
                my (@creations,@updates) ;
                $self->{ACL_REPOSITORY}->setAclFor($resourceBins{$bin}[0], $resourceBins{$bin}[1], \@creations, \@updates);
                $self->notify();
            }; if ($@) {
                my $message;
                if (my $ex = &catch('W3C::Util::Exception')) {
                    $message = $ex->toString
                    } else {
                        $message = $@;
                    }
                print STDERR $message ;
            }
        }
    } elsif ($self->{VERBOSE}) {
        warn "No ACLs set\n" ;
    }
}

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

sub notify {
    my ($self) = @_;
    my $to = $self->{PROPERTIES}->getI($PROP_NOTIFY_TO);
    my $from = $self->{PROPERTIES}->getI($PROP_NOTIFY_FROM);
    my $subj = $self->{PROPERTIES}->getI($PROP_NOTIFY_SUBJ);
    my $lastUpdate = $self->{ACL_REPOSITORY}->getMaxResourceUpdate();

    if (defined $to && defined $lastUpdate) {

	my $SENDMAIL = '/usr/lib/sendmail';
	$subj =~ s/\%d\b/$lastUpdate/g;
	my $pid = open(KID_TO_WRITE, "|-");
	$SIG{ALRM} = sub {
	    &throw(new W3C::Util::Exception(-message=>"mail pipe broke"));
	};

	if ($pid) {  # parent
	    print KID_TO_WRITE "To: $to\n";
	    print KID_TO_WRITE "From: $from\n";
	    print KID_TO_WRITE "Subject: $subj\n";
	    print KID_TO_WRITE "\n";
	    print KID_TO_WRITE "$MAIL_NOTIFY_BODY\n";
	    close(KID_TO_WRITE) || warn "kid exited $?";

	} else {     # child
	    if (!exec($SENDMAIL, '-t', "-f$from")) {
		&throw(new W3C::Util::Exception(-message => 
						"can't exec $SENDMAIL: $!"));
	    }
	}
    }
}

sub _getCVSFilepathMaps {
    my ($self) = @_;
    return [['http://www.w3.org/.*', 
	     'http://www.w3.org/CGI/chacl', 
	     '/w3ccvs/WWW', 
	     's|\Ahttp://www.w3.org/|/w3ccvs/WWW/|', 
	     's|\A/w3ccvs/WWW/|http://www.w3.org/|'], 
	    ['http://quake.w3.org/.*', 
	     'http://quake.w3.org/CGI/chacl', 
	     '/w3ccvs/WWW', 
	     's|\Ahttp://quake.w3.org/|/w3ccvs/WWW/|', 
	     's|\A/w3ccvs/WWW/|http://quake.w3.org/|'], 
	    ['http://localhost/.*', 
	     'http://localhost/CGI/chacl', 
	     '/w3ccvs/WWW', 
	     's|\Ahttp://localhost/|/w3ccvs/WWW/|', 
	     's|\A/w3ccvs/WWW/|http://localhost/|']]; # @@@ need to get this from *somewhere*...
}

sub _mapFromLocalFile {
    my ($self) = shift(@_) ;
    $_  = shift(@_) ;
    if (m/^WWW\//) {
        s-^WWW-http://www.w3.org- ;
        return $_ ;
    }
    return undef ;
}