VREF code

src/Gitolite/Conf/Load.pm

@@ -6,6 +6,7 @@ package Gitolite::Conf::Load;
 @EXPORT = qw(
   load
   access
+  vrefs
 
   list_groups
   list_users
@@ -139,26 +140,47 @@ sub load_1 {
     }
 }
 
-sub rules {
-    my ( $repo, $user ) = @_;
-    trace( 4, "repo=$repo, user=$user" );
-    my @rules = ();
+{
+    my $lastrepo = '';
+    my $lastuser = '';
+    my @cached = ();
 
-    my @repos = memberships($repo);
-    my @users = memberships($user);
-    trace( 4, "memberships: " . scalar(@repos) . " repos and " . scalar(@users) . " users found" );
+    sub rules {
+        my ( $repo, $user ) = @_;
+        trace( 4, "repo=$repo, user=$user" );
 
-    for my $r (@repos) {
-        for my $u (@users) {
-            push @rules, @{ $repos{$r}{$u} } if exists $repos{$r}{$u};
+        return @cached if ($lastrepo eq $repo and $lastuser eq $user and @cached);
+
+        my @rules = ();
+
+        my @repos = memberships($repo);
+        my @users = memberships($user);
+        trace( 4, "memberships: " . scalar(@repos) . " repos and " . scalar(@users) . " users found" );
+
+        for my $r (@repos) {
+            for my $u (@users) {
+                push @rules, @{ $repos{$r}{$u} } if exists $repos{$r}{$u};
+            }
         }
+
+        @rules = sort { $a->[0] <=> $b->[0] } @rules;
+
+        $lastrepo = $repo;
+        $lastuser = $user;
+        @cached = @rules;
+
+        return @rules;
     }
 
-    # dbg("before sorting rules:", \@rules);
-    @rules = sort { $a->[0] <=> $b->[0] } @rules;
-    # dbg("after sorting rules:", \@rules);
+    sub vrefs {
+        my ( $repo, $user ) = @_;
+        # fill the cache if needed
+        rules($repo, $user) unless ($lastrepo eq $repo and $lastuser eq $user and @cached);
 
-    return @rules;
+        my %seen;
+        my @vrefs = grep { /^VREF\// and not $seen{$_}++ } map { $_->[2] } @cached;
+        return @vrefs;
+    }
 }
 
 sub memberships {

src/Gitolite/Conf/Store.pm

@@ -95,9 +95,9 @@ sub parse_refs {
     # if no ref is given, this PERM applies to all refs
     @refs = qw(refs/.*) unless @refs;
 
-    # fully qualify refs that dont start with "refs/" or "NAME/" or "VREF/";
+    # fully qualify refs that dont start with "refs/" or "VREF/";
     # prefix them with "refs/heads/"
-    @refs = map { m(^(refs|NAME|VREF)/) or s(^)(refs/heads/); $_ } @refs;
+    @refs = map { m(^(refs|VREF)/) or s(^)(refs/heads/); $_ } @refs;
     # XXX what do we do? @refs = map { s(/USER/)(/\$gl_user/); $_ } @refs;
 
     return @refs;

src/Gitolite/Conf/Sugar.pm

@@ -65,7 +65,7 @@ sub sugar {
 
     $lines = option($lines);
     $lines = owner_desc($lines);
-    # $lines = name_vref($lines);
+    $lines = name_vref($lines);
 
     return $lines;
 }
@@ -132,5 +132,21 @@ sub owner_desc {
     return \@ret;
 }
 
+sub name_vref {
+    my $lines = shift;
+    my @ret;
+
+    # <perm> NAME/foo = <user>
+    #   ->  <perm> VREF/NAME/foo = <user>
+
+    for my $line (@$lines) {
+        if ( $line =~ /^(-|R\S+) \S.* = \S.*/ ) {
+            $line =~ s( NAME/)( VREF/NAME/)g;
+        }
+        push @ret, $line;
+    }
+    return \@ret;
+}
+
 1;
 

src/Gitolite/Hooks/Update.pm

@@ -28,9 +28,50 @@ sub update {
     trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref) -> $ret" );
     _die $ret if $ret =~ /DENIED/;
 
+    check_vrefs($ref, $oldsha, $newsha, $oldtree, $newtree, $aa);
+
     exit 0;
 }
 
+sub check_vrefs {
+    my($ref, $oldsha, $newsha, $oldtree, $newtree, $aa) = @_;
+    my $name_seen = 0;
+    for my $vref ( vrefs($ENV{GL_REPO}, $ENV{GL_USER}) ) {
+        trace(1, "vref=$vref");
+        if ($vref =~ m(^VREF/NAME/)) {
+            # this one is special; we process it right here, and only once
+            next if $name_seen++;
+
+            for my $ref ( map { chomp; s(^)(VREF/NAME/); $_; } `git diff --name-only $oldtree $newtree` ) {
+                check_vref($aa, $ref);
+            }
+        } else {
+            my($dummy, $pgm, @args) = split '/', $vref;
+            $pgm = "$ENV{GL_BINDIR}/VREF/$pgm";
+            -x $pgm or die "$vref: helper program missing or unexecutable\n";
+
+            open( my $fh, "-|", $pgm, @_, $vref, @args ) or die "$vref: can't spawn helper program: $!\n";
+            while (<$fh>) {
+                my ( $ref, $deny_message ) = split( ' ', $_, 2 );
+                check_vref($aa, $ref, $deny_message);
+            }
+            close($fh) or die $!
+              ? "Error closing sort pipe: $!"
+              : "$vref: helper program exit status $?";
+        }
+    }
+}
+
+sub check_vref {
+    my ($aa, $ref, $deny_message) = @_;
+
+    my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref );
+    trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" );
+    _die "$ret" . ( $deny_message ? "\n$deny_message" : '' )
+        if $ret =~ /DENIED/ and $ret !~ /by fallthru/;
+    trace( 1, "remember, fallthru is success here!") if $ret =~ /by fallthru/;
+}
+
 {
     my $text = '';