dgit-repos-push-receiver: wip

diff --git a/dgit-repos-push-receiver b/dgit-repos-push-receiver
new file mode 100644 (file)
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;
+}