gitolite/src/gl-auth-command

#!/usr/bin/perl

# ----------------------------------------------------------------------------
# ssh mode
# - started by sshd
# - one optional flag, "-s", for "shell allowed" people
# - one argument, the "user" name
# - one env var, SSH_ORIGINAL_COMMAND, containing the command
# - command typically: git-(receive|upload)-pack 'reponame(.git)?'
# - special gitolite commands: info, expand, (get|set)(perms|desc)
# - other commands: anything in $GL_ADC_PATH if defined (see rc file)
#
# (smart) http mode
# - started by apache (httpd)
# - no arguments
# - REQUEST_URI contains verb and repo, REMOTE_USER contains username
# - REQUEST_URI looks like /path/reponame.git/(info/refs\?service=)?git-(receive|upload)-pack
# - no special processing commands currently handled
# ----------------------------------------------------------------------------

use strict;
use warnings;

# ----------------------------------------------------------------------------
#       find the rc file, then pull the libraries in
# ----------------------------------------------------------------------------

# this (gl-auth-command) is one of the two valid starting points for all of
# gitolite for normal operations (the other being gl-time).  All other
# programs are invoked either from this, or from something else (typically
# git-*-pack) in between).  They thus get the benefit of the environment
# variables that this code sets up.
BEGIN {
    # find and set bin dir
    $0 =~ m|^(/)?(.*)/| and $ENV{GL_BINDIR} = ($1 || "$ENV{PWD}/") . $2;
}

# our libraries are either in the same place the scripts are, or, as with
# RPM/DEB install, in some 'system' location that is already in perl's @INC
# anyway
use lib $ENV{GL_BINDIR};

use gitolite_rc;    # this does a "do" of the rc file
use gitolite_env;
use gitolite;

# ----------------------------------------------------------------------------
#       start...
# ----------------------------------------------------------------------------

# these two options are mutually exclusive.  And this program is not supposed
# to be called manually anyway
my $shell_allowed = (@ARGV and $ARGV[0] eq '-s' and shift);
my $program       = (@ARGV and $ARGV[0] eq '-e' and shift);

# setup the environment for the kids so they don't need to embark on the
# voyage of self-discovery above ;-)  [environment also means things like
# nice, umask, etc., not just the environment *variables*]
setup_environment();

# if one of the other programs is being invoked (see doc/hacking.mkd), exec it
exec(@ARGV) if $program;

# ----------------------------------------------------------------------------
#       set up GL_USER and (if reqd) SSH_ORIGINAL_COMMAND and SSH_CONNECTION
# ----------------------------------------------------------------------------

my $user;
if ($ENV{REQUEST_URI}) {
    die "fallback to DAV not supported\n" 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).
    simulate_ssh_connection();

    $ENV{REMOTE_USER} ||= $GL_HTTP_ANON_USER;   # see doc/http-backend.mkd
    $user = $ENV{GL_USER} = $ENV{REMOTE_USER};
} else {
    # no (more) arguments given in ssh mode?  default user is $USER
    # (fedorahosted works like this, and it is harmless for others)
    @ARGV = ($ENV{USER}) unless @ARGV;
    $user = $ENV{GL_USER} = shift;
}

# ----------------------------------------------------------------------------
#       SSH_ORIGINAL_COMMAND
# ----------------------------------------------------------------------------

# no SSH_ORIGINAL_COMMAND given: shell out or default to 'info'
unless ($ENV{SSH_ORIGINAL_COMMAND}) {
    shell_out() if $shell_allowed;  # doesn't return ('exec's out)
    $ENV{SSH_ORIGINAL_COMMAND} = 'info';
}

# quick sanity check for newlines; could be used to create fake log entries.
# Not an access violation but possibly an audit/compliance reporting violation
die "I don't like newlines in the command: $ENV{SSH_ORIGINAL_COMMAND}\n" if $ENV{SSH_ORIGINAL_COMMAND} =~ /[\n\r]/;

# admin defined commands; please see doc/admin-defined-commands.mkd
if ($GL_ADC_PATH and -d $GL_ADC_PATH) {
    try_adc();  # if it succeeds, this also 'exec's out
}

