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.

5 files changed, 93 insertions, 12 deletions

diff --git a/gitacl.schema b/gitacl.schema
index d8083e5..a9098d4 100644
--- a/gitacl.schema
+++ b/gitacl.schema
@@ -41,9 +41,16 @@ attributetype ( 1.3.6.1.4.1.9163.2.3.1.5 NAME 'gitAclUser'
         SUBSTR caseExactSubstringsMatch
         SYNTAX 1.3.6.1.4.1.1466.115.121.1.15{256} )
 
+attributetype ( 1.3.6.1.4.1.9163.2.3.1.6 NAME 'gitAclTree'
+        DESC 'Git subtree'
+        EQUALITY caseExactMatch
+        SUBSTR caseExactSubstringsMatch
+        SYNTAX 1.3.6.1.4.1.1466.115.121.1.15{256} )
+        
 objectclass ( 1.3.6.1.4.1.9163.2.3.2.0 NAME 'gitACL'
         DESC 'Git Access Control List Entry'
         SUP top STRUCTURAL
         MUST ( cn $ gitAclProject $ gitAclVerb )
-        MAY ( gitAclUser $ gitAclOp $ gitAclRef $ gitAclOrder $ description ) )
+        MAY ( gitAclUser $ gitAclOp $ gitAclRef $ gitAclOrder $
+              gitAclTree $ description ) )
 
diff --git a/gitaclhook b/gitaclhook
index 0addbf5..756ebe5 100755
--- a/gitaclhook
+++ b/gitaclhook
@@ -19,7 +19,7 @@ use GitACL;
 use Pod::Man;
 use Pod::Usage;
 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
-    
+
 =head1 NAME
 
 gitaclhook - control access to git repositories
@@ -28,7 +28,7 @@ gitaclhook - control access to git repositories
 
 B<gitaclhook> I<refname> I<old-sha1> I<new-sha1>
 
-B<gitacthook> [B<--debug>] B<--test> I<REPO> I<USER> I<OP> I<REF>
+B<gitacthook> [B<--debug>] B<--test> I<REPO> I<USER> I<OP> I<REF> [I<FILE>...]
     
 B<gitaclhook --help>     
 
@@ -65,7 +65,7 @@ Non-empty lines introduce ACL rules.  The syntax is:
 
 =over 4
     
-I<VERB> I<PROJECT> I<USER> [I<OP> I<REF>]
+I<VERB> I<PROJECT> I<USER> [I<OP> I<REF> [I<PATH>]]
 
 =back
 
@@ -142,6 +142,12 @@ being its part).  If it ends with a B</>, it is treated as a prefix match,
 so, e.g., B<heads/baz/> matches B<refs/heads/baz> and anything below.
 Otherwise, it must match exactly the affected ref.
 
+=item I<PATH>
+
+Pathname pattern.  If present, the names of all files affected by the commit
+must match it in order for the rule to apply.  Matching algorithm is the same
+as for I<REF>.    
+    
 =back
 
 =head1 RULE MATCHING
@@ -149,7 +155,11 @@ Otherwise, it must match exactly the affected ref.
 The rule applies only if its I<PROJECT> and I<USER> parts match the project
 which is being updated and the user who requests the update, its I<OP>
 contains the opcode of the requested operation and I<REF> matches the affected
-ref.  Missing I<REF> and/or I<OP> are treated as a match.
+ref.  If I<PATH> is present each file changed by the commit is compared with
+it and removed from the list if it matches.  The rule applies only if the
+list of files becomes empty.
+    
+Missing I<REF>, I<OP> and I<PATH> are treated as a match.
 
 If no rule applies, the operation is denied.  This can be changed by setting
 B<hooks.acl.default = allow> in Git configuration file.
@@ -203,6 +213,10 @@ The list of operation codes.
 =item B<gitAclRef>        [optional]
 
 Git ref.
+
+=item B<gitAclPath>       [optional]
+
+Pathname pattern.
     
 =item B<gitAclOrder>      [optional]
 
@@ -287,11 +301,13 @@ lists from the command line.  The syntax is:
 =over 4
 
 B<gitacthook> [B<--debug>] [B<-d>] B<--test> I<REPO> I<USER> I<OP> I<REF>
-
+ [I<FILE>...]
+    
 =back
 
 I<REPO> is a pathname of the repository to test, I<USER> is the username,
-I<OP> is the operation code and I<REF> is the reference.
+I<OP> is the operation code and I<REF> is the reference.  Optional I<FILE>
+arguments supply names of the files changed by the commit.    
 
 Optional B<--debug> (B<-d>) options increment the debugging level.
 
@@ -358,11 +374,12 @@ unless ($ENV{GIT_DIR}) {
                "test|t" => \$test)
         or exit (3);
     if ($test) {
-        abend("--test requires four arguments") unless ($#ARGV == 3);
+        abend("--test requires four or more arguments") unless ($#ARGV >= 3);
         $args{git_dir} = $ENV{GIT_DIR} = $ARGV[0];
         $args{user} = $ARGV[1];
         $args{op} = $ARGV[2];
         $args{ref} = $ARGV[3];
+        $args{files} = [@ARGV[4..$#ARGV]] if ($#ARGV > 3);
         $args{old} = '0000000000000000000000000000000000000000';
         $args{new} = '0000000000000000000000000000000000000001';
         $args{debug} = $debug;
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') {