gitolite/src/gitolite-shell
Sitaram Chamarty f636ce3ba3 (security) fix bug in pattern to detect path traversal
while we're about it, add the same check to some of the internal
routines, so that commands can also be protected.

finally, just to make sure we don't lose it again in some other fashion,
add a few tests for path traversal...
2012-10-05 12:28:20 +05:30

239 lines
7.8 KiB
Perl
Executable file

#!/usr/bin/perl
# gitolite shell, invoked from ~/.ssh/authorized_keys
# ----------------------------------------------------------------------
use FindBin;
BEGIN { $ENV{GL_BINDIR} = $FindBin::RealBin; }
BEGIN { $ENV{GL_LIBDIR} = "$ENV{GL_BINDIR}/lib"; }
use lib $ENV{GL_LIBDIR};
# set HOME
BEGIN { $ENV{HOME} = $ENV{GITOLITE_HTTP_HOME} if $ENV{GITOLITE_HTTP_HOME}; }
use Gitolite::Rc;
use Gitolite::Common;
use Gitolite::Conf::Load;
use strict;
use warnings;
# the main() sub expects ssh-ish things; set them up...
my $id = '';
if ( exists $ENV{G3T_USER} ) {
$id = in_file(); # file:// masquerading as ssh:// for easy testing
} elsif ( exists $ENV{SSH_CONNECTION} ) {
$id = in_ssh();
} elsif ( exists $ENV{REQUEST_URI} ) {
$id = in_http();
} else {
_die "who the *heck* are you?";
}
# sanity...
my $soc = $ENV{SSH_ORIGINAL_COMMAND};
$soc =~ s/[\n\r]+/<<newline>>/g;
_die "I don't like newlines in the command: '$soc'\n" if $ENV{SSH_ORIGINAL_COMMAND} ne $soc;
# the INPUT trigger massages @ARGV and $ENV{SSH_ORIGINAL_COMMAND} as needed
trigger('INPUT');
main($id);
gl_log('END') if $$ == $ENV{GL_TID};
exit 0;
# ----------------------------------------------------------------------
sub in_file {
gl_log( 'file', "ARGV=" . join( ",", @ARGV ), "SOC=$ENV{SSH_ORIGINAL_COMMAND}" );
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";
}
return 'file';
}
sub in_http {
http_setup_die_handler();
_die "GITOLITE_HTTP_HOME not set" unless $ENV{GITOLITE_HTTP_HOME};
_die "fallback to DAV not supported" if $ENV{REQUEST_METHOD} eq 'PROPFIND';
# fake out SSH_ORIGINAL_COMMAND and SSH_CONNECTION when called via http,
# so the rest of the code stays the same (except the exec at the end).
http_simulate_ssh_connection();
$ENV{REMOTE_USER} ||= $rc{HTTP_ANON_USER};
@ARGV = ( $ENV{REMOTE_USER} );
return 'http';
}
sub in_ssh {
my $ip;
( $ip = $ENV{SSH_CONNECTION} || '(no-IP)' ) =~ s/ .*//;
gl_log( 'ssh', "ARGV=" . join( ",", @ARGV ), "SOC=" . ( $ENV{SSH_ORIGINAL_COMMAND} || '' ), "FROM=$ip" );
$ENV{SSH_ORIGINAL_COMMAND} ||= '';
return $ip;
}
# ----------------------------------------------------------------------
# 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 {
my $id = shift;
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, $aa );
gl_log( 'create', $repo, $user, $aa );
}
# 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.
unless ( $ENV{GL_BYPASS_ACCESS_CHECKS} ) {
my $ret = access( $repo, $user, $aa, 'any' );
trace( 1, "access($repo, $user, $aa, 'any')", "-> $ret" );
trigger( 'ACCESS_1', $repo, $user, $aa, 'any', $ret );
_die $ret . "\n(or you mis-spelled the reponame)" if $ret =~ /DENIED/;
gl_log( "pre_git", $repo, $user, $aa, 'any', "-> $ret" );
}
trigger( 'PRE_GIT', $repo, $user, $aa, 'any', $verb );
if ($ENV{REQUEST_URI}) {
_system( "git", "http-backend" );
} else {
my $repodir = "'$rc{GL_REPO_BASE}/$repo.git'";
_system( "git", "shell", "-c", "$verb $repodir" );
}
trigger( 'POST_GIT', $repo, $user, $aa, 'any', $verb );
}
# ----------------------------------------------------------------------
sub parse_soc {
my $soc = $ENV{SSH_ORIGINAL_COMMAND};
$soc ||= 'info';
my $git_commands = "git-upload-pack|git-receive-pack|git-upload-archive";
if ( $soc =~ m(^($git_commands) '/?(.*?)(?:\.git(\d)?)?'$) ) {
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(\.\.);
}
# ----------------------------------------------------------------------
# helper functions for "in_http"
sub http_setup_die_handler {
$SIG{__DIE__} = sub {
my $service = ( $ENV{SSH_ORIGINAL_COMMAND} =~ /git-receive-pack/ ? 'git-receive-pack' : 'git-upload-pack' );
my $message = shift; chomp($message);
print STDERR "$message\n";
# format the service response, then the message. With initial
# help from Ilari and then a more detailed email from Shawn...
$service = "# service=$service\n"; $message = "ERR $message\n";
$service = sprintf( "%04X", length($service) + 4 ) . "$service"; # no CRLF on this one
$message = sprintf( "%04X", length($message) + 4 ) . "$message";
http_print_headers();
print $service;
print "0000"; # flush-pkt, apparently
print $message;
print STDERR $service;
print STDERR $message;
exit 0; # if it's ok for die_webcgi in git.git/http-backend.c, it's ok for me ;-)
}
}
sub http_simulate_ssh_connection {
# these patterns indicate normal git usage; see "services[]" in
# http-backend.c for how I got that. Also note that "info" is overloaded;
# git uses "info/refs...", while gitolite uses "info" or "info?...". So
# there's a "/" after info in the list below
if ( $ENV{PATH_INFO} =~ m(^/(.*)/(HEAD$|info/refs$|objects/|git-(?:upload|receive)-pack$)) ) {
my $repo = $1;
my $verb = ( $ENV{REQUEST_URI} =~ /git-receive-pack/ ) ? 'git-receive-pack' : 'git-upload-pack';
$ENV{SSH_ORIGINAL_COMMAND} = "$verb '$repo'";
} else {
# this is one of our custom commands; could be anything really,
# because of the adc feature
my ($verb) = ( $ENV{PATH_INFO} =~ m(^/(\S+)) );
my $args = $ENV{QUERY_STRING};
$args =~ s/\+/ /g;
$args =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
$ENV{SSH_ORIGINAL_COMMAND} = $verb;
$ENV{SSH_ORIGINAL_COMMAND} .= " $args" if $args;
http_print_headers(); # in preparation for the eventual output!
}
$ENV{SSH_CONNECTION} = "$ENV{REMOTE_ADDR} $ENV{REMOTE_PORT} $ENV{SERVER_ADDR} $ENV{SERVER_PORT}";
}
my $http_headers_printed = 0;
sub http_print_headers {
my ( $code, $text ) = @_;
return if $http_headers_printed++;
$code ||= 200;
$text ||= "OK - gitolite";
$|++;
print "Status: $code $text\r\n";
print "Expires: Fri, 01 Jan 1980 00:00:00 GMT\r\n";
print "Pragma: no-cache\r\n";
print "Cache-Control: no-cache, max-age=0, must-revalidate\r\n";
print "\r\n";
}