# get/set perms/desc for wild repos; also the 'expand' command
my $CUSTOM_COMMANDS=qr/^\s*(expand|(get|set)(perms|desc))\b/;
# note that all the subs called here chdir somewhere else and do not come
# back; they all blithely take advantage of the fact that processing custom
# commands is sort of a dead end for normal (git) processing
if ($ENV{SSH_ORIGINAL_COMMAND} =~ $CUSTOM_COMMANDS) {
    die "wildrepos disabled, sorry\n" unless $GL_WILDREPOS;
    run_custom_command($user);
    exit 0;
}

# non-git commands: if the command does NOT fit the pattern of a normal git
# command, send it off somewhere else...

# side notes on detecting a normal git command: the pattern we check allows
# old style as well as new style ("git-subcommand arg" or "git subcommand
# arg").  Currently, this is how git sends across the command (including the
# single quotes):
#       git-receive-pack 'reponame.git'

my ($verb, $repo) = ($ENV{SSH_ORIGINAL_COMMAND} =~ /^\s*(git\s+\S+|\S+)\s+'\/?(.*?)(?:\.git)?'/);
unless ( $verb and ( $verb eq 'git-init' or $verb =~ $R_COMMANDS or $verb =~ $W_COMMANDS ) and $repo and $repo =~ $REPONAME_PATT ) {
    special_cmd ($shell_allowed);
    exit 0;
}

# some final sanity checks
die "$repo ends with a slash; I don't like that\n" if $repo =~ /\/$/;
die "$repo has two consecutive periods; I don't like that\n" if $repo =~ /\.\./;

# save the reponame; too many things need this
$ENV{GL_REPO}=$repo;

# ----------------------------------------------------------------------------
#       the real git commands (git-receive-pack, etc...)
# ----------------------------------------------------------------------------

# we know the user and repo; we just need to know what perm he's trying for
# (aa == attempted access; setting this makes some later logic simpler)
my $aa = ($verb =~ $R_COMMANDS ? 'R' : 'W');

# writes may get redirected under certain conditions
if ( $aa eq 'W' and mirror_mode($repo) =~ /^slave of (\S+)/ ) {
    my $master = $1;
    die "$ABRT GL_HOSTNAME not set; rejecting push to non-local repo\n" unless $GL_HOSTNAME;
    die "$ABRT $GL_HOSTNAME not the master, please push to $master\n" unless mirror_redirectOK($repo, $GL_HOSTNAME);
    print STDERR "$GL_HOSTNAME ==== $user ($repo) ===> $master\n";
    exec("ssh", $master, "USER=$user", "SOC=$ENV{SSH_ORIGINAL_COMMAND}");
}

# first level permissions check

my ($perm, $creator, $wild);
if ( $GL_ALL_READ_ALL and $verb =~ $R_COMMANDS and -d "$REPO_BASE/$repo.git") {
    $perm = 'R';
} else {
    ($perm, $creator, $wild) = repo_rights($repo);
}
# it was missing, and you have create perms, so create it
new_wild_repo($repo, $user) if ($perm =~ /C/);

die "$aa access for $repo DENIED to $user
(Or there may be no repository at the given path. Did you spell it correctly?)\n" unless $perm =~ /$aa/;

# check if repo is write-enabled
check_repo_write_enabled($repo) if $aa eq 'W';

# run the pre-git hook if present (do this last, just before actually handing
# off to git).  Force its output to go to STDERR so the git client does not
# get confused, in case the code in the pre-git hook forgot.  To make it
# simple for the script, send in $aa (which will be 'R' or 'W') so now they
# have all three: GL_USER and GL_REPO in the env, and $aa as arg-1.
if (-x "$REPO_BASE/$repo.git/hooks/gl-pre-git") {
    system("cd $REPO_BASE/$repo.git; hooks/gl-pre-git $aa >&2");
    die "gl-pre-git hook failed ($?)\n" if $?;
}

# ----------------------------------------------------------------------------
#       over to git now
# ----------------------------------------------------------------------------

if ($ENV{REQUEST_URI}) {
    log_it($ENV{REQUEST_URI});
    exec $ENV{GIT_HTTP_BACKEND};
    # the GIT_HTTP_BACKEND env var should be set either by the rc file, or as
    # a SetEnv in the apache config somewhere
}

log_it();

$repo = "'$REPO_BASE/$repo.git'";
exec("git", "shell", "-c", "$verb $repo") unless $verb eq 'git-init';