'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
This commit is contained in:
Sitaram Chamarty
parent
0aeb0cd5e2
commit
7f8020adc5
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
@ -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.,
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ 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");
|
||||
|
|
|
|||
|
|
@ -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 = '';
|
||||
|
||||
|
|
@ -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();
|
||||
|
||||
|
|
|
|||
|
|
@ -207,8 +207,7 @@ sub store {
|
|||
}
|
||||
|
||||
sub parse_done {
|
||||
for my $ig (sort keys %ignored)
|
||||
{
|
||||
for my $ig ( sort keys %ignored ) {
|
||||
_warn "$ig.conf attempting to set access for " . join( ", ", sort keys %{ $ignored{$ig} } );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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,23 +101,6 @@ 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;
|
||||
|
|
@ -134,14 +117,34 @@ sub query_rc {
|
|||
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. 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,
|
||||
},
|
||||
);
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ) {
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/bin/bash
|
||||
# TODO: convert to perl!
|
||||
|
||||
# gitolite VREF to count number of changed/new files in a push
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#!/bin/bash
|
||||
# TODO: convert to perl!
|
||||
|
||||
# gitolite VREF to find autogenerated files
|
||||
|
||||
|
|
|
|||
31
src/commands/info
Executable file
31
src/commands/info
Executable file
|
|
@ -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/;
|
||||
}
|
||||
105
src/gitolite
105
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();
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
sub args {
|
||||
my ( $command, @args ) = @ARGV;
|
||||
usage() if not $command or $command eq '-h';
|
||||
# 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 '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() } );
|
||||
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' ) {
|
||||
shift @ARGV;
|
||||
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';
|
||||
}
|
||||
|
||||
=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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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...
|
||||
|
||||
sub in_local {
|
||||
print STDERR "TRACE: gsh(", join( ")(", @ARGV ), ")\n";
|
||||
print STDERR "TRACE: gsh(SOC=$ENV{SSH_ORIGINAL_COMMAND})\n";
|
||||
}
|
||||
|
||||
sub in_http {
|
||||
_die 'http not yet implemented...';
|
||||
}
|
||||
|
||||
sub in_ssh {
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
# 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;
|
||||
my $user = $ENV{GL_USER} = shift @ARGV;
|
||||
|
||||
# set up the repo and the attempted access
|
||||
my ( $verb, $repo ) = split_soc();
|
||||
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.
|
||||
# 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 split_soc {
|
||||
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 {
|
||||
|
|
|
|||
5
t/glt
5
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 );
|
||||
|
|
|
|||
Loading…
Reference in a new issue