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
|
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use lib $ENV{GL_LIBDIR};
use Gitolite::Rc;
use Gitolite::Common;
use Gitolite::Conf::Load;
=for args
Usage: gitolite info [-lc] [-ld] [-json] [<repo name pattern>]
List all existing repos you can access, as well as repo name patterns you can
create repos from (if any).
'-lc' lists creators as an additional field at the end.
'-ld' lists description as an additional field at the end.
'-json' produce JSON output instead of normal output
The optional pattern is an unanchored regex that will limit the repos
searched, in both cases. It might speed up things a little if you have more
than a few thousand repos.
=cut
# these are globals
my ( $lc, $ld, $json, $patt ) = args();
my %out; # holds info to be json'd
print_version();
print_patterns(); # repos he can create for himself
print_phy_repos(); # repos already created
if ( $rc{SITE_INFO} ) {
$json
? $out{SITE_INFO} = $rc{SITE_INFO}
: print "\n$rc{SITE_INFO}\n";
}
print JSON::to_json( \%out, { utf8 => 1, pretty => 1 } ) if $json;
# ----------------------------------------------------------------------
sub args {
my ( $lc, $ld, $json, $patt ) = ( '', '', '', '' );
my $help = '';
GetOptions(
'lc' => \$lc,
'ld' => \$ld,
'json' => \$json,
'h' => \$help,
) or usage();
usage() if @ARGV > 1 or $help;
$patt = shift @ARGV || '.';
require JSON if $json;
return ( $lc, $ld, $json, $patt );
}
sub print_version {
chomp( my $hn = `hostname -s 2>/dev/null || hostname` );
my $gv = substr( `git --version`, 12 );
$ENV{GL_USER} or _die "GL_USER not set";
if ($json) {
$out{GL_USER} = $ENV{GL_USER};
$out{USER} = ( $ENV{USER} || "httpd" ) . "\@$hn";
$out{gitolite_version} = version();
chomp( $out{git_version} = $gv ); # this thing has a newline at the end
return;
}
# normal output
print "hello $ENV{GL_USER}, this is " . ( $ENV{USER} || "httpd" ) . "\@$hn running gitolite3 " . version() . " on git $gv\n";
}
sub print_patterns {
my ( $repos, @aa );
my $lm = \&Gitolite::Conf::Load::list_members;
# find repo patterns only, call them with ^C flag included
@$repos = grep { !/$REPONAME_PATT/ } map { /^@/ ? @{ $lm->($_) } : $_ } @{ lister_dispatch('list-repos')->() };
@aa = qw(R W ^C);
listem( $repos, '', '', @aa );
# but squelch the 'lc' and 'ld' flags for these
}
sub print_phy_repos {
my ( $repos, @aa );
# now get the actual repos and get R or W only
_chdir( $rc{GL_REPO_BASE} );
$repos = list_phy_repos(1);
@aa = qw(R W);
listem( $repos, $lc, $ld, @aa );
}
sub listem {
my ( $repos, $lc, $ld, @aa ) = @_;
my $creator = '';
for my $repo (@$repos) {
next unless $repo =~ /$patt/;
my $perm = '';
$creator = creator($repo) if $lc;
my $desc = '';
for my $d ("$ENV{GL_REPO_BASE}/$repo.git/description") {
next unless $ld and -r $d;
$desc = slurp($d);
chomp($desc);
}
for my $aa (@aa) {
my $ret = access( $repo, $ENV{GL_USER}, $aa, 'any' );
$perm .= ( $ret =~ /DENIED/ ? " " : " $aa" );
}
$perm =~ s/\^//;
next unless $perm =~ /\S/;
if ($json) {
$out{repos}{$repo}{creator} = $creator if $lc;
$out{repos}{$repo}{description} = $desc if $ld;
$out{repos}{$repo}{perms} = _hash($perm);
next;
}
print "$perm\t$repo";
print "\t$creator" if $lc;
print "\t$desc" if $ld;
print "\n";
}
}
sub _hash {
my $in = shift;
my %out = map { $_ => 1 } ( $in =~ /(\S)/g );
return \%out;
}
|
