diff options
Diffstat (limited to 'src/lib/Gitolite/Conf/Load.pm')
-rw-r--r-- | src/lib/Gitolite/Conf/Load.pm | 704 |
1 files changed, 704 insertions, 0 deletions
diff --git a/src/lib/Gitolite/Conf/Load.pm b/src/lib/Gitolite/Conf/Load.pm new file mode 100644 index 0000000..7dea259 --- /dev/null +++ b/src/lib/Gitolite/Conf/Load.pm @@ -0,0 +1,704 @@ +package Gitolite::Conf::Load; + +# load conf data from stored files +# ---------------------------------------------------------------------- + +@EXPORT = qw( + load + + access + git_config + env_options + + option + repo_missing + creator + + vrefs + lister_dispatch +); + +use Exporter 'import'; +use Cwd; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +# our variables, because they get loaded by a 'do' +our $data_version = ''; +our %repos; +our %one_repo; +our %groups; +our %patterns; +our %configs; +our %one_config; +our %split_conf; + +my $subconf = 'master'; + +my %listers = ( + 'list-groups' => \&list_groups, + 'list-users' => \&list_users, + 'list-repos' => \&list_repos, + 'list-memberships' => \&list_memberships, + 'list-members' => \&list_members, +); + +# 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( 3, "$repo" ); + if ( $repo ne $loaded_repo ) { + load_common(); + load_1($repo); + $loaded_repo = $repo; + } + } +} + +sub access { + my ( $repo, $user, $aa, $ref ) = @_; + trace( 2, $repo, $user, $aa, $ref ); + _die "invalid user '$user'" if not( $user and $user =~ $USERNAME_PATT ); + sanity($repo); + return "$aa any $repo $user DENIED by fallthru" unless update_hook_present($repo); + + my @rules; + my $deny_rules; + + load($repo); + @rules = rules( $repo, $user ); + $deny_rules = option( $repo, 'deny-rules' ); + + # sanity check the only piece the user can control + _die "invalid characters in ref or filename: '$ref'\n" unless $ref =~ m(^VREF/NAME/) or $ref =~ $REF_OR_FILENAME_PATT; + # apparently we can't always force sanity; at least what we *return* + # should be sane/safe. This pattern is based on REF_OR_FILENAME_PATT. + ( my $safe_ref = $ref ) =~ s([^-0-9a-zA-Z._\@/+ :,])(.)g; + trace( 3, "safe_ref", $safe_ref ) if $ref ne $safe_ref; + + # when a real repo doesn't exist, ^C is a pre-requisite for any other + # check to give valid results. + if ( $aa ne '^C' and $repo !~ /^\@/ and $repo =~ $REPONAME_PATT and repo_missing($repo) ) { + my $iret = access( $repo, $user, '^C', $ref ); + $iret =~ s/\^C/$aa/; + return $iret if $iret =~ /DENIED/; + } + # similarly, ^C must be denied if the repo exists + if ( $aa eq '^C' and not repo_missing($repo) ) { + trace( 2, "DENIED by existence" ); + return "$aa $safe_ref $repo $user DENIED by existence"; + } + + trace( 3, scalar(@rules) . " rules found" ); + + $rc{RULE_TRACE} = ''; + for my $r (@rules) { + $rc{RULE_TRACE} .= " " . $r->[0] . " "; + + my $perm = $r->[1]; + my $refex = $r->[2]; $refex =~ s(/USER/)(/$user/); + trace( 3, "perm=$perm, refex=$refex" ); + + $rc{RULE_TRACE} .= "d"; + # skip 'deny' rules if the ref is not (yet) known + next if $perm eq '-' and $ref eq 'any' and not $deny_rules; + + $rc{RULE_TRACE} .= "r"; + # rule matches if ref matches or ref is any (see gitolite-shell) + next unless $ref =~ /^$refex/ or $ref eq 'any'; + + $rc{RULE_TRACE} .= "D"; + trace( 2, "DENIED by $refex" ) if $perm eq '-'; + return "$aa $safe_ref $repo $user DENIED by $refex" if $perm eq '-'; + + # For repo creation, perm will be C and aa will be "^C". For branch + # access, $perm can be RW\+?(C|D|CD|DC)?M?, and $aa can be W, +, C or + # D, or any of these followed by "M". + + # We need to turn $aa into a regex that can match a suitable $perm. + # This is trivially true for "^C", "W" and "D", but the others (+, C, + # M) need some tweaking. + + # first, quote the '+': + ( my $aaq = $aa ) =~ s/\+/\\+/; + # if aa is just "C", the user is trying to create a *branch* (not a + # *repo*), so let's make the pattern clearer to reflect that. + $aaq = "RW.*C" if $aaq eq "C"; + # if the aa is, say "WM", make this "W.*M" because the perm could be + # 'RW+M', 'RW+CDM' etc, and they are all valid: + $aaq =~ s/M/.*M/; + + $rc{RULE_TRACE} .= "A"; + + # as far as *this* ref is concerned we're ok + return $refex if ( $perm =~ /$aaq/ ); + + $rc{RULE_TRACE} .= "p"; + } + $rc{RULE_TRACE} .= " F"; + + trace( 2, "DENIED by fallthru" ); + return "$aa $safe_ref $repo $user DENIED by fallthru"; +} + +# cache control +if ($rc{CACHE}) { + require Gitolite::Cache; + Gitolite::Cache::cache_wrap('Gitolite::Conf::Load::access'); +} + +sub git_config { + my ( $repo, $key, $empty_values_OK ) = @_; + $key ||= '.'; + + if ( repo_missing($repo) ) { + load_common(); + } else { + load($repo); + } + + # read comments bottom up + my %ret = + # and take the second and third elements to make up your new hash + map { $_->[1] => $_->[2] } + # keep only the ones where the second element matches your key + grep { $_->[1] =~ qr($key) } + # sort this list of listrefs by the first element in each list ref'd to + sort { $a->[0] <=> $b->[0] } + # dereference it (into a list of listrefs) + map { @$_ } + # take the value of that entry + map { $configs{$_} } + # if it has an entry in %configs + grep { $configs{$_} } + # for each "repo" that represents us + memberships( 'repo', $repo ); + + # %configs looks like this (for each 'foo' that is in memberships()) + # 'foo' => [ [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] ], + # the first map gets you the value + # [ [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] ], + # the deref gets you + # [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] + # the sort rearranges it (in this case it's already sorted but anyway...) + # the grep gets you this, assuming the key is foo.bar (and "." is regex ".') + # [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ] + # and the final map does this: + # 'foo.bar'=>'repo' , 'foodbar'=>'repoD' + + # now some of these will have an empty key; we need to delete them unless + # we're told empty values are OK + unless ($empty_values_OK) { + my ( $k, $v ); + while ( ( $k, $v ) = each %ret ) { + delete $ret{$k} if not $v; + } + } + + my ( $k, $v ); + my $creator = creator($repo); + while ( ( $k, $v ) = each %ret ) { + $v =~ s/%GL_REPO/$repo/g; + $v =~ s/%GL_CREATOR/$creator/g if $creator; + $ret{$k} = $v; + } + + map { trace( 3, "$_", "$ret{$_}" ) } ( sort keys %ret ) if $ENV{D}; + return \%ret; +} + +sub env_options { + return unless -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf-compiled.pm"; + # prevent catch-22 during initial install + + my $cwd = getcwd(); + + my $repo = shift; + map { delete $ENV{$_} } grep { /^GL_OPTION_/ } keys %ENV; + my $h = git_config( $repo, '^gitolite-options.ENV\.' ); + while ( my ( $k, $v ) = each %$h ) { + next unless $k =~ /^gitolite-options.ENV\.(\w+)$/; + $ENV{ "GL_OPTION_" . $1 } = $v; + } + + chdir($cwd); +} + +sub option { + my ( $repo, $option ) = @_; + $option = "gitolite-options.$option"; + my $ret = git_config( $repo, "^\Q$option\E\$" ); + return '' unless %$ret; + return $ret->{$option}; +} + +sub sanity { + my ($repo, $patt) = @_; + $patt ||= $REPOPATT_PATT; + + _die "invalid repo '$repo'" if not( $repo and $repo =~ $patt ); + _die "'$repo' ends with a '/'" if $repo =~ m(/$); + _die "'$repo' contains '..'" if $repo =~ $REPONAME_PATT and $repo =~ m(\.\.); + _die "'$repo' contains '.git/'" if $repo =~ $REPONAME_PATT and $repo =~ m(\.git/); + _die "'$repo' ends with '.git'" if $repo =~ m(\.git$); +} + +sub repo_missing { + my $repo = shift; + sanity($repo); + + return not -d "$rc{GL_REPO_BASE}/$repo.git"; +} + +# ---------------------------------------------------------------------- + +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; + } + + 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; + return if $repo =~ /^\@/; + trace( 3, $repo ); + + if ( repo_missing($repo) ) { + trace( 1, "repo '$repo' missing" ) if $repo =~ $REPONAME_PATT; + return; + } + _chdir("$rc{GL_REPO_BASE}/$repo.git"); + + if ( $repo eq $last_repo ) { + $repos{$repo} = $one_repo{$repo}; + $configs{$repo} = $one_config{$repo} if $one_config{$repo}; + return; + } + + if ( -f "gl-conf" ) { + return if not $split_conf{$repo} and not $rc{ALLOW_ORPHAN_GL_CONF}; + + my $cc = "./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}; + } +} + +{ + my $lastrepo = ''; + my $lastuser = ''; + my @cached = (); + + sub rules { + my ( $repo, $user ) = @_; + trace( 3, $repo, $user ); + + return @cached if ( $lastrepo eq $repo and $lastuser eq $user and @cached ); + + my @rules = (); + + my @repos = memberships( 'repo', $repo ); + my @users = memberships( 'user', $user, $repo ); + trace( 3, "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} and exists $repos{$r}{$u}; + } + } + + @rules = sort { $a->[0] <=> $b->[0] } @rules; + + $lastrepo = $repo; + $lastuser = $user; + @cached = @rules; + + # however if the repo was missing, invalidate the cache + $lastrepo = '' if repo_missing($repo); + + return @rules; + } + + sub vrefs { + my ( $repo, $user ) = @_; + # fill the cache if needed + rules( $repo, $user ) unless ( $lastrepo eq $repo and $lastuser eq $user and @cached ); + + my %seen; + my @vrefs = grep { /^VREF\// and not $seen{$_}++ } map { $_->[2] } @cached; + return @vrefs; + } +} + +sub memberships { + trace( 3, @_ ); + my ( $type, $base, $repo ) = @_; + $repo ||= ''; + my @ret; + my $base2 = ''; + + @ret = ( $base, '@all' ); + + if ( $type eq 'repo' ) { + # first, if a repo, say, pub/sitaram/project, has a gl-creator file + # that says "sitaram", find memberships for pub/CREATOR/project also + $base2 = generic_name($base); + + # second, you need to check in %repos also + for my $i ( keys %repos, keys %configs ) { + if ( $base eq $i or $base =~ /^$i$/ or $base2 and ( $base2 eq $i or $base2 =~ /^$i$/ ) ) { + push @ret, $i; + } + } + + # add in any group names explicitly given in (GIT_DIR)/gl-repo-groups + push @ret, + map { s/^\@?/\@/; $_ } + grep { ! /[^\w@-]/ } + split (' ', slurp("$ENV{GL_REPO_BASE}/$base.git/gl-repo-groups")) + if -f "$ENV{GL_REPO_BASE}/$base.git/gl-repo-groups"; + } + + push @ret, @{ $groups{$base} } if exists $groups{$base}; + push @ret, @{ $groups{$base2} } if $base2 and exists $groups{$base2}; + if ($type eq 'repo') { + # regexes can only be used for repos, not for users + for my $i ( keys %{ $patterns{groups} } ) { + if ( $base =~ /^$i$/ or $base2 and ( $base2 =~ /^$i$/ ) ) { + push @ret, @{ $groups{$i} }; + } + } + } + + push @ret, @{ ext_grouplist($base) } if $type eq 'user' and $rc{GROUPLIST_PGM}; + + if ( $type eq 'user' and $repo and not repo_missing($repo) ) { + # find the roles this user has when accessing this repo and add those + # in as groupnames he is a member of. You need the already existing + # memberships for this; see below this function for an example + push @ret, user_roles( $base, $repo, @ret ); + } + + @ret = @{ sort_u( \@ret ) }; + trace( 3, sort @ret ); + return @ret; +} + +=for example + +conf/gitolite.conf: + @g1 = u1 + @g2 = u1 + # now user is a member of both g1 and g2 + +gl-perms for repo being accessed: + READERS @g1 + +This should result in @READERS being added to the memberships that u1 has +(when accessing this repo). So we send the current list (@g1, @g2) to +user_roles(), otherwise it has to redo that logic. + +=cut + +sub data_version_mismatch { + return $data_version ne glrc('current-data-version'); +} + +sub user_roles { + my ( $user, $repo, @eg ) = @_; + + # eg == existing groups (that user is already known to be a member of) + my %eg = map { $_ => 1 } @eg; + + my %ret = (); + my $f = "$rc{GL_REPO_BASE}/$repo.git/gl-perms"; + my @roles = (); + if ( -f $f ) { + my $fh = _open( "<", $f ); + chomp( @roles = <$fh> ); + } + push @roles, "CREATOR = " . creator($repo); + for (@roles) { + # READERS u3 u4 @g1 + s/^\s+//; s/ +$//; s/=/ /; s/\s+/ /g; s/^\@//; + next if /^#/; + next unless /\S/; + my ( $role, @members ) = split; + # role = READERS, members = u3, u4, @g1 + if ( $role ne 'CREATOR' and not $rc{ROLES}{$role} ) { + _warn "role '$role' not allowed, ignoring"; + next; + } + for my $m (@members) { + if ( $m !~ $USERNAME_PATT ) { + _warn "ignoring '$m' in perms line"; + next; + } + # if user eq u3/u4, or is a member of @g1, he has role READERS + $ret{ '@' . $role } = 1 if $m eq $user or $eg{$m}; + } + } + + return keys %ret; +} + +sub generic_name { + my $base = shift; + my $base2 = ''; + my $creator; + + # get the creator name. For not-yet-born repos this is $ENV{GL_USER}, + # which should be set in all cases that we care about, viz., where we are + # checking ^C permissions before new_wild_repo(), and the info command. + # In particular, 'gitolite access' can't be used to check ^C perms on wild + # repos that contain "CREATOR" if GL_USER is not set. + $creator = creator($base); + + $base2 = $base; + $base2 =~ s(\b$creator\b)(CREATOR) if $creator; + $base2 = '' if $base2 eq $base; # if there was no change + + return $base2; +} + +sub creator { + my $repo = shift; + sanity($repo); + + return ( $ENV{GL_USER} || '' ) if repo_missing($repo); + my $f = "$rc{GL_REPO_BASE}/$repo.git/gl-creator"; + my $creator = ''; + chomp( $creator = slurp($f) ) if -f $f; + return $creator; +} + +{ + my %cache = (); + + sub ext_grouplist { + my $user = shift; + my $pgm = $rc{GROUPLIST_PGM}; + return [] if not $pgm; + + return $cache{$user} if $cache{$user}; + my @extgroups = map { s/^@?/@/; $_; } split ' ', `$rc{GROUPLIST_PGM} $user`; + return ( $cache{$user} = \@extgroups ); + } +} + +# ---------------------------------------------------------------------- +# api functions +# ---------------------------------------------------------------------- + +sub lister_dispatch { + my $command = shift; + + my $fn = $listers{$command} or _die "unknown gitolite sub-command"; + return $fn; +} + +=for list_groups +Usage: gitolite list-groups + + - lists all group names in conf + - no options, no flags +=cut + +sub list_groups { + usage() if @_; + + load_common(); + + my @g = (); + while ( my ( $k, $v ) = each(%groups) ) { + push @g, @{$v}; + } + return ( sort_u( \@g ) ); +} + +=for list_users +Usage: gitolite list-users [<repo name pattern>] + +List all users and groups explicitly named in a rule. + +- you will have to run 'list-members' on each group name to expand it -- for + details and caveats on that please see its help message. +- User names not mentioned in an access rule will not show up at all (for + example, if you have users who only have access via an '@all' rule). + +WARNING: may be slow if you have thousands of repos. The optional repo name +pattern is an unanchored regex; it can speed things up if you're interested +only in users of a matching set of repos. This is only an optimisation, not +an actual access list; you will still have to pipe it to 'gitolite access' +with appropriate arguments to get an actual access list. + +NOTE: If you're running in ssh mode, it may be simpler to parse the authorized +keys file in ~/.ssh, like so: + perl -lne '/ ([a-z0-9]+)"/; print $1 if $1' < ~/.ssh/authorized_keys | sort -u +If you're running in http mode, only your web server knows all the potential +user names. +=cut + +sub list_users { + my $patt = shift || '.'; + usage() if $patt eq '-h' or @_; + my $count = 0; + my $total = 0; + + load_common(); + + my @u = map { keys %{$_} } values %repos; + $total = scalar( grep { /$patt/ } keys %split_conf ); + warn "WARNING: you have $total repos to check; this could take some time!\n" if $total > 100; + for my $one ( grep { /$patt/ } 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" if $count >= 100; + return ( sort_u( \@u ) ); +} + +=for list_repos +Usage: gitolite list-repos + + - lists all repos/repo groups in conf + - no options, no flags +=cut + +sub list_repos { + usage() if @_; + + load_common(); + + my @r = keys %repos; + push @r, keys %split_conf; + + return ( sort_u( \@r ) ); +} + +=for list_memberships +Usage: gitolite list-memberships -u|-r <name> + +List all groups a name is a member of. One of the flags '-u' or '-r' is +mandatory, to specify if the name is a user or a repo. + +For users, the output includes the result from GROUPLIST_PGM, if it is +defined. For repos, the output includes any repo patterns that the repo name +matches, as well as any groups that contain those patterns. +=cut + +sub list_memberships { + require Getopt::Long; + + my ( $user, $repo, $help ); + + Getopt::Long::GetOptionsFromArray( + \@_, + 'user|u=s' => \$user, + 'repo|r=s' => \$repo, + 'help|h' => \$help, + ); + usage() if $help or ( not $user and not $repo ); + + load_common(); + my @m; + + if ( $user and $repo ) { + # unsupported/undocumented except via "in_role()" in Easy.pm + @m = memberships( 'user', $user, $repo ); + } elsif ($user) { + @m = memberships( 'user', $user ); + } elsif ($repo) { + @m = memberships( 'repo', $repo ); + } + + @m = grep { $_ ne '@all' and $_ ne ( $user || $repo ) } @m; + return ( sort_u( \@m ) ); +} + +=for list_members +Usage: gitolite list-members <group name> + + - list all members of a group + - takes one group name + +'@all' is not expandable in this context. Also, if you have GROUPLIST_PGM set +in your rc file[1], gitolite cannot expand group names completely; only your +external database can. + +[1]: http://gitolite.com/gitolite/conf.html#ldap + +=cut + +sub list_members { + usage() if @_ and $_[0] eq '-h' or not @_; + + my $name = shift; + + load_common(); + + my @m = (); + while ( my ( $k, $v ) = each(%groups) ) { + for my $g ( @{$v} ) { + push @m, $k if $g eq $name; + } + } + + return ( sort_u( \@m ) ); +} + +# ---------------------------------------------------------------------- + +{ + 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; + |