diff options
Diffstat (limited to 'src/Gitolite')
| -rw-r--r-- | src/Gitolite/Common.pm | 33 | ||||
| -rw-r--r-- | src/Gitolite/Conf.pm | 6 | ||||
| -rw-r--r-- | src/Gitolite/Conf/Explode.pm | 2 | ||||
| -rw-r--r-- | src/Gitolite/Conf/Load.pm | 86 | ||||
| -rw-r--r-- | src/Gitolite/Conf/Store.pm | 5 | ||||
| -rw-r--r-- | src/Gitolite/Conf/Sugar.pm | 12 | ||||
| -rw-r--r-- | src/Gitolite/Hooks/PostUpdate.pm | 10 | ||||
| -rw-r--r-- | src/Gitolite/Hooks/Update.pm | 22 | ||||
| -rw-r--r-- | src/Gitolite/Rc.pm | 72 | ||||
| -rw-r--r-- | src/Gitolite/Setup.pm | 5 | ||||
| -rw-r--r-- | src/Gitolite/Test.pm | 4 | ||||
| -rw-r--r-- | src/Gitolite/Test/Tsh.pm | 3 |
12 files changed, 140 insertions, 120 deletions
diff --git a/src/Gitolite/Common.pm b/src/Gitolite/Common.pm index eb4b6f1..2260e41 100644 --- a/src/Gitolite/Common.pm +++ b/src/Gitolite/Common.pm @@ -40,10 +40,10 @@ sub trace { return unless defined( $ENV{D} ); my $level = shift; return if $ENV{D} < $level; - my $args = ''; $args = join( ", ", @_ ) if @_; - my $sub = ( caller 1 )[3] || ''; $sub =~ s/.*://; $sub .= ' ' x ( 32 - length($sub) ); - say2 "TRACE $level $sub", (@_ ? shift : ()); - say2("TRACE $level " . (" " x 32), $_)for @_; + my $args = ''; $args = join( ", ", @_ ) if @_; + my $sub = ( caller 1 )[3] || ''; $sub =~ s/.*://; $sub .= ' ' x ( 32 - length($sub) ); + say2 "TRACE $level $sub", ( @_ ? shift : () ); + say2( "TRACE $level " . ( " " x 32 ), $_ ) for @_; } sub dbg { @@ -75,13 +75,17 @@ sub _die { } sub usage { - my ($warn, $section) = @_; - _warn($warn) if $warn; - $section ||= 'usage'; - my $scriptname = ( caller() )[1]; - my $script = slurp($scriptname); - $script =~ /^=for $section(.*?)^=cut/sm; - say2( $1 ? $1 : "...no usage message in $scriptname" ); + _warn(shift) if @_; + my ( $script, $function ) = ( caller(1) )[ 1, 3 ]; + if (not $script) { + $script = ( caller ) [1]; + $function = 'usage'; + } + dbg( "u s a g e", $script, $function ); + $function =~ s/.*:://; + my $code = slurp($script); + $code =~ /^=for $function(.*?)^=cut/sm; + say2( $1 ? $1 : "...no usage message in $script" ); exit 1; } @@ -154,8 +158,8 @@ sub ln_sf { sub sort_u { my %uniq; my $listref = shift; - return [] unless @{ $listref }; - undef @uniq{ @{ $listref } }; # expect a listref + return [] unless @{$listref}; + undef @uniq{ @{$listref} }; # expect a listref my @sort_u = sort keys %uniq; return \@sort_u; } @@ -177,7 +181,6 @@ sub cleanup_conf_line { my @phy_repos = (); sub list_phy_repos { - _die "'gitolite list_phy_repos' takes no arguments" if @ARGV; trace(3); # use cached value only if it exists *and* no arg was received (i.e., @@ -189,7 +192,7 @@ sub cleanup_conf_line { $repo =~ s(\./(.*)\.git$)($1); push @phy_repos, $repo; } - return sort_u(\@phy_repos); + return sort_u( \@phy_repos ); } } diff --git a/src/Gitolite/Conf.pm b/src/Gitolite/Conf.pm index 6fcc0cf..a93aa10 100644 --- a/src/Gitolite/Conf.pm +++ b/src/Gitolite/Conf.pm @@ -24,12 +24,12 @@ use warnings; sub compile { trace(3); - # XXX assume we're in admin-base/conf + _die "'gitolite compile' does not take any arguments" if @_; _chdir( $rc{GL_ADMIN_BASE} ); _chdir("conf"); - parse(sugar('gitolite.conf')); + parse( sugar('gitolite.conf') ); # the order matters; new repos should be created first, to give store a # place to put the individual gl-conf files @@ -39,7 +39,7 @@ sub compile { sub parse { my $lines = shift; - trace(4, scalar(@$lines) . " lines incoming"); + trace( 4, scalar(@$lines) . " lines incoming" ); for my $line (@$lines) { # user or repo groups diff --git a/src/Gitolite/Conf/Explode.pm b/src/Gitolite/Conf/Explode.pm index a821dc9..f77e89d 100644 --- a/src/Gitolite/Conf/Explode.pm +++ b/src/Gitolite/Conf/Explode.pm @@ -28,7 +28,7 @@ sub explode { # seed the 'seen' list if it's empty $included{ device_inode("conf/gitolite.conf") }++ unless %included; - my $fh = _open( "<", $file ); + my $fh = _open( "<", $file ); while (<$fh>) { my $line = cleanup_conf_line($_); next unless $line =~ /\S/; diff --git a/src/Gitolite/Conf/Load.pm b/src/Gitolite/Conf/Load.pm index 625d7eb..1759214 100644 --- a/src/Gitolite/Conf/Load.pm +++ b/src/Gitolite/Conf/Load.pm @@ -7,12 +7,7 @@ package Gitolite::Conf::Load; load access vrefs - - list_groups - list_users - list_repos - list_memberships - list_members + lister_dispatch ); use Exporter 'import'; @@ -25,8 +20,6 @@ use warnings; # ---------------------------------------------------------------------- -my $subconf = 'master'; - # our variables, because they get loaded by a 'do' our $data_version = ''; our %repos; @@ -36,6 +29,16 @@ 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 = ''; @@ -118,7 +121,7 @@ sub load_1 { my $repo = shift; trace( 4, $repo ); - _chdir( "$rc{GL_REPO_BASE}/$repo.git" ); + _chdir("$rc{GL_REPO_BASE}/$repo.git"); if ( $repo eq $last_repo ) { $repos{$repo} = $one_repo{$repo}; @@ -143,13 +146,13 @@ sub load_1 { { my $lastrepo = ''; my $lastuser = ''; - my @cached = (); + my @cached = (); sub rules { my ( $repo, $user ) = @_; trace( 4, "repo=$repo, user=$user" ); - return @cached if ($lastrepo eq $repo and $lastuser eq $user and @cached); + return @cached if ( $lastrepo eq $repo and $lastuser eq $user and @cached ); my @rules = (); @@ -167,7 +170,7 @@ sub load_1 { $lastrepo = $repo; $lastuser = $user; - @cached = @rules; + @cached = @rules; return @rules; } @@ -175,7 +178,7 @@ sub load_1 { sub vrefs { my ( $repo, $user ) = @_; # fill the cache if needed - rules($repo, $user) unless ($lastrepo eq $repo and $lastuser eq $user and @cached); + 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; @@ -200,15 +203,22 @@ sub data_version_mismatch { # api functions # ---------------------------------------------------------------------- -# list all groups -sub list_groups { - die " +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 -" if @ARGV; +sub list_groups { + usage() if @_; load_common(); @@ -219,18 +229,18 @@ Usage: gitolite list-groups return ( sort_u( \@g ) ); } -sub list_users { - my $count = 0; - my $total = 0; - - die " +=for list_users 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 +=cut -" if @ARGV; +sub list_users { + usage() if @_; + my $count = 0; + my $total = 0; load_common(); @@ -242,19 +252,19 @@ Usage: gitolite list-users $count++; print STDERR "$count / $total\r" if not( $count % 100 ) and timer(5); push @u, map { keys %{$_} } values %one_repo; } - print STDERR "\n"; + print STDERR "\n" if $count >= 100; return ( sort_u( \@u ) ); } -sub list_repos { - - die " +=for list_repos Usage: gitolite list-repos - lists all repos/repo groups in conf - no options, no flags +=cut -" if @ARGV; +sub list_repos { + usage() if @_; load_common(); @@ -264,34 +274,34 @@ Usage: gitolite list-repos return ( sort_u( \@r ) ); } -sub list_memberships { - - die " +=for list_memberships Usage: gitolite list-memberships <name> - list all groups a name is a member of - takes one user/repo name +=cut -" if @ARGV and $ARGV[0] eq '-h' or not @ARGV and not @_; +sub list_memberships { + usage() if @_ and $_[0] eq '-h' or not @_; - my $name = ( @_ ? shift @_ : shift @ARGV ); + my $name = shift; load_common(); my @m = memberships($name); return ( sort_u( \@m ) ); } -sub list_members { - - die " +=for list_members Usage: gitolite list-members <group name> - list all members of a group - takes one group name +=cut -" if @ARGV and $ARGV[0] eq '-h' or not @ARGV and not @_; +sub list_members { + usage() if @_ and $_[0] eq '-h' or not @_; - my $name = ( @_ ? shift @_ : shift @ARGV ); + my $name = shift; load_common(); diff --git a/src/Gitolite/Conf/Store.pm b/src/Gitolite/Conf/Store.pm index c513669..154b44e 100644 --- a/src/Gitolite/Conf/Store.pm +++ b/src/Gitolite/Conf/Store.pm @@ -207,9 +207,8 @@ sub store { } sub parse_done { - for my $ig (sort keys %ignored) - { - _warn "$ig.conf attempting to set access for " . join (", ", sort keys %{ $ignored{$ig} }); + for my $ig ( sort keys %ignored ) { + _warn "$ig.conf attempting to set access for " . join( ", ", sort keys %{ $ignored{$ig} } ); } } diff --git a/src/Gitolite/Conf/Sugar.pm b/src/Gitolite/Conf/Sugar.pm index 30dcfc0..caea1fb 100644 --- a/src/Gitolite/Conf/Sugar.pm +++ b/src/Gitolite/Conf/Sugar.pm @@ -3,7 +3,7 @@ package SugarBox; sub run_sugar_script { - my ($ss, $lref) = @_; + my ( $ss, $lref ) = @_; do $ss if -x $ss; $lref = sugar_script($lref); return $lref; @@ -35,7 +35,7 @@ sub sugar { # gets a filename, returns a listref my @lines = (); - explode(shift, 'master', \@lines); + explode( shift, 'master', \@lines ); my $lines; $lines = \@lines; @@ -43,11 +43,11 @@ sub sugar { # run through the sugar stack one by one # first, user supplied sugar: - if (exists $rc{SYNTACTIC_SUGAR}) { - if (ref($rc{SYNTACTIC_SUGAR}) ne 'ARRAY') { + if ( exists $rc{SYNTACTIC_SUGAR} ) { + if ( ref( $rc{SYNTACTIC_SUGAR} ) ne 'ARRAY' ) { _warn "bad syntax for specifying sugar scripts; see docs"; } else { - for my $s (@{ $rc{SYNTACTIC_SUGAR} }) { + for my $s ( @{ $rc{SYNTACTIC_SUGAR} } ) { # perl-ism; apart from keeping the full path separate from the # simple name, this also protects %rc from change by implicit @@ -55,7 +55,7 @@ sub sugar { my $sfp = "$ENV{GL_BINDIR}/syntactic-sugar/$s"; _warn("skipped sugar script '$s'"), next if not -x $sfp; - $lines = SugarBox::run_sugar_script($sfp, $lines); + $lines = SugarBox::run_sugar_script( $sfp, $lines ); $lines = [ grep /\S/, map { cleanup_conf_line($_) } @$lines ]; } } diff --git a/src/Gitolite/Hooks/PostUpdate.pm b/src/Gitolite/Hooks/PostUpdate.pm index ab94e23..efd4838 100644 --- a/src/Gitolite/Hooks/PostUpdate.pm +++ b/src/Gitolite/Hooks/PostUpdate.pm @@ -19,7 +19,7 @@ use warnings; # ---------------------------------------------------------------------- sub post_update { - trace(3, @ARGV); + trace( 3, @ARGV ); # this is the *real* post_update hook for gitolite tsh_try("git ls-tree --name-only master"); @@ -32,11 +32,11 @@ sub post_update { _system("$ENV{GL_BINDIR}/gitolite compile"); # now run optional post-compile features - if (exists $rc{POST_COMPILE}) { - if (ref($rc{POST_COMPILE}) ne 'ARRAY') { + if ( exists $rc{POST_COMPILE} ) { + if ( ref( $rc{POST_COMPILE} ) ne 'ARRAY' ) { _warn "bad syntax for specifying post compile scripts; see docs"; } else { - for my $s (@{ $rc{POST_COMPILE} }) { + for my $s ( @{ $rc{POST_COMPILE} } ) { # perl-ism; apart from keeping the full path separate from the # simple name, this also protects %rc from change by implicit @@ -44,7 +44,7 @@ sub post_update { my $sfp = "$ENV{GL_BINDIR}/post-compile/$s"; _warn("skipped post-compile script '$s'"), next if not -x $sfp; - _system($sfp, @ARGV); # they better all return with 0 exit codes! + _system( $sfp, @ARGV ); # they better all return with 0 exit codes! } } } diff --git a/src/Gitolite/Hooks/Update.pm b/src/Gitolite/Hooks/Update.pm index cc13465..da089b5 100644 --- a/src/Gitolite/Hooks/Update.pm +++ b/src/Gitolite/Hooks/Update.pm @@ -28,32 +28,32 @@ sub update { trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref) -> $ret" ); _die $ret if $ret =~ /DENIED/; - check_vrefs($ref, $oldsha, $newsha, $oldtree, $newtree, $aa); + check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ); exit 0; } sub check_vrefs { - my($ref, $oldsha, $newsha, $oldtree, $newtree, $aa) = @_; + my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = @_; my $name_seen = 0; - for my $vref ( vrefs($ENV{GL_REPO}, $ENV{GL_USER}) ) { - trace(1, "vref=$vref"); - if ($vref =~ m(^VREF/NAME/)) { + for my $vref ( vrefs( $ENV{GL_REPO}, $ENV{GL_USER} ) ) { + trace( 1, "vref=$vref" ); + if ( $vref =~ m(^VREF/NAME/) ) { # this one is special; we process it right here, and only once next if $name_seen++; for my $ref ( map { chomp; s(^)(VREF/NAME/); $_; } `git diff --name-only $oldtree $newtree` ) { - check_vref($aa, $ref); + check_vref( $aa, $ref ); } } else { - my($dummy, $pgm, @args) = split '/', $vref; + my ( $dummy, $pgm, @args ) = split '/', $vref; $pgm = "$ENV{GL_BINDIR}/VREF/$pgm"; -x $pgm or die "$vref: helper program missing or unexecutable\n"; open( my $fh, "-|", $pgm, @_, $vref, @args ) or die "$vref: can't spawn helper program: $!\n"; while (<$fh>) { my ( $ref, $deny_message ) = split( ' ', $_, 2 ); - check_vref($aa, $ref, $deny_message); + check_vref( $aa, $ref, $deny_message ); } close($fh) or die $! ? "Error closing sort pipe: $!" @@ -63,13 +63,13 @@ sub check_vrefs { } sub check_vref { - my ($aa, $ref, $deny_message) = @_; + my ( $aa, $ref, $deny_message ) = @_; my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref ); trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" ); _die "$ret" . ( $deny_message ? "\n$deny_message" : '' ) - if $ret =~ /DENIED/ and $ret !~ /by fallthru/; - trace( 1, "remember, fallthru is success here!") if $ret =~ /by fallthru/; + if $ret =~ /DENIED/ and $ret !~ /by fallthru/; + trace( 1, "remember, fallthru is success here!" ) if $ret =~ /by fallthru/; } { diff --git a/src/Gitolite/Rc.pm b/src/Gitolite/Rc.pm index be82ab2..2a51a55 100644 --- a/src/Gitolite/Rc.pm +++ b/src/Gitolite/Rc.pm @@ -8,7 +8,7 @@ package Gitolite::Rc; glrc query_rc - $ADC_CMD_ARGS_PATT + $REMOTE_COMMAND_PATT $REF_OR_FILENAME_PATT $REPONAME_PATT $REPOPATT_PATT @@ -36,7 +36,7 @@ $rc{GL_REPO_BASE} = "$ENV{HOME}/repositories"; # variables that should probably never be changed # ---------------------------------------------------------------------- -$ADC_CMD_ARGS_PATT = qr(^[0-9a-zA-Z._\@/+:-]*$); +$REMOTE_COMMAND_PATT = qr(^[- 0-9a-zA-Z\@\%_=+:,./]*$); $REF_OR_FILENAME_PATT = qr(^[0-9a-zA-Z][0-9a-zA-Z._\@/+ :,-]*$); $REPONAME_PATT = qr(^\@?[0-9a-zA-Z][0-9a-zA-Z._\@/+-]*$); $REPOPATT_PATT = qr(^\@?[0-9a-zA-Z[][\\^.$|()[\]*+?{}0-9a-zA-Z._\@/,-]*$); @@ -101,26 +101,9 @@ sub glrc { # implements 'gitolite query-rc' # ---------------------------------------------------------------------- -=for usage - -Usage: gitolite query-rc -a - gitolite query-rc [-n] <list of rc variables> - - -a print all variables and values - -n do not append a newline - -Example: - - gitolite query-rc GL_ADMIN_BASE GL_UMASK - # prints "/home/git/.gitolite<tab>0077" or similar - - gitolite query-rc -a - # prints all known variables and values, one per line -=cut - # ---------------------------------------------------------------------- -my $all = 0; +my $all = 0; my $nonl = 0; sub query_rc { @@ -130,18 +113,38 @@ sub query_rc { no strict 'refs'; - if ( $all ) { - for my $e (sort keys %rc) { - print "$e=" . ( defined($rc{$e}) ? $rc{$e} : 'undef' ) . "\n"; + if ($all) { + for my $e ( sort keys %rc ) { + print "$e=" . ( defined( $rc{$e} ) ? $rc{$e} : 'undef' ) . "\n"; } - return; + exit 0; } - print join( "\t", map { $rc{$_} || '' } @vars ) . ($nonl ? '' : "\n") if @vars; + my @res = map { $rc{$_} } grep { $rc{$_} } @vars; + print join( "\t", @res ) . ( $nonl ? '' : "\n" ) if @res; + # shell truth + exit 0 if @res; + exit 1; } # ---------------------------------------------------------------------- +=for args +Usage: gitolite query-rc -a + gitolite query-rc [-n] <list of rc variables> + + -a print all variables and values + -n do not append a newline + +Example: + + gitolite query-rc GL_ADMIN_BASE UMASK + # prints "/home/git/.gitolite<tab>0077" or similar + + gitolite query-rc -a + # prints all known variables and values, one per line +=cut + sub args { my $help = 0; @@ -163,30 +166,35 @@ sub args { __DATA__ # configuration variables for gitolite -# PLEASE READ THE DOCUMENTATION BEFORE EDITING OR ASKING QUESTIONS - -# This file is in perl syntax. +# This file is in perl syntax. But you do NOT need to know perl to edit it -- +# just mind the commas and make sure the brackets and braces stay matched up! -# However, you do NOT need to know perl to edit it; it should be fairly -# self-explanatory and easy to maintain. Just mind the commas (perl is quite -# happy to have an extra one at the end of the last item in any list, by the -# way!). And make sure the brackets and braces stay matched up! +# (Tip: perl allows a comma after the last item in a list also!) %RC = ( UMASK => 0077, GL_GITCONFIG_KEYS => "", # comment out or uncomment as needed + # these will run in sequence during the conf file parse SYNTACTIC_SUGAR => [ # 'continuation-lines', ], # comment out or uncomment as needed + # these will run in sequence after post-update POST_COMPILE => [ 'ssh-authkeys', ], + + # comment out or uncomment as needed + # these are available to remote users + COMMANDS => + { + 'info' => 1, + }, ); # ------------------------------------------------------------------------------ diff --git a/src/Gitolite/Setup.pm b/src/Gitolite/Setup.pm index d335147..09930bd 100644 --- a/src/Gitolite/Setup.pm +++ b/src/Gitolite/Setup.pm @@ -3,14 +3,15 @@ package Gitolite::Setup; # implements 'gitolite setup' # ---------------------------------------------------------------------- -=for usage +=for args Usage: gitolite setup [<at least one option>] - -a, --admin <name> admin user name -pk --pubkey <file> pubkey file name -f, --fixup-hooks fixup hooks +Setup (first run only), then compile conf and fixup hooks. + First run: -a required -pk required for ssh mode install diff --git a/src/Gitolite/Test.pm b/src/Gitolite/Test.pm index f950fb3..f7b4544 100644 --- a/src/Gitolite/Test.pm +++ b/src/Gitolite/Test.pm @@ -17,8 +17,8 @@ use Carp qw(carp cluck croak confess); BEGIN { require Gitolite::Test::Tsh; - *{'try'} = \&Tsh::try; - *{'put'} = \&Tsh::put; + *{'try'} = \&Tsh::try; + *{'put'} = \&Tsh::put; *{'text'} = \&Tsh::text; } diff --git a/src/Gitolite/Test/Tsh.pm b/src/Gitolite/Test/Tsh.pm index b4b3b41..41b4d12 100644 --- a/src/Gitolite/Test/Tsh.pm +++ b/src/Gitolite/Test/Tsh.pm @@ -259,8 +259,7 @@ sub rc_lines { $cmd = shift @cmds; # is the current command a "testing" command? - my $testing_cmd = - ( $cmd =~ m(^ok(?:\s+or\s+(.*))?$) or $cmd =~ m(^!ok(?:\s+or\s+(.*))?$) or $cmd =~ m(^/(.*?)/(?:\s+or\s+(.*))?$) or $cmd =~ m(^!/(.*?)/(?:\s+or\s+(.*))?$) ); + my $testing_cmd = ( $cmd =~ m(^ok(?:\s+or\s+(.*))?$) or $cmd =~ m(^!ok(?:\s+or\s+(.*))?$) or $cmd =~ m(^/(.*?)/(?:\s+or\s+(.*))?$) or $cmd =~ m(^!/(.*?)/(?:\s+or\s+(.*))?$) ); # warn if the previous command failed but rc is not being checked if ( $rc and not $testing_cmd ) { |