dgit-repos-push-receiver: wip

1 files changed, 229 insertions, 0 deletions

diff --git a/dgit-repos-push-receiver b/dgit-repos-push-receiver
new file mode 100644
index 0000000..486cd16
--- /dev/null
+++ b/dgit-repos-push-receiver
@@ -0,0 +1,229 @@
+#!/usr/bin/perl -w
+# dgit-repos-push-receiver
+#
+# usages:
+#  .../dgit-repos-push-receiver DGIT-REPOS-DIR --ssh
+#  .../dgit-repos-push-receiver 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
+
+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 $package;
+our $destrepo;
+our $workrepo;
+
+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/$package_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 $package
+END
+    close $fh or die "$prerecv: $!";
+    $ENV{'DGIT_RPR_WORK'}= $workrepo;
+    $ENV{'DGIT_RPR_DEST'}= $destrepo;
+}
+
+#----- stunt post-receive hook -----
+
+our ($tagname, $tagval, $suite, $commit);
+our ($version, %tagh);
+
+sub readupdates () {
+    while (<STDIN>) {
+	m/^\S+ (\S+) (\S+)$/ or die "$_ ?";
+	my ($sha1, $refname) = ($1, $2);
+	if ($refname =~ m{^refs/tags/(?=debian/)}) {
+	    die if defined $tagname;
+	    $tagname = $'; #';
+	    $tagval = $sha1;
+	} elsif ($refname =~ m{^refs/dgit/}) {
+	    die if defined $suite;
+	    $suite = $'; #';
+	    $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 $package;
+    $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 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;
+}
+
+
+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;
+	$package = shift @ARGV;
+	defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die;
+	defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die;
+	open STDOUT, ">&STDERR" or die $!;
+	stunthook();
+	exit 0;
+    }
+
+    die if $ARGV[0] =~ m/^-/;
+    $dgitrepos = shift;
+
+    die unless @ARGV;
+    if ($ARGV[0] != m/^-/) {
+	@ARGV == 1 or die;
+	$package = shift @ARGV;
+    } elsif ($ARGV[0] eq '--ssh') {
+	shift @ARGV;
+	!@ARGV or die;
+	my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
+	$cmd =~ m{
+            ^
+            (?:\S*/)?
+	    (?:dgit-repos-push-receiver|git-receive-pack)
+	    \s+
+            (?:\S*/)?
+	    ($package_re)\.git
+            $
+        }ox 
+	    or die "requested command $cmd not understood";
+	$package = $1;
+    } else {
+	die;
+    }
+
+    $destrepo = "$dgitrepos/$package.git";
+}
+
+sub main () {
+    parseargs();
+    makeworkingclone();
+    setupstunthook();
+    runcmd qw(git receive-pack), $destdir;
+}