diff options
Diffstat (limited to 'dgit-repos-server')
| -rw-r--r-- | dgit-repos-server | 324 |
1 files changed, 324 insertions, 0 deletions
diff --git a/dgit-repos-server b/dgit-repos-server new file mode 100644 index 0000000..0f7c4b0 --- /dev/null +++ b/dgit-repos-server @@ -0,0 +1,324 @@ +#!/usr/bin/perl -w +# dgit-repos-push-receiver +# +# usages: +# .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh +# .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR PACKAGE +# internal usage: +# .../dgit-repos-push-receiver --pre-receive-hook PACKAGE +# +# Invoked as the ssh restricted command +# +# Works like git-receive-pack +# +# KEYRING-AUTH-SPEC is a :-separated list of +# KEYRING.GPG,AUTH-SPEC +# where AUTH-SPEC is one of +# a +# mDM.TXT + +use strict; + +# What we do is this: +# - extract the destination repo name somehow +# - make a hardlink clone of the destination repo +# - provide the destination with a stunt pre-receive hook +# - run actual git-receive-pack with that new destination +# as a result of this the stunt pre-receive hook runs; it does this +# find the keyring(s) to use for verification +# verify the signed tag +# check that the signed tag has a suitable name +# parse the signed tag body to extract the intended +# distro and suite +# check that the distro is right +# check that the suite is the same as the branch we are +# supposed to update +# check that the signed tag refers to the same commit +# as the new suite +# check that the signer was correct +# push the signed tag to the actual repo +# push the new dgit branch head to the actual repo + +use POSIX; +use Fcntl qw(:flock); + +our $package_re = '[0-9a-z][-+.0-9a-z]+'; + +our $dgitrepos; +our $pkg; +our $destrepo; +our $workrepo; +our @keyrings; + +sub acquirelock ($$) { + my ($lock, $must) = @_; + for (;;) { + my $fh = new IO::File, ">", $lock or die "open $lock: $!"; + my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB); + if (!$ok) { + return unless $must; + die "flock $lock: $!"; + } + if (!stat $lock) { + next if $! == ENOENT; + die "stat $lock: $!"; + } + my $want = (stat _)[1]; + stat $fh or die $!; + my $got = (stat _)[1]; + return $fh if $got == $want; + } +} + +sub makeworkingclone () { + $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$"; + my $lock = "$workrepo.lock"; + my $lockfh = acquirelock($lock, 1); + if (!stat $destrepo) { + $! == ENOENT or die "stat dest repo $destrepo: $!"; + mkdir $workrepo or die "create work repo $workrepo: $!"; + runcmd qw(git init --bare), $workrepo; + } else { + runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo; + } +} + +sub setupstunthook () { + my $prerecv = "$workrepo/hooks/pre-receive"; + my $fh = new IO::File, $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777 + or die "$prerecv: $!"; + print $fh <<END or die "$prerecv: $!"; +#!/bin/sh +set -e +exec $0 --pre-receive-hook $pkg +END + close $fh or die "$prerecv: $!"; + $ENV{'DGIT_RPR_WORK'}= $workrepo; + $ENV{'DGIT_RPR_DEST'}= $destrepo; +} + +#----- stunt post-receive hook ----- + +our ($tagname, $tagval, $suite, $oldcommit, $commit); +our ($version, %tagh); + +sub readupdates () { + while (<STDIN>) { + m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; + my ($old, $sha1, $refname) = ($1, $2, $3); + if ($refname =~ m{^refs/tags/(?=debian/)}) { + die if defined $tagname; + $tagname = $'; #'; + $tagval = $sha1; + reject "tag $tagname already exists -". + " not replacing previously-pushed version" + if $old =~ m/[^0]/; + } elsif ($refname =~ m{^refs/dgit/}) { + die if defined $suite; + $suite = $'; #'; + $oldcommit = $old; + $commit = $sha1; + } else { + die; + } + } + STDIN->error and die $!; + + die unless defined $refname; + die unless defined $branchname; +} + +sub parsetag () { + open PT, ">dgit-tmp/plaintext" or die $!; + open DS, ">dgit-tmp/plaintext.asc" or die $!; + open T, "-|", qw(git cat-file tag), $tagval or die $!; + my %tagh; + for (;;) { + $!=0; $_=<T>; defined or die $!; + print PT or die $!; + if (m/^(\S+) (.*)/) { + push @{ $tagh{$1} }, $2; + } elsif (!m/\S/) { + last; + } else { + die; + } + } + $!=0; $_=<T>; defined or die $!; + m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die; + + die unless $1 eq $pkg; + $version = $2; + die unless $3 eq $suite; + + for (;;) { + print PT or die $!; + $!=0; $_=<T>; defined or die $!; + last if m/^-----BEGIN PGP/; + } + for (;;) { + print DS or die $!; + $!=0; $_=<T>; + last if !defined; + } + T->error and die $!; + close PT or die $!; + close DS or die $!; +} + +sub checksig_keyring ($) { + my ($keyringfile) = @_; + # returns primary-keyid if signed by a key in this keyring + # or undef if not + # or dies on other errors + + my $ok = undef; + + open P, "-|", (qw(gpgv --status-fd=1), + map { '--keyring', $_ }, @keyrings, + qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)) + or die $!; + + while (<P>) { + next unless s/^\[GNUPG:\]: //; + chomp or die; + my @l = split / /, $_; + if ($l[0] eq 'NO_PUBKEY') { + last; + } elsif ($l[0] eq 'VALIDSIG') { + my $sigtype = $l[9]; + $sigtype eq '00' or reject "signature is not of type 00!"; + $ok = $l[10]; + die unless defined $ok; + last; + } + } + close P; + + return $ok; +} + +sub dm_txt_check ($$) { + my ($keyid, $dmtxtfn) = @_; + open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; + while (<DT>) { + m/^fingerprint:\s+$keyid$/oi + ..0 or next; + m/^\S/ + or reject "key $keyid missing Allow section in permissions!"; + # in right stanza... + s/^allow:/ /i + ..0 or next; + s/^\s+// + or reject "package $package not allowed for key $keyid"; + # in allow field... + s/\([^()]+\)//; + s/\,//; + foreach my $p (split /\s+/) { + return if $p eq $package; # yay! + } + } + DT->error and die $!; + close DT or die $!; + reject "key $keyid not in permissions list although in keyring!"; +} + +sub verifytag () { + foreach my $kas (split /:/, $keyrings) { + $kas =~ s/^([^,]+),// or die; + my $keyid = checksig_keyring $1; + if (defined $keyid) { + if ($kas =~ m/^a$/) { + return; # yay + } elsif ($kas =~ m/^m([^,]+)$/) { + dm_txt_check($keyid, $1); + return; + } else { + die; + } + } + } + reject "key not found in keyrings"; +} + +sub checktag () { + tagh1('object') eq $branchval or die; + tagh1('type') eq 'commit' or die; + tagh1('tag') eq $tagname or die; + + my $v = $version; + $v =~ y/~:/_%/; + $tagname eq "debian/$v" or die; + + check fast forward; +} + + +sub stunthook () { + chdir $workrepo or die "chdir $workrepo: $!"; + mkdir "dgit-tmp" or $!==EEXIST or die $!; + readupdates(); + parsetag(); + verifytag(); + checktag(); +... ... +} + +#----- arg parsing and main program ----- + +sub parseargs () { + die unless @ARGV; + + if ($ARGV[0] eq '--pre-receive-hook') { + shift @ARGV; + @ARGV == 1 or die; + $pkg = shift @ARGV; + defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die; + defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die; + defined($keyrings = $ENV{'DGIT_RPR_KEYRINGS'}) or die $!; + open STDOUT, ">&STDERR" or die $!; + stunthook(); + exit 0; + } + + die unless @ARGV>=2; + + die if $ARGV[0] =~ m/^-/; + $ENV{'DGIT_RPR_KEYRINGS'} = shift @ARGV; + die if $ARGV[0] =~ m/^-/; + $dgitrepos = shift @ARGV; + + die unless @ARGV; + if ($ARGV[0] != m/^-/) { + @ARGV == 1 or die; + $pkg = shift @ARGV; + } elsif ($ARGV[0] eq '--ssh') { + shift @ARGV; + !@ARGV or die; + my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; + $cmd =~ m{ + ^ + (?:\S*/)? + (git-receive-pack|git-upload-pack) + \s+ + (?:\S*/)? + ($package_re)\.git + $ + }ox + or die "requested command $cmd not understood"; + $method = $1; + $pkg = $2; + } else { + die; + } + + $destrepo = "$dgitrepos/$pkg.git"; +} + +sub main () { + parseargs(); +fixme check method; + makeworkingclone(); + setupstunthook(); + runcmd qw(git receive-pack), $destdir; +} |