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     return ('[?.?.?.?]:?') unless defined $sockaddr;
  19     my ($port,$addr) = sockaddr_in $sockaddr;
  20     $addr = inet_ntoa $addr;
  21     return ("[$addr]:$port",$addr,$port);
  22 }
  23 {
  24     package cf;
  25     our ($client,$client_addr,$client_port) = ::ntoa(getpeername(STDIN));
  26     our ($server,$server_addr,$server_port) = ::ntoa(getsockname(STDIN));
  27 }
  28
  29 openlog 'userv-git-daemon', 'pid', 'daemon';
  30
  31 sub fail {
  32     syslog 'err', "$cf::client @_";
  33     exit;
  34 }
  35
  36 sub xread {
  37     my $length = shift;
  38     my $buffer = "";
  39     local $SIG{ALRM} = sub { fail "timeout" };
  40     alarm 30;
  41     while ($length > length $buffer) {
  42         my $ret = sysread STDIN, $buffer, $length, length $buffer;
  43         fail "short read: expected $length bytes, got " . length $buffer
  44                             if defined $ret and $ret == 0;
  45         fail "read: $!" if not defined $ret and $! != EINTR and $! != EAGAIN;
  46     }
  47     alarm 0;
  48     return $buffer;
  49 }
  50
  51 my $len_hex = xread 4;
  52 fail "non-hex packet length" unless $len_hex =~ m{^[0-9a-fA-F]{4}$};
  53 my $line = xread hex $len_hex;
  54 if ($line =~ m{^(git-[a-z-]+) ([!-~]+)\0host=([!-~]+)\0$}) {
  55     package cf;
  56     our ($service,$path,$host) = ($1,$2,$3);
  57     $path =~ s|^/*||;
  58     our $uri = $_ = "git://$host/$path";
  59 } else {
  60     $line =~ s|[^ -~]+| |g;
  61     fail "could not parse \"$line\""
  62 }
  63
  64 for my $cf (@ARGV) {
  65     package cf;
  66     our ($user,$dir,$repo);
  67     do $cf;
  68 }
  69 fail "no user configured for $cf::uri" unless defined $cf::user;
  70 syslog 'info', "$cf::client $cf::service $cf::uri";
  71
  72 my @opts = map "-D$_=${$cf::{$_}}", grep defined ${$cf::{$_}}, sort keys %cf::;
  73 my @cmd = ('userv', @opts, $cf::user, $cf::service);
  74 no warnings; # suppress errors to stderr
  75 exec @cmd or fail "exec @cmd: $!";
  76
  77 # end