git-daemon/git-daemon.pl

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