#!/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;
}