gitolite/src/gl-auth-command

#!/usr/bin/perl

use strict;
use warnings;

# ----------------------------------------------------------------------------
# you:  what's the invocation?
# me:   Hail, O Lord Ganesha, destroyer of obsta...
# you:  err hmm not *that* sort of invocation... I meant how does this program
#       get invoked?
# me:   oh hehe <hides sheepish grin>, ok here we go...
#
# ssh mode
# - started by sshd
# - 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)
# - special non-gitolite commands: rsync, svnserve, htpasswd
# - 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
# ----------------------------------------------------------------------------

# ----------------------------------------------------------------------------
#       common definitions
# ----------------------------------------------------------------------------

# these are set by the "rc" file
our ($GL_LOGT, $GL_CONF_COMPILED, $REPO_BASE, $GIT_PATH, $REPO_UMASK, $GL_ADMINDIR, $RSYNC_BASE, $HTPASSWD_FILE, $GL_WILDREPOS, $GL_WILDREPOS_DEFPERMS, $GL_ADC_PATH, $SVNSERVE, $PROJECTS_LIST, $GL_SLAVE_MODE, $GL_PERFLOGT);
# and these are set by gitolite.pm
our ($R_COMMANDS, $W_COMMANDS, $REPONAME_PATT, $REPOPATT_PATT, $ADC_CMD_ARGS_PATT);
our %repos;
our %groups;
our %repo_config;

# the common setup module is in the same directory as this running program is
my $bindir = $0;
$bindir =~ s/\/[^\/]+$//;
$bindir = "$ENV{PWD}/$bindir" unless $bindir =~ /^\//;
unshift @INC, $bindir;
require gitolite or die "parse gitolite.pm failed\n";

# ask where the rc file is, get it, and "do" it
&where_is_rc();
die "parse $ENV{GL_RC} failed: "       . ($! or $@) unless do $ENV{GL_RC};

# we need to pass GL_ADMINDIR and the bindir to the child hooks
$ENV{GL_ADMINDIR} = $GL_ADMINDIR;
$ENV{GL_BINDIR} = $bindir;

# add a custom path for git binaries, if specified
$ENV{PATH} .= ":$GIT_PATH" if $GIT_PATH;

# set default permission of wildcard repositories
$ENV{GL_WILDREPOS_DEFPERMS} = $GL_WILDREPOS_DEFPERMS if $GL_WILDREPOS_DEFPERMS;

# set the umask before creating any files
umask($REPO_UMASK);

$ENV{GL_REPO_BASE_ABS} = ( $REPO_BASE =~ m(^/) ? $REPO_BASE : "$ENV{HOME}/$REPO_BASE" );

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

# if the first argument is a "-s", this user is allowed to get a shell using
# this key
my $shell_allowed = 0;
if (@ARGV and $ARGV[0] eq '-s') {
    $shell_allowed = 1;
    shift;
}

# ----------------------------------------------------------------------------
#       set up SSH_ORIGINAL_COMMAND and SSH_CONNECTION in http mode
# ----------------------------------------------------------------------------

# fake out SSH_ORIGINAL_COMMAND and SSH_CONNECTION so the rest of the code
# stays the same (except the exec at the end).

my $user;
if ($ENV{REQUEST_URI}) {
    die "fallback to DAV not supported\n" if $ENV{REQUEST_METHOD} eq 'PROPFIND';

    # 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;
        &print_http_headers();  # in preparation for the eventual output!
    }
    $ENV{SSH_CONNECTION} = "$ENV{REMOTE_ADDR} $ENV{REMOTE_PORT} $ENV{SERVER_ADDR} $ENV{SERVER_PORT}";
    $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;
}

# ----------------------------------------------------------------------------
#       logging, timestamp env vars
# ----------------------------------------------------------------------------

$ENV{GL_LOG} = &get_logfilename($GL_LOGT);

# ----------------------------------------------------------------------------
#       sanity checks on SSH_ORIGINAL_COMMAND
# ----------------------------------------------------------------------------

