infra/dgit-repos-policy-debian

   1 #!/usr/bin/perl -w
   2 # dgit repos policy hook script for Debian
   3 #
   4 # usages:
   5 #   dgit-repos-policy-debian DISTRO DGIT-REPOS-DIR ACTION...
   6 # ie.
   7 #   dgit-repos-policy-debian ... check-list [...]
   8 #   dgit-repos-policy-debian ... check-package PACKAGE [...]
   9 #   dgit-repos-policy-debian ... push PACKAGE \
  10 #         VERSION SUITE TAGNAME DELIBERATELIES [...]
  11 #   dgit-repos-policy-debian ... push-confirm PACKAGE \
  12 #         VERSION SUITE TAGNAME DELIBERATELIES [...]
  13 #
  14 # cwd for push is a temporary repo where the to-be-pushed objects have
  15 #  been received; TAGNAME is the version-based tag
  16 #
  17 # if push requested FRESHREPO, push-confirm happens in said fresh repo
  18 #
  19 # policy hook for a particular package will be invoked only once at
  20 # a time
  21
  22 use strict;
  23 use POSIX;
  24 use JSON;
  25 use File::Temp;
  26
  27 use Debian::Dgit qw(:DEFAULT :policyflags);
  28
  29 our $distro = shift @ARGV // die "need DISTRO";
  30 our $repos = shift @ARGV // die "need DGIT-REPOS-DIR";
  31 our $action = shift @ARGV // die "need ACTION";
  32
  33 our $publicmode = 02775;
  34 our $policydb = "dbi:SQLite:$repos/policy";
  35 our $new_upload_propagation_slop = 3600*4 + 100;
  36
  37 our $poldbh;
  38 our $pkg;
  39 our $pkgdir;
  40 our ($pkg_exists,$pkg_secret);
  41
  42 our ($version,$suite,$tagname);
  43 our %deliberately;
  44
  45 # We assume that it is not possible for NEW to have a version older
  46 # than sid.
  47
  48 # Whenever pushing, we check for
  49 #   source-package-local tainted history
  50 #   global tainted history
  51 #   can be overridden by --deliberately except for an admin prohib taint
  52 #
  53 # ALL of the following apply only if history is secret:
  54 #
  55 # if NEW has no version, or a version which is not in our history[1]
  56 #   (always)
  57 #   check all suites
  58 #   if any suite's version is in our history[1], publish our history
  59 #   otherwise discard our history,
  60 #     tainting --deliberately-include-questionable-history
  61 #
  62 # if NEW has a version which is in our history[1]
  63 #   (on push only)
  64 #   require explicit specification of one of
  65 #     --deliberately-include-questionable-history
  66 #     --deliberately-not-fast-forward
  67 #       (latter will taint old NEW version --d-i-q-h)
  68 #   (otherwise)
  69 #   leave it be
  70 #
  71 # [1] looking for the relevant git tag for the version number and not
  72 #    caring what that tag refers to.
  73 #
  74 # A wrinkle: if we approved a push recently, we treat NEW as having
  75 # a version which is in our history.  This is because the package may
  76 # still be being uploaded.  (We record this using the timestamp of the
  77 # package's git repo directory.)
  78
  79
  80 sub poldb_setup () {
  81     $poldbh = DBI->connect($policydb,'','', {
  82         RaiseError=>1, PrintError=>1, AutoCommit=>0
  83                            });
  84     $poldbh->do("PRAGMA foreign_keys = ON");
  85
  86     $poldbh->do(<<END);
  87         CREATE TABLE IF NOT EXISTS taints (
  88             taint_id   INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT,
  89             package    TEXT    NOT NULL,
  90             gitobjid   TEXT    NOT NULL,
  91             comment    TEXT    NOT NULL,
  92             time       INTEGER,
  93             gitobjtype TEXT,
  94             gitobjdata TEXT
  95             )
  96 END
  97     $poldbh->do(<<END);
  98         CREATE INDEX IF NOT EXISTS taints_by_package
  99             ON taints (package, gitobject)
 100 END
 101     # any one of of the listed deliberatelies will override its taint
 102     $poldbh->do(<<END);
 103         CREATE TABLE IF NOT EXISTS taintoverrides (
 104             taint_id  INTEGER NOT NULL
 105                       REFERENCES taints (taint_id)
 106                           ON UPDATE RESTRICT
 107                           ON DELETE CASCADE
 108                       DEFERRABLE INITIALLY DEFERRED,
 109             deliberately TEXT NOT NULL,
 110             PRIMARY KEY (taint_id, deliberately)
 111         )
 112 END
 113 }
 114
 115 sub poldb_commit () {
 116     $poldbh->commit;
 117 }
 118
 119 sub apiquery ($) {
 120     my ($subpath) = @_;
 121     local $/=undef;
 122     $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
 123     defined $json or die "$subpath $! $?";
 124     return decode_json $json;
 125 }
 126
 127 sub specific_suite_has_vsn_in_our_history ($) {
 128     my ($suite) = @_;
 129     my $in_new = apiquery "/dsc_in_suite/$suite/$pkg";
 130     foreach my $entry (@$in_new) {
 131         my $vsn = $entry->{version};
 132         die "$pkg ?" unless defined $vsn;
 133         my $tag = debiantag $vsn;
 134         $?=0; my $r = system qw(git show-ref --verify --quiet), $tag;
 135         return 1 if !$r;
 136         next if $r==256;
 137         die "$pkg tag $tag $? $!";
 138     }
 139     return 0;
 140 }
 141
 142 sub new_has_vsn_in_our_history () {
 143     stat $pkgdir or die "$pkgdir $!";
 144     my $mtime = ((stat _)[9]);
 145     my $age = time -  $mtime;
 146     return 1 if $age < $new_upload_propagation_slop;
 147     return specific_suite_has_vsn_in_our_history('new');
 148 }
 149
 150 sub good_suite_has_vsn_in_our_history () {
 151     my $suites = apiquery "/suites";
 152     foreach my $suitei (@$suites) {
 153         my $suite = $suitei->{name};
 154         die unless defined $suite;
 155         next if $suite =~ m/\bnew$/;
 156         return 1 if specific_suite_has_vsn_in_our_history($suite);
 157     }
 158     return 0;
 159 }
 160
 161 sub getpackage () {
 162     die unless @ARGV > 1;
 163     $pkg = shift @ARGV;
 164     die if $pkg =~ m#[^-+.0-9a-z]#;
 165     die unless $pkg =~ m#^[^-]#;
 166
 167     $pkgdir = "$repos/$pkg";
 168     if (!stat $pkgdir) {
 169         die "$pkgdir $!" unless $!==ENOENT;
 170         $pkg_exists = 0;
 171     }
 172     $pkg_exists = 1;
 173     $pkg_secret = !!(~(stat _)[2] & 05);
 174 }
 175
 176 sub add_taint ($$) {
 177     my ($refobj, $reason);
 178
 179     my $tf = new File::Temp or die $!;
 180     print $tf "$refobj^0\n" or die $!;
 181
 182     my $gcfpid = open GCF, "-|";
 183     defined $gcfpid or die $!;
 184     if (!$gcfpid) {
 185         open STDIN, "<&", $tf or die $!;
 186         exec 'git', 'cat-file';
 187         die $!;
 188     }
 189
 190     close $tf or die $!;
 191     $_ = <GCF>;
 192     m/^(\w+) (\w+) (\d+)\n/ or die "$objline ?";
 193     my $gitobjid = $1;
 194     my $gitobjtype = $2;
 195     my $bytes = $3;
 196
 197     my $gitobjdata;
 198     if ($gitobjtype eq 'commit' or $gitobjtype eq 'tag') {
 199         $!=0; read GCF, $gitobjdata, $bytes == $bytes
 200             or die "$gitobjid $bytes $!";
 201     }
 202     close GCF;
 203
 204     $poldbh->do("INSERT INTO taints".
 205                 " (package, gitobjid, gitobjtype, gitobjdata, time, comment)",
 206                 " VALUES (?,?,?,?,?,?)", {},
 207                 $pkg, $gitobjid, $gitobjtype, $gitobjdata, time, $reason);
 208
 209     my $taint_id = $poldbh->last_insert_id(undef,undef,"taints","taint_id");
 210     die unless defined $taint_id;
 211
 212     $poldbh->do("INSERT INTO taintoverrides".
 213                 " (taint_id, deliberately)",
 214                 " VALUES (?, 'include-questionable-history')", {},
 215                 $taint_id);
 216 }
 217
 218 sub add_taint_by_tag ($$) {
 219     my ($tagname,$refobjid) = @_;
 220     add_taint($refobjid,
 221               "tag $tagname referred to this object in git tree but all".
 222               " previously pushed versions were found to have been".
 223               " removed from NEW (ie, rejected) (or never arrived)");
 224 }
 225
 226 sub action__check_package () {
 227     getpackage();
 228     return 0 unless $pkg_exists;
 229     return 0 unless $pkg_secret;
 230
 231     chdir $pkgdir or die "$pkgdir $!";
 232     return if new_has_vsn_in_our_history();
 233
 234     if (good_suite_has_vsn_in_our_history) {
 235         chmod $publicmode, "." or die $!;
 236         return 0;
 237     }
 238
 239     git_for_each_ref('refs/tags', sub {
 240         my ($objid,$objtype,$fullrefname,$tagname) = @_;
 241         add_taint_by_tag($tagname,$refobjid);
 242     });
 243     $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";
 244
 245     return FRESHREPO;
 246 }
 247
 248 sub getpushinfo () {
 249     die unless @ARGV >= 4;
 250     $version = shift @ARGV;
 251     $suite = shift @ARGV;
 252     $tagname = shift @ARGV;
 253     my $delibs = shift @ARGV;
 254     foreach my $delib (split /\,/, $delibs) {
 255         $deliberately{$delib} = 1;
 256     }
 257 }
 258
 259 sub deliberately ($) { return $deliberately{$_[0]}; }
 260
 261 sub action_push () {
 262     getpackage();
 263     return 0 unless $pkg_exists;
 264     return 0 unless $pkg_secret;
 265
 266     # we suppose that NEW has a version which is already in our
 267     # history, as otherwise the repo would have been blown away
 268
 269     if (deliberately('not-fast-forward')) {
 270         add_taint(server_ref($suite),
 271                   "suite $suite when --deliberately-not-fast-forward".
 272                   " specified in signed tag $tagname for upload of".
 273                   " version $version into suite $suite");
 274         return NOFFCHECK|FRESHREPO;
 275     }
 276     if (deliberately('include-questionable-history')) {
 277         return 0;
 278     }
 279     die "Package is in NEW and has not been accepted or rejected yet;".
 280         " use a --deliberately option to specify whether you are".
 281         " keeping or discarding the previously pushed history. ".
 282         " Please RTFM dgit(1).\n";
 283 }
 284
 285 sub action_push_confirm () {
 286     my $initq = $dbh->prepare(<<END);
 287         SELECT taint_id, gitobjid FROM taints t
 288             WHERE (package = ? OR package = '')
 289 END
 290     $initq->execute($pkg);
 291
 292     my @taintids;
 293     my $chkinput = tempfile();
 294     while (my $taint = $initq->fetchrow_hashref()) {
 295         push @taintids, $taint->{taint_id};
 296         print $chkinput, $taint->{gitobjid}, "\n" or die $!;
 297     }
 298     flush $chkinput or die $!;
 299     seek $chkinput,0,0 or die $!;
 300
 301     my $checkpid = open2("<&$chkinput", \*CHKOUT, qw(git cat-file --batch));
 302     $checkpid or die $!;
 303
 304     my ($taintinfoq,$overridesanyq,$untaintq,$overridesq);
 305
 306     my $overridesstmt = <<END;
 307         SELECT deliberately FROM taintoverrides WHERE (
 308     my @overridesv = sort keys %deliberately;
 309     $overridesstmt .= join <<END, (<<END x @overridesv);
 310 END
 311             OR
 312 END
 313             deliberately = ?
 314 END
 315     $overridesstmt .= <<END;
 316         ) AND taint_id = ?
 317         ORDER BY deliberately ASC
 318 END
 319
 320     my $mustreject=0;
 321
 322     while (<CHKOUT>) {
 323         my $taintid = shift @taintids;
 324         die unless defined $taintid;
 325
 326         next if m/^\w+ missing$/;
 327         die unless m/^(\w+) (\s+) (\d+)\s/;
 328         my ($objid,$objtype,$nbytes) = @_;
 329
 330         read CHKOUT, $_, $nbytes == $bytes or last;
 331
 332         $taintinfoq ||= $dbh->prepare(<<END);
 333             SELECT package, time, comment FROM taints WHERE taint_id =  ?
 334 END
 335         $taintinfoq->execute($taintid);
 336
 337         my $ti = $taintinfoq->fetchrow_hashref();
 338         die unless $ti;
 339
 340         my $timeshow = defined $ti->{time}
 341             ? " at time ".strftime("%Y-%m-%d %H:%M:%S Z", gmtime $ti->time)
 342             : "";
 343         my $pkgshow = length $ti->{package}
 344             ? "package $ti->{package}"
 345             : "any package";
 346
 347         print STDERR <<END;
 348
 349 History contains tainted $objtype $objid
 350 Taint recorded$timeshow for $pkginfo
 351 Reason: $ti->{comment}
 352 END
 353
 354         $overridesq ||= $dbh->prepare($overridesstmt);
 355         $overridesq->execute(@overridesv, $taintid);
 356         my ($ovwhy) = $overridesq->fetchrow_array();
 357         if (!defined $ovwhy) {
 358             $overridesanyq ||= $dbh->prepare(<<END);
 359                 SELECT 1 FROM taintoverrides WHERE taint_id = ? LIMIT 1
 360 END
 361             $overridesanyq->execute($taintid);
 362             my ($ovany) = $overridesanyq->fetchrow_array();
 363             print STDERR $ovany ? <<END : <<END;
 364 Could be forced using --deliberately.  Consult documentation.
 365 END
 366 Uncorrectable error.  If confused, consult administrator.
 367 END
 368             $mustreject = 1;
 369         } else {
 370             print STDERR <<END;
 371 Forcing due to --deliberately-$ovwhy
 372 END
 373             $untaintq ||= $dbh->prepare(<<END);
 374                 DELETE FROM taints WHERE taint_id = ?
 375 END
 376             $untaintq->execute($taint_id);
 377         }
 378     }
 379     if (@taintids) {
 380         $?=0; my $gotpid = waitpid $checkpid, WNOHANG;
 381         die "@taintids $gotpid $? $!";
 382     }
 383
 384     if ($mustreject) {
 385         print STDERR <<END;
 386
 387 Rejecting push due to questionable history.
 388 END
 389         exit 1;
 390     }
 391
 392     return 0;
 393 }
 394
 395 if (defined $pkg) {
 396     selectpackage;
 397 }
 398
 399 $cmd =~ y/-/_/;
 400 my $fn = ${*::}{"action__$cmd"};
 401 $fn or die "unknown ACTION";
 402
 403 poldb_setup();
 404
 405 my $rcode = $fn->();
 406 die unless defined $rcode;
 407
 408 poldb_commit();
 409 exit $rcode;