gitolite/Gitolite/Conf/Load.pm

306 lines
6.9 KiB
Perl
Raw Normal View History

package Gitolite::Conf::Load;
# load conf data from stored files
# ----------------------------------------------------------------------
@EXPORT = qw(
load
access
2012-03-08 07:43:50 +01:00
list_groups
list_users
list_repos
2012-03-08 12:30:27 +01:00
list_memberships
2012-03-08 13:29:44 +01:00
list_members
);
use Exporter 'import';
use lib $ENV{GL_BINDIR};
use Gitolite::Common;
use Gitolite::Rc;
use strict;
use warnings;
# ----------------------------------------------------------------------
my $subconf = 'master';
# our variables, because they get loaded by a 'do'
our $data_version = '';
our %repos;
our %one_repo;
our %groups;
our %configs;
our %one_config;
our %split_conf;
# helps maintain the "cache" in both "load_common" and "load_1"
my $last_repo = '';
# ----------------------------------------------------------------------
{
my $loaded_repo = '';
sub load {
my $repo = shift or _die "load() needs a reponame";
trace( 4, "$repo" );
if ( $repo ne $loaded_repo ) {
trace( 3, "loading $repo..." );
load_common();
load_1($repo);
$loaded_repo = $repo;
}
}
}
sub access {
my ( $repo, $user, $aa, $ref ) = @_;
trace( 3, "repo=$repo, user=$user, aa=$aa, ref=$ref" );
load($repo);
my @rules = rules( $repo, $user );
trace( 3, scalar(@rules) . " rules found" );
for my $r (@rules) {
my $perm = $r->[1];
my $refex = $r->[2];
trace( 4, "perm=$perm, refex=$refex" );
# skip 'deny' rules if the ref is not (yet) known
next if $perm eq '-' and $ref eq 'unknown';
# rule matches if ref matches or ref is unknown (see gitolite-shell)
next unless $ref =~ /^$refex/ or $ref eq 'unknown';
trace( 3, "DENIED by $refex" ) if $perm eq '-';
return "DENIED: $aa access to $repo by $user (rule: $refex)" if $perm eq '-';
# $perm can be RW\+?(C|D|CD|DC)?M?. $aa can be W, +, C or D, or
# any of these followed by "M".
( my $aaq = $aa ) =~ s/\+/\\+/;
$aaq =~ s/M/.*M/;
# as far as *this* ref is concerned we're ok
return $refex if ( $perm =~ /$aaq/ );
}
trace( 3, "DENIED by fallthru" );
return "DENIED: $aa access to $repo by $user (fallthru)";
}
# ----------------------------------------------------------------------
sub load_common {
_chdir( $rc{GL_ADMIN_BASE} );
# we take an unusual approach to caching this function!
# (requires that first call to load_common is before first call to load_1)
if ( $last_repo and $split_conf{$last_repo} ) {
delete $repos{$last_repo};
delete $configs{$last_repo};
return;
}
trace(4);
my $cc = "conf/gitolite.conf-compiled.pm";
_die "parse $cc failed: " . ( $! or $@ ) unless do $cc;
if ( data_version_mismatch() ) {
system("gitolite setup");
_die "parse $cc failed: " . ( $! or $@ ) unless do $cc;
_die "data version update failed; this is serious" if data_version_mismatch();
}
}
sub load_1 {
my $repo = shift;
trace( 4, $repo );
_chdir( $rc{GL_REPO_BASE} );
if ( $repo eq $last_repo ) {
$repos{$repo} = $one_repo{$repo};
$configs{$repo} = $one_config{$repo} if $one_config{$repo};
return;
}
if ( -f "$repo.git/gl-conf" ) {
_die "split conf not set, gl-conf present for $repo" if not $split_conf{$repo};
my $cc = "$repo.git/gl-conf";
_die "parse $cc failed: " . ( $! or $@ ) unless do $cc;
$last_repo = $repo;
$repos{$repo} = $one_repo{$repo};
$configs{$repo} = $one_config{$repo} if $one_config{$repo};
} else {
_die "split conf set, gl-conf not present for $repo" if $split_conf{$repo};
}
}
sub rules {
my ( $repo, $user ) = @_;
trace( 4, "repo=$repo, user=$user" );
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};
}
}
# dbg("before sorting rules:", \@rules);
@rules = sort { $a->[0] <=> $b->[0] } @rules;
# dbg("after sorting rules:", \@rules);
return @rules;
}
sub memberships {
my $item = shift;
my @ret = ( $item, '@all' );
push @ret, @{ $groups{$item} } if $groups{$item};
return @ret;
}
sub data_version_mismatch {
return $data_version ne glrc('current-data-version');
}
2012-03-08 07:43:50 +01:00
# ----------------------------------------------------------------------
# api functions
# ----------------------------------------------------------------------
# list all groups
sub list_groups {
die "
Usage: gitolite list-groups
- lists all group names in conf
- no options, no flags
" if @ARGV;
2012-03-08 07:43:50 +01:00
load_common();
my @g = ();
while ( my ( $k, $v ) = each(%groups) ) {
push @g, @{$v};
2012-03-08 07:43:50 +01:00
}
return ( sort_u( \@g ) );
2012-03-08 07:43:50 +01:00
}
sub list_users {
my $count = 0;
my $total = 0;
die "
Usage: gitolite list-users
- lists all users/user groups in conf
- no options, no flags
- WARNING: may be slow if you have thousands of repos
" if @ARGV;
load_common();
my @u = map { keys %{$_} } values %repos;
$total = scalar( keys %split_conf );
warn "WARNING: you have $total repos to check; this could take some time!\n" if $total > 100;
for my $one ( keys %split_conf ) {
load_1($one);
$count++; print STDERR "$count / $total\r" if not( $count % 100 ) and timer(5);
push @u, map { keys %{$_} } values %one_repo;
}
print STDERR "\n";
return ( sort_u( \@u ) );
}
sub list_repos {
die "
Usage: gitolite list-repos
- lists all repos/repo groups in conf
- no options, no flags
" if @ARGV;
load_common();
my @r = keys %repos;
push @r, keys %split_conf;
return ( sort_u( \@r ) );
}
2012-03-08 12:30:27 +01:00
sub list_memberships {
die "
Usage: gitolite list-memberships <name>
- list all groups a name is a member of
- takes one user/repo name
" if @ARGV and $ARGV[0] eq '-h' or not @ARGV and not @_;
my $name = ( @_ ? shift @_ : shift @ARGV );
load_common();
my @m = memberships($name);
return ( sort_u( \@m ) );
2012-03-08 12:30:27 +01:00
}
2012-03-08 13:29:44 +01:00
sub list_members {
die "
Usage: gitolite list-members <group name>
- list all members of a group
- takes one group name
" if @ARGV and $ARGV[0] eq '-h' or not @ARGV and not @_;
my $name = ( @_ ? shift @_ : shift @ARGV );
load_common();
my @m = ();
while ( my ( $k, $v ) = each(%groups) ) {
for my $g ( @{$v} ) {
2012-03-08 13:29:44 +01:00
push @m, $k if $g eq $name;
}
}
return ( sort_u( \@m ) );
2012-03-08 13:29:44 +01:00
}
# ----------------------------------------------------------------------
{
my $start_time = 0;
sub timer {
unless ($start_time) {
$start_time = time();
return 0;
}
my $elapsed = shift;
return 0 if time() - $start_time < $elapsed;
$start_time = time();
return 1;
}
}
1;