src/commands/access

   1 #!/usr/bin/perl -s
   2 use strict;
   3 use warnings;
   4
   5 use lib $ENV{GL_LIBDIR};
   6 use Gitolite::Rc;
   7 use Gitolite::Common;
   8 use Gitolite::Conf::Load;
   9
  10 our ( $q, $s, $h );    # quiet, show, help
  11
  12 =for usage
  13 Usage:  gitolite access [-q|-s] <repo> <user> <perm> <ref>
  14
  15 Print access rights for arguments given.  The string printed has the word
  16 DENIED in it if access was denied.  With '-q', returns only an exit code
  17 (shell truth, not perl truth -- 0 is success).  For '-s', see below.
  18
  19   - repo: mandatory
  20   - user: mandatory
  21   - perm: defauts to '+'.  Valid values: R, W, +, C, D, M
  22   - ref:  defauts to 'any'.  See notes below
  23
  24 Notes:
  25   - ref: something like 'master', or 'refs/tags/v1.0', or even a VREF if you
  26     know what they look like.
  27
  28     The 'any' ref is special -- it ignores deny rules, thus simulating
  29     gitolite's behaviour during the pre-git access check (see 'deny-rules'
  30     section in rules.html for details).
  31
  32   - batch mode: see src/triggers/post-compile/update-git-daemon-access-list
  33     for a good example that shows how to test several repos in one invocation.
  34     This is orders of magnitude faster than running the command multiple
  35     times; you'll notice if you have more than a hundred or so repos.
  36
  37   - '-s' shows the rules (conf file name, line number, and rule) that were
  38     considered and how they fared.
  39
  40   - you can also test the ability to create wild repos if you set GL_USER to
  41     the username and use ^C as the permission to check for.
  42 =cut
  43
  44 usage() if not @ARGV or $h;
  45
  46 my ( $repo, $user, $aa, $ref ) = @ARGV;
  47 # default access is '+'
  48 $aa  ||= '+';
  49 # default ref is 'any'
  50 $ref ||= 'any';
  51 # fq the ref if needed
  52 $ref =~ s(^)(refs/heads/) if $ref and $ref ne 'any' and $ref !~ m(^(refs|VREF)/);
  53 _die "invalid perm" if not( $aa and $aa =~ /^(R|W|\+|C|D|M|\^C)$/ );
  54 _die "invalid ref name" if not( $ref and $ref =~ $REPONAME_PATT );
  55
  56 my $ret = '';
  57
  58 if ( $repo ne '%' and $user ne '%' ) {
  59     # single repo, single user; no STDIN
  60     $ret = access( $repo, $user, $aa, $ref );
  61
  62     show($ret) if $s;
  63
  64     if ( $ret =~ /DENIED/ ) {
  65         print "$ret\n" unless $q;
  66         exit 1;
  67     }
  68
  69     print "$ret\n" unless $q;
  70     exit 0;
  71 }
  72
  73 $repo = '' if $repo eq '%';
  74 $user = '' if $user eq '%';
  75
  76 _die "'-q' and '-s' meaningless in pipe mode" if $q or $s;
  77 @ARGV = ();
  78 while (<>) {
  79     my @in = split;
  80     my $r  = $repo || shift @in;
  81     my $u  = $user || shift @in;
  82     $ret = access( $r, $u, $aa, $ref );
  83     print "$r\t$u\t$ret\n";
  84 }
  85
  86 sub show {
  87     my $ret = shift;
  88     die "repo already exists; ^C won't work\n" if $ret =~ /DENIED by existence/;
  89
  90     my $in = $rc{RULE_TRACE} or die "this should not happen! $ret";
  91
  92     print STDERR "legend:";
  93     print STDERR "
  94     d => skipped deny rule due to ref unknown or 'any',
  95     r => skipped due to refex not matching,
  96     p => skipped due to perm (W, +, etc) not matching,
  97     D => explicitly denied,
  98     A => explicitly allowed,
  99     F => denied due to fallthru (no rules matched)
 100
 101 ";
 102
 103     my %rule_info = read_ri($in);    # get rule info data for all traced rules
 104                                      # this means conf filename, line number, and content of the line
 105
 106     # the rule-trace info is a set of pairs of a number plus a string.  Only
 107     # the last character in a string is valid (and has meanings shown above).
 108     # At the end there may be a final 'f'
 109     my @in = split ' ', $in;
 110     while (@in) {
 111         $in = shift @in;
 112         if ( $in =~ /^\d+$/ ) {
 113             my $res = shift @in or die "this should not happen either!";
 114             my $m = chop($res);
 115             printf "  %s %20s:%-6s %s\n", $m,
 116                                           $rule_info{$in}{fn},
 117                                           $rule_info{$in}{ln},
 118                                           $rule_info{$in}{cl};
 119         } elsif ( $in eq 'F' ) {
 120             printf "  %s %20s\n", $in, "(fallthru)";
 121         } else {
 122             die "and finally, this also should not happen!";
 123         }
 124     }
 125     print "\n";
 126 }
 127
 128 sub read_ri {
 129     my %rules = map { $_ => 1 } $_[0] =~ /(\d+)/g;
 130     # contains a series of rule numbers, each of which we must search in
 131     # $GL_ADMIN_BASE/.gitolite/conf/rule_info
 132
 133     my %rule_info;
 134     for ( slurp( $ENV{GL_ADMIN_BASE} . "/conf/rule_info" ) ) {
 135         my ( $r, $f, $l ) = split ' ', $_;
 136         next unless $rules{$r};
 137         $rule_info{$r}{fn} = $f;
 138         $rule_info{$r}{ln} = $l;
 139         $rule_info{$r}{cl} = conf_lines( $f, $l );
 140
 141         # a wee bit of optimisation, in case the rule_info file is huge and
 142         # what we want is up near the beginning
 143         delete $rules{$r};
 144         last unless %rules;
 145     }
 146     return %rule_info;
 147 }
 148
 149 {
 150     my %conf_lines;
 151
 152     sub conf_lines {
 153         my ( $file, $line ) = @_;
 154         $line--;
 155
 156         unless ( $conf_lines{$file} ) {
 157             $conf_lines{$file} = [ slurp( $ENV{GL_ADMIN_BASE} . "/conf/$file" ) ];
 158             chomp( @{ $conf_lines{$file} } );
 159         }
 160         return $conf_lines{$file}[$line];
 161     }
 162 }