# no SSH_ORIGINAL_COMMAND given...
unless ($ENV{SSH_ORIGINAL_COMMAND}) {
    # if the user is allowed to use a shell, give him one
    if ($shell_allowed) {
        my $shell = $ENV{SHELL};
        $shell =~ s/.*\//-/;    # change "/bin/bash" to "-bash"
        &log_it($shell);
        exec { $ENV{SHELL} } $shell;
    }
    # otherwise, pretend he typed in "info" and carry on...
    $ENV{SSH_ORIGINAL_COMMAND} = 'info';
}

# ----------------------------------------------------------------------------
#       slave mode should not do much
# ----------------------------------------------------------------------------

die "server is in slave mode; you can only fetch\n"
    if ($GL_SLAVE_MODE and $ENV{SSH_ORIGINAL_COMMAND} !~ /^(info|expand|get|git-upload-)/);

# ----------------------------------------------------------------------------
#       admin defined commands
# ----------------------------------------------------------------------------

# please see doc/admin-defined-commands.mkd for details
if ($GL_ADC_PATH and -d $GL_ADC_PATH) {
    my ($cmd, @args) = split ' ', $ENV{SSH_ORIGINAL_COMMAND};
    if (-x "$GL_ADC_PATH/$cmd") {
        # yes this is rather strict, sorry.
        do { die "I don't like $_\n" unless $_ =~ $ADC_CMD_ARGS_PATT } for ($cmd, @args);
        &log_it("$GL_ADC_PATH/$ENV{SSH_ORIGINAL_COMMAND}");
        exec("$GL_ADC_PATH/$cmd", @args);
    }
}

# ----------------------------------------------------------------------------
#       get and set perms for actual repo created by wildcard-autoviv
# ----------------------------------------------------------------------------

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;
    my $cmd = $ENV{SSH_ORIGINAL_COMMAND};
    my ($verb, $repo) = ($cmd =~ /^\s*(\S+)(?:\s+'?\/?(.*?)(?:\.git)?'?)?$/);
    # deal with "no argument" cases
    $verb eq 'expand' ? $repo = '^' : die "$verb needs an argument\n" unless $repo;
    if ($repo =~ $REPONAME_PATT and $verb =~ /getperms|setperms/) {
        # with an actual reponame, you can "getperms" or "setperms"
        get_set_perms($repo, $verb, $user);
    }
    elsif ($repo =~ $REPONAME_PATT and $verb =~ /(get|set)desc/) {
        # with an actual reponame, you can "getdesc" or "setdesc"
        get_set_desc($repo, $verb, $user);
    }
    elsif ($verb eq 'expand') {
        # with a wildcard, you can "expand" it to see what repos actually match
        die "$repo has invalid characters" unless "x$repo" =~ $REPOPATT_PATT;
        expand_wild($GL_ADMINDIR, $GL_CONF_COMPILED, $repo, $user);
    } else {
        die "$cmd doesn't make sense to me\n";
    }
    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 ) {
    # ok, it's not a normal git command; call the special command helper
    &special_cmd ($GL_ADMINDIR, $GL_CONF_COMPILED, $shell_allowed, $RSYNC_BASE, $HTPASSWD_FILE, $SVNSERVE);
    exit;
}
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 =~ /\.\./;

# reponame
$ENV{GL_REPO}=$repo;

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

# ----------------------------------------------------------------------------
#       first level permissions check
# ----------------------------------------------------------------------------

my ($perm, $creator, $wild) = &repo_rights($repo);
if ($perm =~ /C/) {
    # it was missing, and you have create perms
    wrap_chdir("$ENV{GL_REPO_BASE_ABS}");
    new_repo($repo, "$GL_ADMINDIR/hooks/common", $user);
        # note pwd is now the bare "repo.git"; new_repo does that...
    wrap_print("gl-perms", "$GL_WILDREPOS_DEFPERMS\n") if $GL_WILDREPOS_DEFPERMS;
    &setup_repo_configs($repo, \%repo_config);
    &setup_daemon_access($repo);
    &add_del_line ("$repo.git", $PROJECTS_LIST, &setup_gitweb_access($repo, '', ''));
    wrap_chdir($ENV{HOME});
}

# we know the user and repo; we just need to know what perm he's trying
# aa == attempted access
my $aa = ($verb =~ $R_COMMANDS ? 'R' : 'W');
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/;

# ----------------------------------------------------------------------------
#       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';