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 #
  12 # cwd for push is a temporary repo where the to-be-pushed objects have
  13 #  been received; TAGNAME is the version-based tag
  14 #
  15 # policy hook for a particular package will be invoked only once at
  16 # a time
  17
  18 use strict;
  19 use POSIX;
  20 use JSON;
  21 use File::Temp;
  22
  23 use Debian::Dgit qw(:DEFAULT :policyflags);
  24
  25 our $distro = shift @ARGV // die "need DISTRO";
  26 our $repos = shift @ARGV // die "need DGIT-REPOS-DIR";
  27 our $action = shift @ARGV // die "need ACTION";
  28
  29 our $publicmode = 02775;
  30 our $policydb = "dbi:SQLite:$repos/policy";
  31 our $new_upload_propagation_slop = 3600*4 + 100;
  32
  33 our $poldbh;
  34 our $pkg;
  35 our $pkgdir;
  36 our ($pkg_exists,$pkg_secret);
  37
  38 # We assume that it is not possible for NEW to have a version older
  39 # than sid.
  40
  41 # Whenever pushing, we check for
  42 #   source-package-local tainted history
  43 #   global tainted history
  44 #   can be overridden by --deliberately except for an admin prohib taint
  45 #
  46 # ALL of the following apply only if history is secret:
  47 #
  48 # if NEW has no version, or a version which is not in our history[1]
  49 #   (always)
  50 #   check all suites
  51 #   if any suite's version is in our history[1], publish our history
  52 #   otherwise discard our history,
  53 #     tainting --deliberately-include-questionable-history
  54 #
  55 # if NEW has a version which is in our history[1]
  56 #   (on push only)
  57 #   require explicit specification of one of
  58 #     --deliberately-include-questionable-history
  59 #     --deliberately-not-fast-forward
  60 #       (latter will taint old NEW version --d-i-q-h)
  61 #   (otherwise)
  62 #   leave it be
  63 #
  64 # [1] looking for the relevant git tag for the version number and not
  65 #    caring what that tag refers to.
  66 #
  67 # A wrinkle: if we approved a push recently, we treat NEW as having
  68 # a version which is in our history.  This is because the package may
  69 # still be being uploaded.  (We record this using the timestamp of the
  70 # package's git repo directory.)
  71
  72
  73 sub poldb_setup () {
  74     $poldbh = DBI->connect($policydb,'','', {
  75         RaiseError=>1, PrintError=>1, AutoCommit=>0
  76                            });
  77     $poldbh->do("PRAGMA foreign_keys = ON");
  78
  79     $poldbh->do(<<END);
  80         CREATE TABLE IF NOT EXISTS taints (
  81             taint_id   INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT,
  82             package    TEXT    NOT NULL,
  83             gitobjid   TEXT    NOT NULL,
  84             comment    TEXT    NOT NULL,
  85             time       INTEGER,
  86             gitobjtype TEXT,
  87             gitobjdata TEXT
  88             )
  89 END
  90     $poldbh->do(<<END);
  91         CREATE INDEX IF NOT EXISTS taints_by_package
  92             ON taints (package, gitobject)
  93 END
  94     # any one of of the listed deliberatelies will override its taint
  95     $poldbh->do(<<END);
  96         CREATE TABLE IF NOT EXISTS taintoverrides (
  97             taint_id  INTEGER NOT NULL
  98                       REFERENCES taints (taint_id)
  99                           ON UPDATE RESTRICT
 100                           ON DELETE CASCADE
 101                       DEFERRABLE INITIALLY DEFERRED,
 102             deliberately TEXT NOT NULL,
 103             PRIMARY KEY (taint_id, deliberately)
 104         )
 105 END
 106 }
 107
 108 sub poldb_commit () {
 109     $poldbh->commit;
 110 }
 111
 112 sub apiquery ($) {
 113     my ($subpath) = @_;
 114     local $/=undef;
 115     $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
 116     defined $json or die "$subpath $! $?";
 117     return decode_json $json;
 118 }
 119
 120 sub specific_suite_has_vsn_in_our_history ($) {
 121     my ($suite) = @_;
 122     my $in_new = apiquery "/dsc_in_suite/$suite/$pkg";
 123     foreach my $entry (@$in_new) {
 124         my $vsn = $entry->{version};
 125         die "$pkg ?" unless defined $vsn;
 126         my $tag = debiantag $vsn;
 127         $?=0; my $r = system qw(git show-ref --verify --quiet), $tag;
 128         return 1 if !$r;
 129         next if $r==256;
 130         die "$pkg tag $tag $? $!";
 131     }
 132     return 0;
 133 }
 134
 135 sub new_has_vsn_in_our_history () {
 136     stat $pkgdir or die "$pkgdir $!";
 137     my $mtime = ((stat _)[9]);
 138     my $age = time -  $mtime;
 139     return 1 if $age < $new_upload_propagation_slop;
 140     return specific_suite_has_vsn_in_our_history('new');
 141 }
 142
 143 sub good_suite_has_vsn_in_our_history () {
 144     my $suites = apiquery "/suites";
 145     foreach my $suitei (@$suites) {
 146         my $suite = $suitei->{name};
 147         die unless defined $suite;
 148         next if $suite =~ m/\bnew$/;
 149         return 1 if specific_suite_has_vsn_in_our_history($suite);
 150     }
 151     return 0;
 152 }
 153
 154 sub getpackage () {
 155     die unless @ARGV > 1;
 156     $pkg = shift @ARGV;
 157     die if $pkg =~ m#[^-+.0-9a-z]#;
 158     die unless $pkg =~ m#^[^-]#;
 159
 160     $pkgdir = "$repos/$pkg";
 161     if (!stat $pkgdir) {
 162         die "$pkgdir $!" unless $!==ENOENT;
 163         $pkg_exists = 0;
 164     }
 165     $pkg_exists = 1;
 166     $pkg_secret = !!(~(stat _)[2] & 05);
 167 }
 168
 169 sub add_taint ($$) {
 170     my ($gitobjid, $gitobjtype, $reason) = @_;
 171
 172     my $tf = new File::Temp or die $!;
 173     print $tf "$gitobjid\n" or die $!;
 174
 175     my $gcfpid = open GCF, "-|";
 176     defined $gcfpid or die $!;
 177     if (!$gcfpid) {
 178         open STDIN, "<&", $tf or die $!;
 179         exec 'git', 'cat-file';
 180         die $!;
 181     }
 182
 183     close $tf or die $!;
 184     $_ = <GCF>;
 185     m/^(\w+) (\w+) (\d+)\n/ or die "$objline ?";
 186     $1 eq $gitobjid or die "$! $gitobjid ?";
 187     $2 eq $gitobjtype or die "$! $gitobjtype ?";
 188     my $bytes = $3;
 189
 190     my $gitobjdata;
 191     $!=0; read GCF, $gitobjdata, $bytes == $bytes or die "$gitobjid $bytes $!";
 192     close GCF;
 193
 194     $poldbh->do("INSERT INTO taints".
 195                 " (package, gitobjid, gitobjtype, gitobjdata, time, comment)",
 196                 " VALUES (?,?,?,?,?,?)", {},
 197                 $pkg, $gitobjid, $gitobjtype, $gitobjdata, time, $reason);
 198
 199     my $taint_id = $poldbh->last_insert_id(undef,undef,"taints","taint_id");
 200     die unless defined $taint_id;
 201
 202     $poldbh->do("INSERT INTO taintoverrides".
 203                 " (taint_id, 'include-questionable-history')",
 204                 " VALUES (?)", {},
 205                 $taint_id);
 206 }
 207
 208
 209 sub action__check_package () {
 210     getpackage();
 211     return 0 unless $pkg_exists;
 212     return 0 unless $pkg_secret;
 213
 214     chdir $pkgdir or die "$pkgdir $!";
 215     return if new_has_vsn_in_our_history();
 216
 217     if (good_suite_has_vsn_in_our_history) {
 218         chmod $publicmode, "." or die $!;
 219         return 0;
 220     }
 221
 222     open TAGL, "git for-each-ref '[r]efs/tags/*' |" or die $!;
 223     while (<TAGL>) {
 224         m#^(\w+) (\w+) (refs/tags/\S+)\s# or die "$_ ?";
 225         add_taint($1,$2,
 226                   "tag $3 referred to this object in git tree but all".
 227                   " previously pushed versions were found to have been".
 228                   " removed from NEW (ie, rejected) (or never arrived)");
 229     }
 230     $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";
 231
 232     return FRESHREPO;
 233 }
 234
 235 sub action_push () {
 236     # we suppose that NEW has a version which is already in our
 237     # history, as otherwise the repo would have been blown away
 238
 239     getpackage();
 240     return 0 unless $pkg_exists;
 241     return 0 unless $pkg_secret;
 242
 243     xxx up to here
 244 }
 245
 246
 247
 248 if (defined $pkg) {
 249     selectpackage;
 250 }
 251
 252 my $fn = ${*::}{"action__$cmd"};
 253 $fn or die "unknown ACTION";
 254
 255 poldb_setup();
 256
 257 my $rcode = $fn->();
 258 die unless defined $rcode;
 259
 260 poldb_commit();
 261 exit $rcode;