X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=infra%2Fdgit-repos-policy-debian;h=41a5551faa005c591dfb0fed62467b9387e88dff;hp=c84fd7d4f3ff7c935466877b7903e301ebf6cdc8;hb=2965f30cca23b1cb7c1cf1d764b4f6b571f0a78e;hpb=d395baaa070686dce79a9ad7cd02777a4caa4778

diff --git a/infra/dgit-repos-policy-debian b/infra/dgit-repos-policy-debian
index c84fd7d4..41a5551f 100755
--- a/infra/dgit-repos-policy-debian
+++ b/infra/dgit-repos-policy-debian
@@ -2,18 +2,23 @@
 # dgit repos policy hook script for Debian
 
 use strict;
+$SIG{__WARN__} = sub { die $_[0]; };
+
 use POSIX;
 use JSON;
-use File::Temp;
+use File::Temp qw(tempfile);
+use DBI;
+use IPC::Open2;
 
 use Debian::Dgit qw(:DEFAULT :policyflags);
+use Debian::Dgit::Policy::Debian;
 
 our $distro = shift @ARGV // die "need DISTRO";
 our $repos = shift @ARGV // die "need DGIT-REPOS-DIR";
+our $dgitlive = shift @ARGV // die "need DGIT-LIVE-DIR";
 our $action = shift @ARGV // die "need ACTION";
 
 our $publicmode = 02775;
-our $policydb = "dbi:SQLite:$repos/policy.sqlite3";
 our $new_upload_propagation_slop = 3600*4 + 100;
 
 our $poldbh;
@@ -21,6 +26,8 @@ our $pkg;
 our $pkgdir;
 our ($pkg_exists,$pkg_secret);
 
+our $stderr;
+
 our ($version,$suite,$tagname);
 our %deliberately;
 
@@ -58,58 +65,31 @@ our %deliberately;
 # still be being uploaded.  (We record this using the timestamp of the
 # package's git repo directory.)
 
