dgit-repos-push-receiver: wip

1 files changed, 107 insertions, 14 deletions

diff --git a/dgit-repos-push-receiver b/dgit-repos-push-receiver
index 486cd16..390f2e0 100644
--- a/dgit-repos-push-receiver
+++ b/dgit-repos-push-receiver
@@ -2,14 +2,20 @@
 # dgit-repos-push-receiver
 #
 # usages:
-#  .../dgit-repos-push-receiver DGIT-REPOS-DIR --ssh
-#  .../dgit-repos-push-receiver DGIT-REPOS-DIR PACKAGE
+#  .../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;
 
@@ -39,9 +45,10 @@ use Fcntl qw(:flock);
 our $package_re = '[0-9a-z][-+.0-9a-z]+';
 
 our $dgitrepos;
-our $package;
+our $pkg;
 our $destrepo;
 our $workrepo;
+our @keyrings;
 
 sub acquirelock ($$) {
     my ($lock, $must) = @_;
@@ -64,7 +71,7 @@ sub acquirelock ($$) {
 }
 
 sub makeworkingclone () {
-    $workrepo = "$dgitrepos/_tmp/$package_incoming$$";
+    $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$";
     my $lock = "$workrepo.lock";
     my $lockfh = acquirelock($lock, 1);
     if (!stat $destrepo) {
@@ -83,7 +90,7 @@ sub setupstunthook () {
     print $fh <<END or die "$prerecv: $!";
 #!/bin/sh
 set -e
-exec $0 --pre-receive-hook $package
+exec $0 --pre-receive-hook $pkg
 END
     close $fh or die "$prerecv: $!";
     $ENV{'DGIT_RPR_WORK'}= $workrepo;
@@ -92,20 +99,24 @@ END
 
 #----- stunt post-receive hook -----
 
-our ($tagname, $tagval, $suite, $commit);
+our ($tagname, $tagval, $suite, $oldcommit, $commit);
 our ($version, %tagh);
 
 sub readupdates () {
     while (<STDIN>) {
-	m/^\S+ (\S+) (\S+)$/ or die "$_ ?";
-	my ($sha1, $refname) = ($1, $2);
+	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;
@@ -136,7 +147,7 @@ sub parsetag () {
     $!=0; $_=<T>; defined or die $!;
     m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die;
 
-    die unless $1 eq $package;
+    die unless $1 eq $pkg;
     $version = $2;
     die unless $3 eq $suite;
 
@@ -155,6 +166,81 @@ sub parsetag () {
     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;
@@ -163,6 +249,8 @@ sub checktag () {
     my $v = $version;
     $v =~ y/~:/_%/;
     $tagname eq "debian/$v" or die;
+
+    check fast forward;
 }
 
 
@@ -184,21 +272,26 @@ sub parseargs () {
     if ($ARGV[0] eq '--pre-receive-hook') {
 	shift @ARGV;
 	@ARGV == 1 or die;
-	$package = shift @ARGV;
+	$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;
+    $dgitrepos = shift @ARGV;
 
     die unless @ARGV;
     if ($ARGV[0] != m/^-/) {
 	@ARGV == 1 or die;
-	$package = shift @ARGV;
+	$pkg = shift @ARGV;
     } elsif ($ARGV[0] eq '--ssh') {
 	shift @ARGV;
 	!@ARGV or die;
@@ -213,12 +306,12 @@ sub parseargs () {
             $
         }ox 
 	    or die "requested command $cmd not understood";
-	$package = $1;
+	$pkg = $1;
     } else {
 	die;
     }
 
-    $destrepo = "$dgitrepos/$package.git";
+    $destrepo = "$dgitrepos/$pkg.git";
 }
 
 sub main () {