infra/dgit-ssh-dispatch

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use POSIX;
   5
   6 open DEBUG, '>/dev/null' or die $!;
   7 if (@ARGV && $ARGV[0] eq '-D') {
   8     shift @ARGV;
   9     open DEBUG, '>&STDERR' or die $!;
  10 }
  11
  12 die unless @ARGV>=1 && @ARGV<=2 && $ARGV[0] !~ m/^-/;
  13 our ($dispatchdir,$authrune) = @ARGV;
  14
  15 $authrune //= join ':',
  16     '@/keyrings/debian-keyring.gpg,a',
  17     '@/keyrings/debian-maintainers.gpg,m@/dm.txt';
  18
  19 our $lre = '[0-9a-z][-+.0-9a-z]*';
  20 our $qre = '["'."']?";
  21
  22 # $dispatchdir should contain
  23 #    dgit-live   a clone of dgit
  24 #    repos/
  25 #    suites
  26 #    diverts
  27 #    policy-hook
  28 # plus files required by the authrune (by default, keyrings/ and dm.txt)
  29 #
  30 # diverts should be list of
  31 #  <pat> [<divert-to>]
  32 # where <pat> is a package name pattern which may contain * or literals.
  33
  34 our ($distro,$pkg);
  35 our ($dgitlive,$repos,$suites,$diverts,$policyhook,$repo);
  36
  37 sub checkdivert ($) {
  38     my ($df) = @_;
  39     if (!open DIV, '<', $df) {
  40         $!==ENOENT or die $!;
  41         return undef;
  42     } else {
  43         while (<DIV>) {
  44             s/^\s+//; s/\s+$//;
  45             next unless m/\S/;
  46             next if m/^\#/;
  47             my $divert;
  48             if (s/\s+(\S+)$//) { $divert=$1; }
  49             s/[^-+._0-9a-zA-Z*]/\\$&/g;
  50             s/\*/.*/g;
  51             printf DEBUG 'DISPATCH DIVERT ^%s$ %s'."\n",
  52                 $_, ($divert // '(undef)');
  53             if ($pkg =~ m/^$_$/) { return $divert; }
  54         }
  55         DIV->error and die $!;
  56         close DIV;
  57         return undef;
  58     }
  59 }
  60
  61 sub finish () {
  62     close STDOUT or die $!;
  63     exit 0;
  64 }
  65
  66 sub prl ($) {
  67     print @_, "\n" or die $!;
  68 }
  69
  70 sub selectpackage ($$;$) {
  71     my $divertfn;
  72     ($distro,$pkg, $divertfn) = @_; # $distro,$pkg must have sane syntax
  73
  74     my $d = "$dispatchdir/distro=$distro";
  75
  76     if (!stat $d) {
  77         die $! unless $!==ENOENT;
  78         die "unknown distro ($distro)\n";
  79     }
  80
  81     $dgitlive=    "$d/dgit-live";
  82     $repos=       "$d/repos";
  83     $suites=      "$d/suites";
  84     $policyhook=  "$d/policy-hook";
  85
  86     $authrune =~ s/\@/$d/g;
  87
  88     my $divert = checkdivert("$d/diverts");
  89     if (defined $divert) {
  90         $divertfn //= sub {
  91             die "diverted to $divert incompletely or too late!\n";
  92         };
  93         $divertfn->($divert);
  94         die;
  95     }
  96
  97     $repo = "$repos/$pkg.git";
  98
  99     print DEBUG "DISPATCH DISTRO $distro PKG $pkg\n";
 100 }
 101
 102 sub hasrepo () {
 103     if (stat $repo) {
 104         -d _ or die;
 105         return 1;
 106     } else {
 107         $!==ENOENT or die $!;
 108         return 0;
 109     }
 110 }
 111
 112 sub dispatch () {
 113     local ($_) = $ENV{'SSH_ORIGINAL_COMMAND'};
 114
 115     if (m#^: dgit ($lre) git-check ($lre) ;#) {
 116         selectpackage $1,$2, sub { prl "divert @_"; finish; };
 117         prl hasrepo;
 118         finish;
 119     } elsif (
 120         m#^${qre}git-([-a-z]+) ${qre}/dgit/($lre)/repos/($lre)\.git${qre}$#
 121     ) {
 122         my $cmd=$1;
 123         selectpackage $2,$3;
 124         if ($cmd eq 'receive-pack') {
 125             my $s = "$dgitlive/infra/dgit-repos-server";
 126             exec $s, $distro, $suites, $authrune, $repos,
 127                     $policyhook, qw(--ssh);
 128             die "exec $s: $!";
 129         } elsif ($cmd eq 'upload-pack') {
 130             $repo='$repos/_empty' unless hasrepo;
 131             exec qw(git upload-pack --strict --timeout=1000), $repo;
 132             die "exec git: $!";
 133         } else {
 134             die "unsupported git operation $cmd ($_)";
 135         }
 136     } else {
 137         die "unsupported operation ($_)";
 138     }
 139 }
 140
 141 dispatch;