-
-sub poldb_setup () {
-    $poldbh = DBI->connect($policydb,'','', {
-	RaiseError=>1, PrintError=>1, AutoCommit=>0
-			   });
-    $poldbh->do("PRAGMA foreign_keys = ON");
-
-    $poldbh->do(<<END);
-	CREATE TABLE IF NOT EXISTS taints (
-	    taint_id   INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT,
-	    package    TEXT    NOT NULL,
-	    gitobjid   TEXT    NOT NULL,
-	    comment    TEXT    NOT NULL,
-	    time       INTEGER,
-	    gitobjtype TEXT,
-	    gitobjdata TEXT
-	    )
-END
-    $poldbh->do(<<END);
-	CREATE INDEX IF NOT EXISTS taints_by_package
-	    ON taints (package, gitobject)
-END
-    # any one of of the listed deliberatelies will override its taint
-    $poldbh->do(<<END);
-	CREATE TABLE IF NOT EXISTS taintoverrides (
-	    taint_id  INTEGER NOT NULL
-		      REFERENCES taints (taint_id)
-			  ON UPDATE RESTRICT
-			  ON DELETE CASCADE
-		      DEFERRABLE INITIALLY DEFERRED,
-	    deliberately TEXT NOT NULL,
-	    PRIMARY KEY (taint_id, deliberately)
-	)
-END
-}
-
-sub poldb_commit () {
-    $poldbh->commit;
-}
+# We aim for the following invariants and properties:
+#
+# - .dsc of published dgit package will have corresponding publicly
+#   visible dgit-repo (soon)
+#
+# - when a new package is rejected we help maintainer avoid
+#   accidentally including bad objects in published dgit history
+#
+# - .dsc of NEW dgit package has corresponding dgit-repo but not
+#   publicly readable
 
 sub apiquery ($) {
     my ($subpath) = @_;
     local $/=undef;
-    $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
+    my $cmd = "$dgitlive/dgit -d $distro ".
+	"\$DGIT_TEST_OPTS \$DGIT_TEST_DEBUG archive-api-query $subpath";
+    $!=0; $?=0; my $json = `$cmd`;
     defined $json or die "$subpath $! $?";
     return decode_json $json;
 }
 
 sub specific_suite_has_vsn_in_our_history ($) {
     my ($suite) = @_;
-    my $in_new = apiquery "/dsc_in_suite/$suite/$pkg";
-    foreach my $entry (@$in_new) {
+    my $in_suite = apiquery "/dsc_in_suite/$suite/$pkg";
+    foreach my $entry (@$in_suite) {
 	my $vsn = $entry->{version};
 	die "$pkg ?" unless defined $vsn;
 	my $tag = debiantag $vsn;
@@ -140,19 +120,22 @@ sub good_suite_has_vsn_in_our_history () {
     return 0;
 }
 
+sub statpackage () {
+    $pkgdir = "$repos/$pkg.git";
+    if (!stat_exists $pkgdir) {
+	$pkg_exists = 0;
+    } else {
+	$pkg_exists = 1;
+	$pkg_secret = !!(~(stat _)[2] & 05);
+    }
+}
+
 sub getpackage () {
-    die unless @ARGV > 1;
+    die unless @ARGV >= 1;
     $pkg = shift @ARGV;
-    die if $pkg =~ m#[^-+.0-9a-z]#;
-    die unless $pkg =~ m#^[^-]#;
+    die unless $pkg =~ m/^$package_re$/;
 
-    $pkgdir = "$repos/$pkg";
-    if (!stat $pkgdir) {
-	die "$pkgdir $!" unless $!==ENOENT;
-	$pkg_exists = 0;
-    }
-    $pkg_exists = 1;
-    $pkg_secret = !!(~(stat _)[2] & 05);
+    statpackage();
 }
 
 sub add_taint ($$) {
@@ -171,7 +154,7 @@ sub add_taint ($$) {
 
     close $tf or die $!;
     $_ = <GCF>;
-    m/^(\w+) (\w+) (\d+)\n/ or die "$objline ?";
+    m/^(\w+) (\w+) (\d+)\n/ or die "$_ ?";
     my $gitobjid = $1;
     my $gitobjtype = $2;
     my $bytes = $3;
@@ -220,9 +203,8 @@ sub action__check_package () {
 
     git_for_each_ref('refs/tags', sub {
 	my ($objid,$objtype,$fullrefname,$tagname) = @_;
-	add_taint_by_tag($tagname,$refobjid);
+	add_taint_by_tag($tagname,$objid);
     });
-    $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";
 
     return FRESHREPO;
 }
@@ -265,7 +247,11 @@ sub action_push () {
 }
 
 sub action_push_confirm () {
-    my $initq = $dbh->prepare(<<END);
+    getpackage();
+    die unless @ARGV;
+    my $freshrepo = shift @ARGV;
+
+    my $initq = $poldbh->prepare(<<END);
         SELECT taint_id, gitobjid FROM taints t
             WHERE (package = ? OR package = '')
 END
@@ -275,24 +261,25 @@ END
     my $chkinput = tempfile();
     while (my $taint = $initq->fetchrow_hashref()) {
 	push @taintids, $taint->{taint_id};
-	print $chkinput, $taint->{gitobjid}, "\n" or die $!;
+	print $chkinput $taint->{gitobjid}, "\n" or die $!;
     }
     flush $chkinput or die $!;
     seek $chkinput,0,0 or die $!;
 
-    my $checkpid = open2("<&$chkinput", \*CHKOUT, qw(git cat-file --batch));
-    $checkpid or die $!;
+    my $checkpid = open CHKOUT, "-|" // die $!;
+    if (!$checkpid) {
+	open STDIN, "<&", $chkinput or die $!;
+	exec qw(git cat-file --batch) or die $!;
+    }
 
     my ($taintinfoq,$overridesanyq,$untaintq,$overridesq);
 
     my $overridesstmt = <<END;
-        SELECT deliberately FROM taintoverrides WHERE (
-    my @overridesv = sort keys %deliberately;
-    $overridesstmt .= join <<END, (<<END x @overridesv);
+        SELECT deliberately FROM taintoverrides WHERE ( 1
 END
-            OR
-END
-            deliberately = ?
+    my @overridesv = sort keys %deliberately;
+    $overridesstmt .= join '', (<<END x @overridesv);
+            OR deliberately = ?
 END
     $overridesstmt .= <<END;
 	) AND taint_id = ?
@@ -301,17 +288,21 @@ END
 
     my $mustreject=0;
 
-    while (<CHKOUT>) {
-	my $taintid = shift @taintids;
-	die unless defined $taintid;
+    while (my $taintid = shift @taintids) {
+	# git cat-file prints a spurious newline after it gets EOF
+	# This is not documented.  I guess it might go away.  So we
+	# just read what we expect and then let it get SIGPIPE.
+	$!=0; $_ = <CHKOUT>;
+	die "$? $!" unless defined $_;
 
 	next if m/^\w+ missing$/;
-	die unless m/^(\w+) (\s+) (\d+)\s/;
-	my ($objid,$objtype,$nbytes) = @_;
+	die unless m/^(\w+) (\w+) (\d+)\s/;
+	my ($objid,$objtype,$nbytes) = ($1,$2,$3);
 
-	read CHKOUT, $_, $nbytes == $bytes or last;
+	my $drop;
+	(read CHKOUT, $drop, $nbytes) == $nbytes or die;
 
-	$taintinfoq ||= $dbh->prepare(<<END);
+	$taintinfoq ||= $poldbh->prepare(<<END);
             SELECT package, time, comment FROM taints WHERE taint_id =  ?
 END
         $taintinfoq->execute($taintid);
@@ -320,74 +311,93 @@ END
 	die unless $ti;
 
 	my $timeshow = defined $ti->{time}
-	    ? " at time ".strftime("%Y-%m-%d %H:%M:%S Z", gmtime $ti->time)
+	    ? " at time ".strftime("%Y-%m-%d %H:%M:%S Z", gmtime $ti->{time})
 	    : "";
 	my $pkgshow = length $ti->{package}
 	    ? "package $ti->{package}"
 	    : "any package";
 
-	print STDERR <<END;
+	$stderr .= <<END;
 
 History contains tainted $objtype $objid
-Taint recorded$timeshow for $pkginfo
+Taint recorded$timeshow for $pkgshow
 Reason: $ti->{comment}
 END
 
-        $overridesq ||= $dbh->prepare($overridesstmt);
+        $overridesq ||= $poldbh->prepare($overridesstmt);
 	$overridesq->execute(@overridesv, $taintid);
 	my ($ovwhy) = $overridesq->fetchrow_array();
 	if (!defined $ovwhy) {
-	    $overridesanyq ||= $dbh->prepare(<<END);
+	    $overridesanyq ||= $poldbh->prepare(<<END);
 	        SELECT 1 FROM taintoverrides WHERE taint_id = ? LIMIT 1
 END
 	    $overridesanyq->execute($taintid);
 	    my ($ovany) = $overridesanyq->fetchrow_array();
-	    print STDERR $ovany ? <<END : <<END;
+	    $stderr .= $ovany ? <<END : <<END;
 Could be forced using --deliberately.  Consult documentation.
 END
 Uncorrectable error.  If confused, consult administrator.
 END
             $mustreject = 1;
 	} else {
-	    print STDERR <<END;
+	    $stderr .= <<END;
 Forcing due to --deliberately-$ovwhy
 END
-            $untaintq ||= $dbh->prepare(<<END);
+            $untaintq ||= $poldbh->prepare(<<END);
                 DELETE FROM taints WHERE taint_id = ?
 END
-            $untaintq->execute($taint_id);
+            $untaintq->execute($taintid);
         }
     }
-    if (@taintids) {
-	$?=0; my $gotpid = waitpid $checkpid, WNOHANG;
-	die "@taintids $gotpid $? $!";
-    }
+    close CHKOUT;
 
     if ($mustreject) {
-	print STDERR <<END;
+	$stderr .= <<END;
 
 Rejecting push due to questionable history.
 END
-        exit 1;
+        return 1;
     }
 
-    return 0;
-}
+    if (length $freshrepo) {
+	if (!good_suite_has_vsn_in_our_history()) {
+	    stat $freshrepo or die "$freshrepo $!";
+	    my $oldmode = ((stat _)[2]);
+	    my $oldwrites = $oldmode & 0222;
+	    # remove r and x bits which have corresponding w bits clear
+	    my $newmode = $oldmode & ($oldwrites << 1) & ($oldwrites > 1);
+	    chmod $newmode, $freshrepo or die $!;
+	}
+    }
 
-if (defined $pkg) {
-    selectpackage;
+    return 0;
 }
 
-$cmd =~ y/-/_/;
-my $fn = ${*::}{"action__$cmd"};
+$action =~ y/-/_/;
+my $fn = ${*::}{"action_$action"};
 if (!$fn) {
     exit 0;
 }
 
-poldb_setup();
+my $sleepy=0;
+our $rcode = 127;
+
+for (;;) {
+    poldb_setup(poldb_path($repos));
+    $stderr = '';
 
-my $rcode = $fn->();
-die unless defined $rcode;
+    $rcode = $fn->();
+    die unless defined $rcode;
+
+    eval { $poldbh->commit; };
+    last unless length $@;
+
+    die if $sleepy >= 20;
+    print STDERR "[policy database busy, retrying]\n";
+    sleep ++$sleepy;
+
+    $poldbh->rollback;
+}
 
-poldb_commit();
+print STDERR $stderr;
 exit $rcode;