summaryrefslogtreecommitdiffstats
path: root/src/lib/Gitolite/Conf/Load.pm
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/Gitolite/Conf/Load.pm')
-rw-r--r--src/lib/Gitolite/Conf/Load.pm704
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;
+