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