package Gitolite::Conf::Store; # receive parsed conf data and store it # ---------------------------------------------------------------------- @EXPORT = qw( add_to_group expand_list set_repolist parse_refs parse_users add_rule set_subconf new_repos new_repo hook_repos store ); use Exporter 'import'; use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; use lib $ENV{GL_BINDIR}; use Gitolite::Common; use Gitolite::Rc; use Gitolite::Hooks::Update; use Gitolite::Hooks::PostUpdate; use strict; use warnings; # ---------------------------------------------------------------------- my %repos; my %groups; my %configs; my %split_conf; my @repolist; # current repo list; reset on each 'repo ...' line my $subconf = 'master'; my $ruleseq = 0; my %ignored; # XXX you still have to "warn" if this has any entries # ---------------------------------------------------------------------- sub add_to_group { my ( $lhs, @rhs ) = @_; _die "bad group '$lhs'" unless $lhs =~ $REPONAME_PATT; # store the group association, but overload it to keep track of when # the group was *first* created by using $subconf as the *value* do { $groups{$lhs}{$_} ||= $subconf } for ( expand_list(@rhs) ); # create the group hash even if empty $groups{$lhs} = {} unless $groups{$lhs}; } sub expand_list { my @list = @_; my @new_list = (); for my $item (@list) { if ( $item =~ /^@/ and $item ne '@all' ) # nested group { _die "undefined group $item" unless $groups{$item}; # add those names to the list push @new_list, sort keys %{ $groups{$item} }; } else { push @new_list, $item; } } return @new_list; } sub set_repolist { @repolist = @_; # ...sanity checks for (@repolist) { _warn "explicit '.git' extension ignored for $_.git" if s/\.git$//; _die "bad reponame '$_'" if $_ !~ $REPOPATT_PATT; } # XXX -- how do we deal with this? s/\bCREAT[EO]R\b/\$creator/g for @{ $repos_p }; } sub parse_refs { my $refs = shift; my @refs; @refs = split( ' ', $refs ) if $refs; @refs = expand_list(@refs); # if no ref is given, this PERM applies to all refs @refs = qw(refs/.*) unless @refs; # fully qualify refs that dont start with "refs/" or "NAME/" or "VREF/"; # prefix them with "refs/heads/" @refs = map { m(^(refs|NAME|VREF)/) or s(^)(refs/heads/); $_ } @refs; # XXX what do we do? @refs = map { s(/USER/)(/\$gl_user/); $_ } @refs; return @refs; } sub parse_users { my $users = shift; my @users = split ' ', $users; do { _die "bad username '$_'" unless $_ =~ $USERNAME_PATT } for @users; return @users; } sub add_rule { my ( $perm, $ref, $user ) = @_; $ruleseq++; for my $repo (@repolist) { if ( check_subconf_repo_disallowed( $subconf, $repo ) ) { my $repo = $repo; $repo =~ s/^\@$subconf\./locally modified \@/; $ignored{$subconf}{$repo} = 1; next; } push @{ $repos{$repo}{$user} }, [ $ruleseq, $perm, $ref ]; # XXX g2 diff: we're not doing a lint check for usernames versus pubkeys; # maybe we can add that later # XXX to do: C/R/W, then CREATE_IS_C, etc # XXX to do: also NAME_LIMITS # XXX and hacks like $creator -> "$creatror - wild" # XXX consider if you want to use rurp_seen; initially no } } sub set_subconf { $subconf = shift; trace( 1, $subconf ); } sub new_repos { trace(3); _chdir( $rc{GL_REPO_BASE} ); # normal repos my @repos = grep { $_ =~ $REPONAME_PATT and not /^@/ } sort keys %repos; # add in members of repo groups map { push @repos, keys %{ $groups{$_} } } grep { /^@/ } keys %repos; for my $repo ( @{ sort_u( \@repos ) } ) { next unless $repo =~ $REPONAME_PATT; # skip repo patterns next if $repo =~ m(^\@|EXTCMD/); # skip groups and fake repos # XXX how do we deal with GL_NO_CREATE_REPOS? new_repo($repo) if not -d "$repo.git"; } } sub new_repo { my $repo = shift; trace( 4, $repo ); # XXX ignoring UMASK for now _mkdir("$repo.git"); _chdir("$repo.git"); system("git init --bare >&2"); _chdir( $rc{GL_REPO_BASE} ); hook_1($repo); # XXX ignoring creator for now # XXX ignoring gl-post-init for now } sub hook_repos { trace(3); # all repos, all hooks _chdir( $rc{GL_REPO_BASE} ); # XXX g2 diff: we now don't care if it's a symlink -- it's upto the admin # on the server to make sure things are kosher for my $repo (`find . -name "*.git" -prune`) { chomp($repo); $repo =~ s/\.git$//; hook_1($repo); } } sub store { trace(3); # first write out the ones for the physical repos _chdir( $rc{GL_REPO_BASE} ); my $phy_repos = list_phy_repos(1); for my $repo ( @{$phy_repos} ) { store_1($repo); } _chdir( $rc{GL_ADMIN_BASE} ); store_common(); } # ---------------------------------------------------------------------- sub check_subconf_repo_disallowed { # trying to set access for $repo (='foo')... my ( $subconf, $repo ) = @_; # processing the master config, not a subconf return 0 if $subconf eq 'master'; # subconf is also called 'foo' (you're allowed to have a # subconf that is only concerned with one repo) return 0 if $subconf eq $repo; # same thing in big-config-land; foo is just @foo now return 0 if ( "\@$subconf" eq $repo ); my @matched = grep { $repo =~ /^$_$/ } grep { $groups{"\@$subconf"}{$_} eq 'master' } sort keys %{ $groups{"\@$subconf"} }; return 0 if @matched > 0; trace( 3, "disallowed: $subconf for $repo" ); return 1; } sub store_1 { # warning: writes and *deletes* it from %repos and %configs my ($repo) = shift; trace( 4, $repo ); return unless $repos{$repo} and -d "$repo.git"; my ( %one_repo, %one_config ); open( my $compiled_fh, ">", "$repo.git/gl-conf" ) or return; $one_repo{$repo} = $repos{$repo}; delete $repos{$repo}; my $dumped_data = Data::Dumper->Dump( [ \%one_repo ], [qw(*one_repo)] ); if ( $configs{$repo} ) { $one_config{$repo} = $configs{$repo}; delete $configs{$repo}; $dumped_data .= Data::Dumper->Dump( [ \%one_config ], [qw(*one_config)] ); } # XXX deal with this better now # $dumped_data =~ s/'(?=[^']*\$(?:creator|gl_user))~?(.*?)'/"$1"/g; print $compiled_fh $dumped_data; close $compiled_fh; $split_conf{$repo} = 1; } sub store_common { trace(4); my $cc = "conf/gitolite.conf-compiled.pm"; my $compiled_fh = _open( ">", "$cc.new" ); my $data_version = glrc('current-data-version'); trace( 1, "data_version = $data_version" ); print $compiled_fh Data::Dumper->Dump( [$data_version], [qw(*data_version)] ); my $dumped_data = Data::Dumper->Dump( [ \%repos ], [qw(*repos)] ); $dumped_data .= Data::Dumper->Dump( [ \%configs ], [qw(*configs)] ) if %configs; # XXX and again... # XXX $dumped_data =~ s/'(?=[^']*\$(?:creator|gl_user))~?(.*?)'/"$1"/g; print $compiled_fh $dumped_data; if (%groups) { my %groups = %{ inside_out( \%groups ) }; $dumped_data = Data::Dumper->Dump( [ \%groups ], [qw(*groups)] ); # XXX $dumped_data =~ s/\bCREAT[EO]R\b/\$creator/g; # XXX $dumped_data =~ s/'(?=[^']*\$(?:creator|gl_user))~?(.*?)'/"$1"/g; print $compiled_fh $dumped_data; } print $compiled_fh Data::Dumper->Dump( [ \%split_conf ], [qw(*split_conf)] ) if %split_conf; close $compiled_fh or _die "close compiled-conf failed: $!\n"; rename "$cc.new", $cc; } { my $hook_reset = 0; sub hook_1 { my $repo = shift; trace( 4, $repo ); # reset the gitolite supplied hooks, in case someone fiddled with # them, but only once per run if ( not $hook_reset ) { _mkdir("$rc{GL_ADMIN_BASE}/hooks/common"); _mkdir("$rc{GL_ADMIN_BASE}/hooks/gitolite-admin"); _print( "$rc{GL_ADMIN_BASE}/hooks/common/update", update_hook() ); _print( "$rc{GL_ADMIN_BASE}/hooks/gitolite-admin/post-update", post_update_hook() ); chmod 0755, "$rc{GL_ADMIN_BASE}/hooks/common/update"; chmod 0755, "$rc{GL_ADMIN_BASE}/hooks/gitolite-admin/post-update"; $hook_reset++; } # propagate user hooks ln_sf( "$rc{GL_ADMIN_BASE}/hooks/common", "*", "$repo.git/hooks" ); # propagate admin hook ln_sf( "$rc{GL_ADMIN_BASE}/hooks/gitolite-admin", "*", "$repo.git/hooks" ) if $repo eq 'gitolite-admin'; # g2 diff: no "site-wide" hooks (the stuff in between gitolite hooks # and user hooks) anymore. I don't think anyone used them anyway... } } sub inside_out { my $href = shift; # input conf: @aa = bb cc @bb = @aa dd my %ret = (); while ( my ( $k, $v ) = each( %{$href} ) ) { # $k is '@aa', $v is a href for my $k2 ( keys %{$v} ) { # $k2 is bb, then cc push @{ $ret{$k2} }, $k; } } return \%ret; # %groups = ( 'bb' => [ '@bb', '@aa' ], 'cc' => [ '@bb', '@aa' ], 'dd' => [ '@bb' ]); } 1;