+++ /dev/null
-#!/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;
-}
~ianmdlvl / dgit.git / blobdiff