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 vars qw{ %vhost_default_user %vhost_user_from_tilde
  21              $TILDE $REPO $HOSTNAME };
  22
  23 use lib '/etc/userv';
  24 require 'git-daemon-vhosts.pl';
  25
  26 my $peer = getpeername STDIN;
  27 my ($port,$addr);
  28 if (defined $peer) {
  29     ($port,$addr) = sockaddr_in $peer;
  30     $addr = inet_ntoa $addr;
  31     $peer = "[$addr]:$port";
  32 } else {
  33     $peer = "[?.?.?.?]:?";
  34     undef $!;
  35 }
  36
  37 openlog 'userv-git-daemon', 'pid', 'daemon';
  38
  39 sub fail {
  40     syslog 'err', "$peer @_";
  41     exit;
  42 }
  43
  44 sub xread {
  45     my $length = shift;
  46     my $buffer = "";
  47     my $count = 0;
  48     # simply die if the client takes too long
  49     alarm 30;
  50     while ($length > length $buffer) {
  51         my ($data,$ret);
  52         do {
  53             $ret = sysread STDIN, $data, $length
  54         } while not defined $ret and ($! == EINTR or $! == EAGAIN);
  55         fail "read: $!" unless defined $ret;
  56         fail "short read: expected $length bytes, got $count" if $ret == 0;
  57         $buffer .= $data;
  58         $count += $ret;
  59     }
  60     alarm 0;
  61     return $buffer;
  62 }
  63
  64 my $len_hex = xread 4;
  65 fail "non-hexadecimal packet length" unless $len_hex =~ m{^[0-9a-zA-Z]{4}$};
  66 my $len = hex $len_hex;
  67
  68 my $line = xread $len;
  69 unless ($line =~ m{^git-upload-pack (?:~($TILDE)/)?($REPO[.]git)\0host=($HOSTNAME)\0$}) {
  70     $line =~ s/[^ -~]+/ /g;
  71     fail "could not parse \"$line\""
  72 }
  73 my ($tilde,$repo,$host) = ($1,$2,$3);
  74 my $url = $tilde ? "git://$host/~$tilde/$repo" : "git://$host/$repo";
  75
  76 my $user = $vhost_user_from_tilde{$host} ? $tilde : $vhost_default_user{$host};
  77 fail "no user configuration for $url" unless defined $user;
  78
  79 syslog 'info', "$peer $user $url";
  80
  81 my @opts = ("-DCLIENT=$addr", "-DHOST=$host", "-DREPO=$repo");
  82 push @opts, "-DTILDE=$tilde" if defined $tilde;
  83
  84 exec 'userv', @opts, $user, 'git-upload-pack'
  85     or fail "exec userv: $!";
  86
  87 # end