From 7f8020adc5709690e74f0d07838022e43533c272 Mon Sep 17 00:00:00 2001 From: Sitaram Chamarty Date: Mon, 12 Mar 2012 20:54:30 +0530 Subject: [PATCH] 'info' command, plus lots more changes: - usage() gets a little smarter; it now knows what function it was called from and tries to find a '=for function_name' chunk of data in the script - the various list-* functions now work off a dispatcher in Load.pm - (...and they all use the new usage() magic to print their helps!) - src/gitolite got a lot leaner due to this dispatcher - src/gitolite-shell became a lot more easier to read/flow - rc acquired '{COMMANDS}', which gitolite-shell now refers to - comments in the default rc file changed a bit - rc got a new REMOTE_COMMAND_PATT (in place of ADC_CMD_ARGS_PATT) the rest is perltidy and stuff like that --- src/Gitolite/Common.pm | 33 ++++--- src/Gitolite/Conf.pm | 6 +- src/Gitolite/Conf/Explode.pm | 2 +- src/Gitolite/Conf/Load.pm | 86 +++++++++-------- src/Gitolite/Conf/Store.pm | 5 +- src/Gitolite/Conf/Sugar.pm | 12 +-- src/Gitolite/Hooks/PostUpdate.pm | 10 +- src/Gitolite/Hooks/Update.pm | 22 ++--- src/Gitolite/Rc.pm | 72 ++++++++------ src/Gitolite/Setup.pm | 5 +- src/Gitolite/Test.pm | 4 +- src/Gitolite/Test/Tsh.pm | 3 +- src/VREF/COUNT | 1 + src/VREF/FILETYPE | 1 + src/commands/info | 31 ++++++ src/gitolite | 129 +++++++++++++------------ src/gitolite-shell | 93 ++++++++++++++---- src/post-compile/ssh-authkeys | 2 +- src/syntactic-sugar/continuation-lines | 4 +- t/glt | 5 +- 20 files changed, 317 insertions(+), 209 deletions(-) create mode 100755 src/commands/info 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 - 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 - 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] - - -a print all variables and values - -n do not append a newline - -Example: - - gitolite query-rc GL_ADMIN_BASE GL_UMASK - # prints "/home/git/.gitolite0077" 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] + + -a print all variables and values + -n do not append a newline + +Example: + + gitolite query-rc GL_ADMIN_BASE UMASK + # prints "/home/git/.gitolite0077" 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. 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! -# This file is in perl syntax. - -# 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 [] - -a, --admin admin user name -pk --pubkey 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 ) { diff --git a/src/VREF/COUNT b/src/VREF/COUNT index f61ab57..d5c3982 100755 --- a/src/VREF/COUNT +++ b/src/VREF/COUNT @@ -1,4 +1,5 @@ #!/bin/bash +# TODO: convert to perl! # gitolite VREF to count number of changed/new files in a push diff --git a/src/VREF/FILETYPE b/src/VREF/FILETYPE index e61acc6..2115a5c 100755 --- a/src/VREF/FILETYPE +++ b/src/VREF/FILETYPE @@ -1,4 +1,5 @@ #!/bin/bash +# TODO: convert to perl! # gitolite VREF to find autogenerated files diff --git a/src/commands/info b/src/commands/info new file mode 100755 index 0000000..fe52837 --- /dev/null +++ b/src/commands/info @@ -0,0 +1,31 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use lib $ENV{GL_BINDIR}; +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +=for usage +Usage: gitolite info + + - list all repos/repo groups you can access + - no options, no flags +=cut + +usage() if @ARGV; + +my $user = $ENV{GL_USER} or _die "GL_USER not set"; +my $ref = 'any'; + +my $fn = lister_dispatch('list-repos'); + +for ( @{ $fn->() } ) { + my $perm = ''; + for my $aa (qw(R W ^C)) { + my $ret = access($_, $user, $aa, $ref); + $perm .= ( $ret =~ /DENIED/ ? " " : " $aa" ); + } + print "$perm\t$_\n" if $perm =~ /\S/; +} diff --git a/src/gitolite b/src/gitolite index d8c82af..c265bd5 100755 --- a/src/gitolite +++ b/src/gitolite @@ -3,7 +3,7 @@ # all gitolite CLI tools run as sub-commands of this command # ---------------------------------------------------------------------- -=for usage +=for args Usage: gitolite [sub-command] [options] The following subcommands are available; they should all respond to '-h' if @@ -11,14 +11,16 @@ you want further details on each: setup 1st run: initial setup; all runs: hook fixups compile compile gitolite.conf + query-rc get values of rc variables + post-compile run a post-compile command + list-groups list all group names in conf list-users list all users/user groups in conf list-repos list all repos/repo groups in conf list-phy-repos list all repos actually on disk list-memberships list all groups a name is a member of list-members list all members of a group - post-compile run a post-compile command Warnings: - list-users is disk bound and could take a while on sites with 1000s of repos @@ -40,66 +42,56 @@ use warnings; # ---------------------------------------------------------------------- +my ( $command, @args ) = @ARGV; args(); +# the first two commands need options via @ARGV, as they have their own +# GetOptions calls and older perls don't have 'GetOptionsFromArray' + +if ( $command eq 'setup' ) { + shift @ARGV; + require Gitolite::Setup; + Gitolite::Setup->import; + setup(); + +} elsif ( $command eq 'query-rc' ) { + shift @ARGV; + query_rc(); # doesn't return + +# the rest don't need @ARGV per se + +} elsif ( $command eq 'compile' ) { + require Gitolite::Conf; + Gitolite::Conf->import; + compile(@args); + +} elsif ( $command eq 'post-compile' ) { + post_compile(@args); + +} elsif ( -x "$rc{GL_BINDIR}/commands/$command" ) { + run_command( $command, @args ); + +} elsif ( $command eq 'list-phy-repos' ) { + _chdir( $rc{GL_REPO_BASE} ); + print "$_\n" for ( @{ list_phy_repos(@args) } ); + +} elsif ( $command =~ /^list-/ ) { + require Gitolite::Conf::Load; + Gitolite::Conf::Load->import; + my $fn = lister_dispatch($command); + print "$_\n" for ( @{ $fn->(@args) } ); + +} else { + _die "unknown gitolite sub-command"; +} + +sub args { + usage() if not $command or $command eq '-h'; +} + # ---------------------------------------------------------------------- -sub args { - my ( $command, @args ) = @ARGV; - usage() if not $command or $command eq '-h'; - - if ( $command eq 'setup' ) { - shift @ARGV; - require Gitolite::Setup; - Gitolite::Setup->import; - setup(); - } elsif ( $command eq 'compile' ) { - shift @ARGV; - _die "'gitolite compile' does not take any arguments" if @ARGV; - require Gitolite::Conf; - Gitolite::Conf->import; - compile(); - } elsif ( $command eq 'query-rc' ) { - shift @ARGV; - query_rc(); - } elsif ( $command eq 'list-groups' ) { - shift @ARGV; - require Gitolite::Conf::Load; - Gitolite::Conf::Load->import; - print "$_\n" for ( @{ list_groups() } ); - } elsif ( $command eq 'list-users' ) { - shift @ARGV; - require Gitolite::Conf::Load; - Gitolite::Conf::Load->import; - print "$_\n" for ( @{ list_users() } ); - } elsif ( $command eq 'list-repos' ) { - shift @ARGV; - require Gitolite::Conf::Load; - Gitolite::Conf::Load->import; - print "$_\n" for ( @{ list_repos() } ); - } elsif ( $command eq 'list-phy-repos' ) { - shift @ARGV; - _chdir( $rc{GL_REPO_BASE} ); - print "$_\n" for ( @{ list_phy_repos() } ); - } elsif ( $command eq 'list-memberships' ) { - shift @ARGV; - require Gitolite::Conf::Load; - Gitolite::Conf::Load->import; - print "$_\n" for ( @{ list_memberships() } ); - } elsif ( $command eq 'list-members' ) { - shift @ARGV; - require Gitolite::Conf::Load; - Gitolite::Conf::Load->import; - print "$_\n" for ( @{ list_members() } ); - } elsif ( $command eq 'post-compile' ) { - shift @ARGV; - post_compile(); - } else { - _die "unknown gitolite sub-command"; - } -} - -=for post-compile +=for post_compile Usage: gitolite post-compile [-l] [post-compile-scriptname] [script args...] -l list currently available post-compile scripts @@ -109,17 +101,26 @@ the gitolite-admin repo). =cut sub post_compile { - usage('', 'post-compile') if (@ARGV and $ARGV[0] eq '-h'); + usage() if ( not @_ or $_[0] eq '-h' ); - if (@ARGV and $ARGV[0] eq '-l') { - _chdir("$ENV{GL_BINDIR}/post-compile"); + run_subdir('post-compile', @_); +} + +sub run_command { + run_subdir('commands', @_); +} + +sub run_subdir { + my $subdir = shift; + if ( @_ and $_[0] eq '-l' ) { + _chdir("$ENV{GL_BINDIR}/$subdir"); map { say2($_) } grep { -x } glob("*"); exit 0; } - my $pgm = shift @ARGV; - my $fullpath = "$ENV{GL_BINDIR}/post-compile/$pgm"; + my $pgm = shift; + my $fullpath = "$ENV{GL_BINDIR}/$subdir/$pgm"; _die "$pgm not found or not executable" if not -x $fullpath; - _system($fullpath, @ARGV); + _system( $fullpath, @_ ); exit 0; } diff --git a/src/gitolite-shell b/src/gitolite-shell index d7f6a19..c291bc9 100755 --- a/src/gitolite-shell +++ b/src/gitolite-shell @@ -13,38 +13,89 @@ use Gitolite::Conf::Load; use strict; use warnings; -print STDERR "TRACE: gsh(", join( ")(", @ARGV ), ")\n"; -print STDERR "TRACE: gsh(SOC=$ENV{SSH_ORIGINAL_COMMAND})\n"; + +# the main() sub expects ssh-ish things; set them up... +if ( exists $ENV{G3T_USER} ) { + in_local(); # file:// masquerading as ssh:// for easy testing +} elsif ( exists $ENV{SSH_CONNECTION} ) { + in_ssh(); +} elsif ( exists $ENV{REQUEST_URI} ) { + in_http(); +} else { + _die "who the *heck* are you?"; +} + +main(); + +exit 0; # ---------------------------------------------------------------------- # XXX lots of stuff from gl-auth-command is missing for now... -# set up the user -my $user = $ENV{GL_USER} = shift; +sub in_local { + print STDERR "TRACE: gsh(", join( ")(", @ARGV ), ")\n"; + print STDERR "TRACE: gsh(SOC=$ENV{SSH_ORIGINAL_COMMAND})\n"; +} -# set up the repo and the attempted access -my ( $verb, $repo ) = split_soc(); -sanity($repo); -$ENV{GL_REPO} = $repo; -my $aa = ( $verb =~ 'upload' ? 'R' : 'W' ); +sub in_http { + _die 'http not yet implemented...'; +} -# a ref of 'any' signifies that this is a pre-git check, where we don't -# yet know the ref that will be eventually pushed (and even that won't apply -# if it's a read operation). See the matching code in access() for more. -my $ret = access( $repo, $user, $aa, 'any' ); -trace( 1, "access($repo, $user, $aa, 'any') -> $ret" ); -_die $ret if $ret =~ /DENIED/; - -$repo = "'$rc{GL_REPO_BASE}/$repo.git'"; -exec( "git", "shell", "-c", "$verb $repo" ); +sub in_ssh { +} # ---------------------------------------------------------------------- -sub split_soc { +# call this once you are sure arg-1 is the username and SSH_ORIGINAL_COMMAND +# has been setup (even if it's not actually coming via ssh). +sub main { + # set up the user + my $user = $ENV{GL_USER} = shift @ARGV; + + # set up the repo and the attempted access + my ( $verb, $repo ) = parse_soc(); # returns only for git commands + sanity($repo); + $ENV{GL_REPO} = $repo; + my $aa = ( $verb =~ 'upload' ? 'R' : 'W' ); + + # a ref of 'any' signifies that this is a pre-git check, where we don't + # yet know the ref that will be eventually pushed (and even that won't + # apply if it's a read operation). See the matching code in access() for + # more information. + my $ret = access( $repo, $user, $aa, 'any' ); + trace( 1, "access($repo, $user, $aa, 'any') -> $ret" ); + _die $ret if $ret =~ /DENIED/; + + $repo = "'$rc{GL_REPO_BASE}/$repo.git'"; + exec( "git", "shell", "-c", "$verb $repo" ); +} + +# ---------------------------------------------------------------------- + +sub parse_soc { my $soc = $ENV{SSH_ORIGINAL_COMMAND}; - return ( $1, $2 ) if $soc =~ m(^(git-(?:upload|receive)-pack) '/?(.*?)(?:\.git)?'$); - _die "unknown command: $soc"; + $soc ||= 'info'; + + if ( $soc =~ m(^(git-(?:upload|receive)-pack) '/?(.*?)(?:\.git)?'$) ) { + # TODO git archive + my($verb, $repo) = ($1, $2); + _die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT; + return ($verb, $repo); + } + + # after this we should not return; caller expects us to handle it all here + # and exit out + + _die "suspicious characters loitering about '$soc'" if $soc !~ $REMOTE_COMMAND_PATT; + + my @words = split ' ', $soc; + if ($rc{COMMANDS}{$words[0]}) { + _system("gitolite", @words); + exit 0; + } + + _die "unknown git/gitolite command: $soc"; } sub sanity { diff --git a/src/post-compile/ssh-authkeys b/src/post-compile/ssh-authkeys index c45e388..5e5ad4b 100755 --- a/src/post-compile/ssh-authkeys +++ b/src/post-compile/ssh-authkeys @@ -89,7 +89,7 @@ sub fp { return map { fp_line($_) } grep { !/^#/ and /\S/ } slurp($in); } else { # one or more actual keys - return map { fp_line($_) } grep { !/^#/ and /\S/ } ($in, @_); + return map { fp_line($_) } grep { !/^#/ and /\S/ } ( $in, @_ ); } } diff --git a/src/syntactic-sugar/continuation-lines b/src/syntactic-sugar/continuation-lines index 1d25379..3c28f20 100755 --- a/src/syntactic-sugar/continuation-lines +++ b/src/syntactic-sugar/continuation-lines @@ -18,10 +18,10 @@ sub sugar_script { my $lines = shift; - my @out = (); + my @out = (); my $keep = ''; for my $l (@$lines) { - if ($l =~ s/\\$//) { + if ( $l =~ s/\\$// ) { $keep .= $l; } else { $l = $keep . $l if $keep; diff --git a/t/glt b/t/glt index 45e7b19..09d4429 100755 --- a/t/glt +++ b/t/glt @@ -12,7 +12,10 @@ my $user = shift or die "need user"; my $rc; $ENV{G3T_USER} = $user; -if ( $cmd eq 'push' ) { +if ($cmd eq 'info' ) { + $ENV{SSH_ORIGINAL_COMMAND} = $cmd; + exec( "$ENV{GL_BINDIR}/../src/gitolite-shell", $user ); +} elsif ( $cmd eq 'push' ) { $rc = system( "git", $cmd, "--receive-pack=$ENV{GL_BINDIR}/gitolite-receive-pack", @ARGV ); } else { $rc = system( "git", $cmd, "--upload-pack=$ENV{GL_BINDIR}/gitolite-upload-pack", @ARGV );