1 files changed, 173 insertions, 0 deletions
diff --git a/src/commands/access b/src/commands/access
new file mode 100755
index 0000000..7d4a5b9
--- /dev/null
+++ b/src/commands/access
@@ -0,0 +1,173 @@
+#!/usr/bin/perl -s
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+our ( $q, $s, $h );    # quiet, show, help
+
+=for usage
+Usage:  gitolite access [-q|-s] <repo> <user> <perm> <ref>
+
+Print access rights for arguments given.  The string printed has the word
+DENIED in it if access was denied.  With '-q', returns only an exit code
+(shell truth, not perl truth -- 0 is success).  For '-s', see below.
+
+  - repo: mandatory
+  - user: mandatory
+  - perm: defauts to '+'.  Valid values: R, W, +, C, D, M
+  - ref:  defauts to 'any'.  See notes below
+
+Notes:
+  - ref: something like 'master', or 'refs/tags/v1.0', or even a VREF if you
+    know what they look like.
+
+    The 'any' ref is special -- it ignores deny rules, thus simulating
+    gitolite's behaviour during the pre-git access check (see 'deny-rules'
+    section in rules.html for details).
+
+  - batch mode: see src/triggers/post-compile/update-git-daemon-access-list
+    for a good example that shows how to test several repos in one invocation.
+    This is orders of magnitude faster than running the command multiple
+    times; you'll notice if you have more than a hundred or so repos.
+
+  - '-s' shows the rules (conf file name, line number, and rule) that were
+    considered and how they fared.
+
+  - you can also test the ability to create wild repos if you set GL_USER to
+    the username and use ^C as the permission to check for.
+=cut
+
+usage() if not @ARGV >= 2 or $h;
+
+my ( $repo, $user, $aa, $ref ) = @ARGV;
+# default access is '+'
+$aa  ||= '+';
+# default ref is 'any'
+$ref ||= 'any';
+# fq the ref if needed
+$ref =~ s(^)(refs/heads/) if $ref and $ref ne 'any' and $ref !~ m(^(refs|VREF)/);
+_die "invalid perm" if not( $aa and $aa =~ /^(R|W|\+|C|D|M|\^C)$/ );
+_die "invalid ref name" if not( $ref and $ref =~ $REF_OR_FILENAME_PATT );
+
+my $ret = '';
+
+if ( $repo ne '%' and $user ne '%' ) {
+    # single repo, single user; no STDIN
+    $ret = access( $repo, $user, adjust_aa($repo, $aa), $ref );
+
+    show($ret) if $s;
+
+    # adjust for fallthru in VREFs
+    $ret =~ s/DENIED by fallthru/allowed by fallthru/ if $ref =~ m(^VREF/);
+
+    if ( $ret =~ /DENIED/ ) {
+        print "$ret\n" unless $q;
+        exit 1;
+    }
+
+    print "$ret\n" unless $q;
+    exit 0;
+}
+
+$repo = '' if $repo eq '%';
+$user = '' if $user eq '%';
+
+_die "'-q' and '-s' meaningless in pipe mode" if $q or $s;
+@ARGV = ();
+while (<>) {
+    my @in = split;
+    my $r  = $repo || shift @in;
+    my $u  = $user || shift @in;
+    $ret = access( $r, $u, adjust_aa($r, $aa), $ref );
+    print "$r\t$u\t$ret\n";
+}
+
+sub adjust_aa {
+    my ($repo, $aa) = @_;
+    $aa = 'W' if $aa eq 'C' and not option($repo, 'CREATE_IS_C');
+    $aa = '+' if $aa eq 'D' and not option($repo, 'DELETE_IS_D');
+    $aa = 'W' if $aa eq 'M' and not option($repo, 'MERGE_CHECK');
+    return $aa;
+}
+
+sub show {
+    my $ret = shift;
+    die "repo already exists; ^C won't work\n" if $ret =~ /DENIED by existence/;
+
+    my $in = $rc{RULE_TRACE} or die "this should not happen! $ret";
+
+    print STDERR "legend:";
+    print STDERR "
+    d => skipped deny rule due to ref unknown or 'any',
+    r => skipped due to refex not matching,
+    p => skipped due to perm (W, +, etc) not matching,
+    D => explicitly denied,
+    A => explicitly allowed,
+    F => fallthru; access denied for normal refs, allowed for VREFs
+
+";
+
+    my %rule_info = read_ri($in);    # get rule info data for all traced rules
+                                     # this means conf filename, line number, and content of the line
+
+    # the rule-trace info is a set of pairs of a number plus a string.  Only
+    # the last character in a string is valid (and has meanings shown above).
+    # At the end there may be a final 'f'
+    my @in = split ' ', $in;
+    while (@in) {
+        $in = shift @in;
+        if ( $in =~ /^\d+$/ ) {
+            my $res = shift @in or die "this should not happen either!";
+            my $m = chop($res);
+            printf "  %s %20s:%-6s %s\n", $m,
+                                          $rule_info{$in}{fn},
+                                          $rule_info{$in}{ln},
+                                          $rule_info{$in}{cl};
+        } elsif ( $in eq 'F' ) {
+            printf "  %s %20s\n", $in, "(fallthru)";
+        } else {
+            die "and finally, this also should not happen!";
+        }
+    }
+    print "\n";
+}
+
+sub read_ri {
+    my %rules = map { $_ => 1 } $_[0] =~ /(\d+)/g;
+    # contains a series of rule numbers, each of which we must search in
+    # $GL_ADMIN_BASE/.gitolite/conf/rule_info
+
+    my %rule_info;
+    for ( slurp( $ENV{GL_ADMIN_BASE} . "/conf/rule_info" ) ) {
+        my ( $r, $f, $l ) = split ' ', $_;
+        next unless $rules{$r};
+        $rule_info{$r}{fn} = $f;
+        $rule_info{$r}{ln} = $l;
+        $rule_info{$r}{cl} = conf_lines( $f, $l );
+
+        # a wee bit of optimisation, in case the rule_info file is huge and
+        # what we want is up near the beginning
+        delete $rules{$r};
+        last unless %rules;
+    }
+    return %rule_info;
+}
+
+{
+    my %conf_lines;
+
+    sub conf_lines {
+        my ( $file, $line ) = @_;
+        $line--;
+
+        unless ( $conf_lines{$file} ) {
+            $conf_lines{$file} = [ slurp( $ENV{GL_ADMIN_BASE} . "/conf/$file" ) ];
+            chomp( @{ $conf_lines{$file} } );
+        }
+        return $conf_lines{$file}[$line];
+    }
+}