dgit-repos-server

   1 #!/usr/bin/perl -w
   2 # dgit-repos-push-receiver
   3 #
   4 # usages:
   5 #  .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh
   6 #  .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR PACKAGE
   7 # internal usage:
   8 #  .../dgit-repos-push-receiver --pre-receive-hook PACKAGE
   9 #
  10 # Invoked as the ssh restricted command
  11 #
  12 # Works like git-receive-pack
  13 #
  14 # KEYRING-AUTH-SPEC is a :-separated list of
  15 #   KEYRING.GPG,AUTH-SPEC
  16 # where AUTH-SPEC is one of
  17 #   a
  18 #   mDM.TXT
  19
  20 use strict;
  21
  22 # What we do is this:
  23 #  - extract the destination repo name
  24 #  - make a hardlink clone of the destination repo
  25 #  - provide the destination with a stunt pre-receive hook
  26 #  - run actual git-receive-pack with that new destination
  27 #   as a result of this the stunt pre-receive hook runs; it does this
  28 #    + understand what refs we are allegedly updating and
  29 #      check some correspondences:
  30 #        * we are updating only refs/tags/debian/* and refs/dgit/*
  31 #        * and only one of each
  32 #        * and the tag does not already exist
  33 #      and
  34 #        * recovering the suite name from the destination refs/dgit/ ref
  35 #    + disassemble the signed tag into its various fields and signature
  36 #      including:
  37 #        * parsing the first line of the tag message to recover
  38 #          the package name, version and suite
  39 #        * checking that the package name corresponds to the dest repo name
  40 #        * checking that the suite name is as recovered above
  41 #    + verify the signature on the signed tag
  42 #      and if necessary check that the keyid and package are listed in dm.txt
  43 #    + check various correspondences:
  44 #        * the suite is one of those permitted
  45 #        * the signed tag must refer to a commit
  46 #        * the signed tag commit must be the refs/dgit value
  47 #        * the name in the signed tag must correspond to its ref name
  48 #        * the tag name must be debian/<version> (massaged as needed)
  49 #        * the signed tag has a suitable name
  50 #        * the commit is a fast forward
  51 #    + push the signed tag and new dgit branch to the actual repo
  52 #
  53 # If the destination repo does not already exist, we need to make
  54 # sure that we create it reasonably atomically, and also that
  55 # we don't every have a destination repo containing no refs at all
  56 # (because such a thing causes git-fetch-pack to barf).  So then we
  57 # do as above, except:
  58 #  - before starting, we take out our own lock for the destination repo
  59 #  - we don't make a hardline clone of the destination repo; instead
  60 #    we make a copy (not a hardlink clone) of _template
  61 #  - we set up a post-receive hook as well, which does the following:
  62 #    + check that exactly two refs were updated
  63 #    + delete the two stunt hooks
  64 #    + rename the working repo into place as the destination repo
  65
  66 use POSIX;
  67 use Fcntl qw(:flock);
  68
  69 our $package_re = '[0-9a-z][-+.0-9a-z]+';
  70
  71 our $dgitrepos;
  72 our $pkg;
  73 our $destrepo;
  74 our $workrepo;
  75 our @keyrings;
  76
  77 sub acquirelock ($$) {
  78     my ($lock, $must) = @_;
  79     for (;;) {
  80         my $fh = new IO::File, ">", $lock or die "open $lock: $!";
  81         my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
  82         if (!$ok) {
  83             return unless $must;
  84             die "flock $lock: $!";
  85         }
  86         if (!stat $lock) {
  87             next if $! == ENOENT;
  88             die "stat $lock: $!";
  89         }
  90         my $want = (stat _)[1];
  91         stat $fh or die $!;
  92         my $got = (stat _)[1];
  93         return $fh if $got == $want;
  94     }
  95 }
  96
  97 sub makeworkingclone () {
  98     $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$";
  99     my $lock = "$workrepo.lock";
 100     my $lockfh = acquirelock($lock, 1);
 101     if (!stat $destrepo) {
 102         $! == ENOENT or die "stat dest repo $destrepo: $!";
 103         mkdir $workrepo or die "create work repo $workrepo: $!";
 104         runcmd qw(git init --bare), $workrepo;
 105     } else {
 106         runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
 107     }
 108 }
 109
 110 sub setupstunthook () {
 111     my $prerecv = "$workrepo/hooks/pre-receive";
 112     my $fh = new IO::File, $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
 113         or die "$prerecv: $!";
 114     print $fh <<END or die "$prerecv: $!";
 115 #!/bin/sh
 116 set -e
 117 exec $0 --pre-receive-hook $pkg
 118 END
 119     close $fh or die "$prerecv: $!";
 120     $ENV{'DGIT_RPR_WORK'}= $workrepo;
 121     $ENV{'DGIT_RPR_DEST'}= $destrepo;
 122 }
 123
 124 #----- stunt post-receive hook -----
 125
 126 our ($tagname, $tagval, $suite, $oldcommit, $commit);
 127 our ($version, %tagh);
 128
 129 sub readupdates () {
 130     while (<STDIN>) {
 131         m/^(\S+) (\S+) (\S+)$/ or die "$_ ?";
 132         my ($old, $sha1, $refname) = ($1, $2, $3);
 133         if ($refname =~ m{^refs/tags/(?=debian/)}) {
 134             die if defined $tagname;
 135             $tagname = $'; #';
 136             $tagval = $sha1;
 137             reject "tag $tagname already exists -".
 138                 " not replacing previously-pushed version"
 139                 if $old =~ m/[^0]/;
 140         } elsif ($refname =~ m{^refs/dgit/}) {
 141             die if defined $suite;
 142             $suite = $'; #';
 143             $oldcommit = $old;
 144             $commit = $sha1;
 145         } else {
 146             die;
 147         }
 148     }
 149     STDIN->error and die $!;
 150
 151     die unless defined $refname;
 152     die unless defined $branchname;
 153 }
 154
 155 sub parsetag () {
 156     open PT, ">dgit-tmp/plaintext" or die $!;
 157     open DS, ">dgit-tmp/plaintext.asc" or die $!;
 158     open T, "-|", qw(git cat-file tag), $tagval or die $!;
 159     for (;;) {
 160         $!=0; $_=<T>; defined or die $!;
 161         print PT or die $!;
 162         if (m/^(\S+) (.*)/) {
 163             push @{ $tagh{$1} }, $2;
 164         } elsif (!m/\S/) {
 165             last;
 166         } else {
 167             die;
 168         }
 169     }
 170     $!=0; $_=<T>; defined or die $!;
 171     m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die;
 172
 173     die unless $1 eq $pkg;
 174     $version = $2;
 175     die unless $3 eq $suite;
 176
 177     for (;;) {
 178         print PT or die $!;
 179         $!=0; $_=<T>; defined or die $!;
 180         last if m/^-----BEGIN PGP/;
 181     }
 182     for (;;) {
 183         print DS or die $!;
 184         $!=0; $_=<T>;
 185         last if !defined;
 186     }
 187     T->error and die $!;
 188     close PT or die $!;
 189     close DS or die $!;
 190 }
 191
 192 sub checksig_keyring ($) {
 193     my ($keyringfile) = @_;
 194     # returns primary-keyid if signed by a key in this keyring
 195     # or undef if not
 196     # or dies on other errors
 197
 198     my $ok = undef;
 199
 200     open P, "-|", (qw(gpgv --status-fd=1),
 201                    map { '--keyring', $_ }, @keyrings,
 202                    qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext))
 203         or die $!;
 204
 205     while (<P>) {
 206         next unless s/^\[GNUPG:\]: //;
 207         chomp or die;
 208         my @l = split / /, $_;
 209         if ($l[0] eq 'NO_PUBKEY') {
 210             last;
 211         } elsif ($l[0] eq 'VALIDSIG') {
 212             my $sigtype = $l[9];
 213             $sigtype eq '00' or reject "signature is not of type 00!";
 214             $ok = $l[10];
 215             die unless defined $ok;
 216             last;
 217         }
 218     }
 219     close P;
 220
 221     return $ok;
 222 }
 223
 224 sub dm_txt_check ($$) {
 225     my ($keyid, $dmtxtfn) = @_;
 226     open DT, '<', $dmtxtfn or die "$dmtxtfn $!";
 227     while (<DT>) {
 228         m/^fingerprint:\s+$keyid$/oi
 229             ..0 or next;
 230         m/^\S/
 231             or reject "key $keyid missing Allow section in permissions!";
 232         # in right stanza...
 233         s/^allow:/ /i
 234             ..0 or next;
 235         s/^\s+//
 236             or reject "package $package not allowed for key $keyid";
 237         # in allow field...
 238         s/\([^()]+\)//;
 239         s/\,//;
 240         foreach my $p (split /\s+/) {
 241             return if $p eq $package; # yay!
 242         }
 243     }
 244     DT->error and die $!;
 245     close DT or die $!;
 246     reject "key $keyid not in permissions list although in keyring!";
 247 }
 248
 249 sub verifytag () {
 250     foreach my $kas (split /:/, $keyrings) {
 251         $kas =~ s/^([^,]+),// or die;
 252         my $keyid = checksig_keyring $1;
 253         if (defined $keyid) {
 254             if ($kas =~ m/^a$/) {
 255                 return; # yay
 256             } elsif ($kas =~ m/^m([^,]+)$/) {
 257                 dm_txt_check($keyid, $1);
 258                 return;
 259             } else {
 260                 die;
 261             }
 262         }
 263     }
 264     reject "key not found in keyrings";
 265 }
 266
 267 sub checks () {
 268 fixme check the suite against the approved list
 269     tagh1('type') eq 'commit' or die;
 270     tagh1('object') eq $commit or die;
 271     tagh1('tag') eq $tagname or die;
 272
 273     my $v = $version;
 274     $v =~ y/~:/_%/;
 275     $tagname eq "debian/$v" or die;
 276
 277     # check that our ref is being fast-forwarded
 278     if ($oldcommit =~ m/[^0]/) {
 279         $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`;
 280         chomp $mb;
 281         $mb eq $oldcommit or reject "not fast forward on dgit branch";
 282     }
 283 }
 284
 285 sub onwardpush () {
 286     $!=0;
 287     my $r = system (qw(git send-pack),
 288                     $destrepo,
 289                     "$commit:refs/dgit/$suite",
 290                     "$tagval:refs/tags/$tagname");
 291     !$r or die "onward push failed: $r $!";
 292 }
 293
 294 sub stunthook () {
 295     chdir $workrepo or die "chdir $workrepo: $!";
 296     mkdir "dgit-tmp" or $!==EEXIST or die $!;
 297     readupdates();
 298     parsetag();
 299     verifytag();
 300     checks();
 301     onwardpush();
 302 }
 303
 304 #----- arg parsing and main program -----
 305
 306 sub parseargs () {
 307     die unless @ARGV;
 308
 309     if ($ARGV[0] eq '--pre-receive-hook') {
 310         shift @ARGV;
 311         @ARGV == 1 or die;
 312         $pkg = shift @ARGV;
 313         defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die;
 314         defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die;
 315         defined($keyrings = $ENV{'DGIT_RPR_KEYRINGS'}) or die $!;
 316         open STDOUT, ">&STDERR" or die $!;
 317         stunthook();
 318         exit 0;
 319     }
 320
 321     die unless @ARGV>=2;
 322
 323     die if $ARGV[0] =~ m/^-/;
 324     $ENV{'DGIT_RPR_KEYRINGS'} = shift @ARGV;
 325     die if $ARGV[0] =~ m/^-/;
 326     $dgitrepos = shift @ARGV;
 327
 328     die unless @ARGV;
 329     if ($ARGV[0] != m/^-/) {
 330         @ARGV == 1 or die;
 331         $pkg = shift @ARGV;
 332     } elsif ($ARGV[0] eq '--ssh') {
 333         shift @ARGV;
 334         !@ARGV or die;
 335         my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
 336         $cmd =~ m{
 337             ^
 338             (?:\S*/)?
 339             (git-receive-pack|git-upload-pack)
 340             \s+
 341             (?:\S*/)?
 342             ($package_re)\.git
 343             $
 344         }ox
 345             or die "requested command $cmd not understood";
 346         $method = $1;
 347         $pkg = $2;
 348         my $func = $method;
 349         $func =~ y/-/_/;
 350         $func = $main::{"main__$func"};
 351         &$func;
 352     } else {
 353         die;
 354     }
 355
 356     $destrepo = "$dgitrepos/$pkg.git";
 357 }
 358
 359 sub main__git_receive_pack () {
 360     parseargs();
 361 fixme check method;
 362     makeworkingclone();
 363     setupstunthook();
 364     runcmd qw(git receive-pack), $destdir;
 365 }