git-daemon: simplify xread()

[userv-utils] / git-daemon / git-daemon.pl

#!/usr/bin/perl
#
# A git daemon with an added userv security boundary.
#
# This reads the first packet-line of the protocol, checks the syntax
# of the pathname and hostname, then uses userv to invoke the
# git-upload-pack as the target user with safe arguments.
#
# This was written by Tony Finch <dot@dotat.at>
# You may do anything with it, at your own risk.
# http://creativecommons.org/publicdomain/zero/1.0/

use strict;
use warnings;

use POSIX;
use Socket;
use Sys::Syslog;

use vars qw{ %vhost_default_user %vhost_user_from_tilde
             $TILDE $REPO $HOSTNAME };

use lib '/etc/userv';
require 'git-daemon-vhosts.pl';

my $peer = getpeername STDIN;
my ($port,$addr);
if (defined $peer) {
    ($port,$addr) = sockaddr_in $peer;
    $addr = inet_ntoa $addr;
    $peer = "[$addr]:$port";
} else {
    $peer = "[?.?.?.?]:?";
    undef $!;
}

openlog 'userv-git-daemon', 'pid', 'daemon';

sub fail {
    syslog 'err', "$peer @_";
    exit;
}

sub xread {
    my $length = shift;
    my $buffer = "";
    # simply die if the client takes too long
    alarm 30;
    while ($length > length $buffer) {
        my $ret = sysread STDIN, $buffer, $length, length $buffer;
        fail "short read: expected $length bytes, got " . length $buffer
                            if defined $ret and $ret == 0;
        fail "read: $!" if not defined $ret and $! != EINTR and $! != EAGAIN;
        $ret = 0        if not defined $ret;
    }
    alarm 0;
    return $buffer;
}

my $len_hex = xread 4;
fail "non-hexadecimal packet length" unless $len_hex =~ m{^[0-9a-zA-Z]{4}$};
my $len = hex $len_hex;

my $line = xread $len;
unless ($line =~ m{^git-upload-pack (?:~($TILDE)/)?($REPO[.]git)\0host=($HOSTNAME)\0$}) {
    $line =~ s/[^ -~]+/ /g;
    fail "could not parse \"$line\""
}
my ($tilde,$repo,$host) = ($1,$2,$3);
my $url = $tilde ? "git://$host/~$tilde/$repo" : "git://$host/$repo";

my $user = $vhost_user_from_tilde{$host} ? $tilde : $vhost_default_user{$host};
fail "no user configuration for $url" unless defined $user;

syslog 'info', "$peer $user $url";

my @opts = ("-DCLIENT=$addr", "-DHOST=$host", "-DREPO=$repo");
push @opts, "-DTILDE=$tilde" if defined $tilde;

exec 'userv', @opts, $user, 'git-upload-pack'
    or fail "exec userv: $!";

# end