git-daemon/git-daemon.pl

   1 #!/usr/bin/perl
   2 #
   3 # A git daemon with an added userv security boundary.
   4 #
   5 # This reads the first packet-line of the protocol, checks the syntax
   6 # of the pathname and hostname, then uses userv to invoke the
   7 # git-upload-pack as the target user with safe arguments.
   8 #
   9 # This was written by Tony Finch <dot@dotat.at>
  10 # You may do anything with it, at your own risk.
  11 # http://creativecommons.org/publicdomain/zero/1.0/
  12
  13 use strict;
  14 use warnings;
  15
  16 use POSIX;
  17 use Socket;
  18 use Sys::Syslog;
  19
  20 use lib '/etc/userv';
  21
  22 sub ntoa {
  23     my $sockaddr = shift;
  24     if (defined $sockaddr) {
  25         my ($port,$addr) = sockaddr_in $sockaddr;
  26         $addr = inet_ntoa $addr;
  27         return ($addr,$port,"[$addr]:$port");
  28     } else {
  29         return (undef,undef,"[?.?.?.?]:?");
  30     }
  31 }
  32
  33 my ($client_addr,$client_port,$client) = ntoa getpeername STDIN;
  34 my ($server_addr,$server_port,$server) = ntoa getsockname STDIN;
  35
  36 openlog 'userv-git-daemon', 'pid', 'daemon';
  37
  38 sub fail {
  39     syslog 'err', "$client @_";
  40     exit;
  41 }
  42
  43 sub xread {
  44     my $length = shift;
  45     my $buffer = "";
  46     local $SIG{ALRM} = sub { fail "timeout" };
  47     alarm 30;
  48     while ($length > length $buffer) {
  49         my $ret = sysread STDIN, $buffer, $length, length $buffer;
  50         fail "short read: expected $length bytes, got " . length $buffer
  51                             if defined $ret and $ret == 0;
  52         fail "read: $!" if not defined $ret and $! != EINTR and $! != EAGAIN;
  53         $ret = 0        if not defined $ret;
  54     }
  55     alarm 0;
  56     return $buffer;
  57 }
  58
  59 my $len_hex = xread 4;
  60 fail "non-hex packet length" unless $len_hex =~ m{^[0-9a-fA-F]{4}$};
  61 my $line = xread hex $len_hex;
  62 unless ($line =~ m{^git-upload-pack ([!-~]+)\0host=([!-~]+)\0$}) {
  63     $line =~ s/[^ -~]+/ /g;
  64     fail "could not parse \"$line\""
  65 }
  66 my ($path,$host) = ($1,$2);
  67 $path =~ s|^/||;
  68 $_ = my $uri = "git://$host/$path";
  69
  70 my ($user,$repo) = do "git-daemon-urlmap.pl";
  71 fail "no user configured for $uri" unless defined $user;
  72 syslog 'info', "$client userv $user git-upload-pack $uri";
  73
  74 my %vars = (
  75     REQUEST_HOST => $host,
  76     REQUEST_PATH => $path,
  77     REQUEST_URI => $uri,
  78     CLIENT_ADDR => $client_addr,
  79     CLIENT_PORT => $client_port,
  80     SERVER_ADDR => $server_addr,
  81     SERVER_PORT => $server_port,
  82 );
  83 my @opts = map "-D$_=$vars{$_}", grep defined $vars{$_}, sort keys %vars;
  84
  85 no warnings; # suppress errors to stderr
  86 exec 'userv', @opts, $user, 'git-upload-pack'
  87     or fail "exec userv @opts $user git-upload-pack: $!";
  88
  89 # end