1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
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];
}
}
|
