Optionally test filenames of the files changed by the commit.

* gitacl.schema (gitAclTree): New attribute.
* gitaclhook: Document changes.
Accept four or more arguments in test mode.
* lib/GitACL.pm (git_values): New function.
(match_tree): New function.
(match_tuple): Match path pattern, if supplied.
(new): Fix initialization of the debug member.
Get remote IP address from the socket, if no envar
is defined. Default to 127.0.0.1.
* lib/GitACL/File.pm (check_acl): Allow up to 6 fields in
an ACL line.
* lib/GitACL/LDAP.pm: Get path pattern from the gitAclTree
attribute.

1 files changed, 58 insertions, 3 deletions

diff --git a/lib/GitACL.pm b/lib/GitACL.pm
index d3f6b35..f7743d5 100644
--- a/lib/GitACL.pm
+++ b/lib/GitACL.pm
@@ -17,6 +17,7 @@
 package GitACL;
 
 use strict;
+use feature "state";
 use File::Spec;
 use Net::CIDR qw (cidrlookup);
 
@@ -99,6 +100,16 @@ sub get_project_name($) {
     return $1;
 }
 
+sub git_values(@) {
+    my $fd;
+
+    open($fd,'-|','git',@_);
+    local $_;
+    my @ret = map { chomp; $_; } <$fd>;
+    close($fd);
+    return @ret;
+}
+
 sub git_value(@) {
     my $fd;
     
@@ -153,11 +164,43 @@ sub match_ref($$) {
     return $self->{ref} eq $expr;
 }
 
+sub match_tree($$) {
+    my ($self, $expr) = @_;
+    state @tree;
+    state $init;
+    
+    unless (defined($init)) {
+	if (defined($self->{files})) {
+	    @tree = @{$self->{files}};
+	} else {
+	    @tree = git_values("diff-tree",
+			       "--no-commit-id", "--name-only", "-r",
+			       $self->{new});
+	}
+	$init = 1;
+    }
+
+    for (my $i = 0; $i <= $#tree; ) {
+	my $dir = $tree[$i];
+
+	if (($expr =~ /^\^/ and $dir =~ /$expr/)
+	    or ($expr =~ /\/$/
+		and ("$dir/" eq $expr or index($dir, $expr) == 0))
+	    or $dir eq $expr) {
+	    splice(@tree, $i, 1);
+	} else {	    
+	    ++$i;
+	}
+    }
+
+    return $#tree == -1;
+}
+
 sub match_tuple($$) {
     my ($self, $tuple) = @_;
     my @x = @{$tuple};
 
-    return ( \&deny, "malformed line" ) unless $#x >= 2;
+    return ( \&deny, "malformed line: " . join(' ', @x) ) unless $#x >= 2;
     return ( \&deny, "unknown keyword" )
     	unless ($x[0] eq 'allow' || $x[0] eq 'deny');
 
@@ -168,7 +211,9 @@ sub match_tuple($$) {
     return ( 0, "op mismatch" )
     	if ($#x >= 3 && index(uc $x[3], $self->{op}) == -1);
     return ( 0, "ref mismatch" )
-    	if ($#x == 4 && !$self->match_ref($x[4]));
+    	if ($#x >= 4 && !$self->match_ref($x[4]));
+    return ( 0, "tree mismatch" )
+	if ($#x == 5 && !$self->match_tree($x[5]));
     if ($x[0] eq 'allow') {
     	return ( \&allow );
     } else {
@@ -201,7 +246,7 @@ sub new {
     if (defined($args{debug})) {
 	$obj->{debug} = $args{debug};
     } else {
-	$obj->{debug} = git_value('config', '--bool', 'hooks.acl.debug') ||
+	$obj->{debug} = git_value('config', '--int', 'hooks.acl.debug') ||
 	                $ENV{GIT_UPDATE_DEBUG} > 0;
     }
 
@@ -237,6 +282,14 @@ sub new {
 	if (defined($ENV{$ipvar})) {
 	    my @a = split /\S/, $ENV{$ipvar}, 2;
 	    $obj->{ip} = $a[0];
+	} else {
+	    my $sa = getpeername(STDIN);
+	    if ($sa) {
+		my ($port, $addr) = sockaddr_in($sa);
+		$obj->{ip} = inet_ntoa($addr);
+	    } else {
+		$obj->{ip} = "127.0.0.1";
+	    }
 	}
     }
 
@@ -269,6 +322,8 @@ sub new {
 	$obj->deny("invalid op") unless defined($opstr{$args{op}});
 	$obj->{op} = $args{op};
     }
+
+    $obj->{files} = $args{files} if defined($args{files});
     
     return $obj;
 }