238 lines
7.8 KiB
Perl
Executable file
238 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 );
|
|
gl_log( 'create', $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.
|
|
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;
|
|
$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";
|
|
}
|