New policy admin script

[dgit.git] / infra / dgit-repos-policy-debian

diff --git a/infra/dgit-repos-policy-debian b/infra/dgit-repos-policy-debian
index c84fd7d4f3ff7c935466877b7903e301ebf6cdc8..fa1d17d92d903a4d7456efb61a697c24d8a06470 100755 (executable)
--- a/infra/dgit-repos-policy-debian
+++ b/infra/dgit-repos-policy-debian
@@ -7,13 +7,13 @@ use JSON;
 use File::Temp;
 
 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 $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 +21,8 @@ our $pkg;
 our $pkgdir;
 our ($pkg_exists,$pkg_secret);
 
+our $stderr;
+
 our ($version,$suite,$tagname);
 our %deliberately;
 
@@ -58,45 +60,16 @@ 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) = @_;
@@ -108,8 +81,8 @@ sub apiquery ($) {
 
 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;
@@ -326,7 +299,7 @@ END
            ? "package $ti->{package}"
            : "any package";
 
-       print STDERR <<END;
+       $stderr .= <<END;
 
 History contains tainted $objtype $objid
 Taint recorded$timeshow for $pkginfo
@@ -342,14 +315,14 @@ END
 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);
@@ -364,30 +337,40 @@ END
     }
 
     if ($mustreject) {
-       print STDERR <<END;
+       $stderr .= <<END;
 
 Rejecting push due to questionable history.
 END
-        exit 1;
+        return 1;
     }
 
     return 0;
 }
 
-if (defined $pkg) {
-    selectpackage;
-}
-
 $cmd =~ y/-/_/;
 my $fn = ${*::}{"action__$cmd"};
 if (!$fn) {
     exit 0;
 }
 
-poldb_setup();
+my $sleepy=0;
+
+for (;;) {
+    poldb_setup(poldb_path($repos));
+    $stderr = '';
 
-my $rcode = $fn->();
-die unless defined $rcode;
+    my $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;