gitolite/src/gitolite-shell
Sitaram Chamarty 24b36f11c5 (perltidy)
2012-03-24 10:30:44 +05:30

127 lines
3.8 KiB
Perl
Executable file

#!/usr/bin/perl
# gitolite shell, invoked from ~/.ssh/authorized_keys
# ----------------------------------------------------------------------
use FindBin;
BEGIN { $ENV{GL_BINDIR} = $FindBin::RealBin; }
use lib $ENV{GL_BINDIR};
use Gitolite::Rc;
use Gitolite::Common;
use Gitolite::Conf::Load;
use strict;
use warnings;
# 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 {
if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /git-\w+-pack/ ) {
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 {
gl_log( 'gitolite-shell', @ARGV, $ENV{SSH_ORIGINAL_COMMAND} );
umask $rc{UMASK};
# 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' );
# auto-create?
if ( repo_missing($repo) and access( $repo, $user, '^C', 'any' ) !~ /DENIED/ ) {
require Gitolite::Conf::Store;
Gitolite::Conf::Store->import;
new_wild_repo( $repo, $user );
gl_log( 'gitolite-shell:new_wild_repo', $repo, $user );
}
# 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" );
gl_log( 'gitolite-shell:check', $repo, $user, $aa, 'any', '->', $ret );
trigger( 'ACCESS_CHECK', $repo, $user, $aa, 'any', $ret );
_die $ret if $ret =~ /DENIED/;
$repo = "'$rc{GL_REPO_BASE}/$repo.git'";
trigger( 'PRE_GIT', $repo, $user, $aa, 'any', $verb );
_system( "git", "shell", "-c", "$verb $repo" );
trigger( 'POST_GIT', $repo, $user, $aa, 'any', $verb );
}
# ----------------------------------------------------------------------
sub parse_soc {
my $soc = $ENV{SSH_ORIGINAL_COMMAND};
$soc ||= 'info';
if ( $soc =~ m(^(git-(?:upload|receive)-pack) '/?(.*?)(?:\.git(\d)?)?'$) ) {
# TODO git archive
my ( $verb, $repo, $trace_level ) = ( $1, $2, $3 );
$ENV{D} = $trace_level if $trace_level;
_die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT;
trace( 2, "git command", $soc );
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] } ) {
trace( 2, "gitolite command", $soc );
_system( "gitolite", @words );
exit 0;
}
_die "unknown git/gitolite command: $soc";
}
sub sanity {
my $repo = shift;
_die "'$repo' contains bad characters" if $repo !~ $REPONAME_PATT;
_die "'$repo' ends with a '/'" if $repo =~ m(/$);
_die "'$repo' contains '..'" if $repo =~ m(\.\.$);
}