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_by_tag ($$$) {
 172     my ($tagname, $refobjid, $refobjtype) = @_;
 173
 174     my $tf = new File::Temp or die $!;
 175     print $tf "$refobjid^0\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     my $gitobjid = $1;
 189     my $gitobjtype = $2;
 190     my $bytes = $3;
 191
 192     my $gitobjdata;
 193     if ($gitobjtype eq 'commit' or $gitobjtype eq 'tag') {
 194         $!=0; read GCF, $gitobjdata, $bytes == $bytes
 195             or die "$gitobjid $bytes $!";
 196     }
 197     close GCF;
 198
 199     my $reason =
 200         "tag $tagname referred to this object in git tree but all".
 201         " previously pushed versions were found to have been".
 202         " removed from NEW (ie, rejected) (or never arrived)";
 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, 'include-questionable-history')",
 214                 " VALUES (?)", {},
 215                 $taint_id);
 216 }
 217
 218
 219 sub action__check_package () {
 220     getpackage();
 221     return 0 unless $pkg_exists;
 222     return 0 unless $pkg_secret;
 223
 224     chdir $pkgdir or die "$pkgdir $!";
 225     return if new_has_vsn_in_our_history();
 226
 227     if (good_suite_has_vsn_in_our_history) {
 228         chmod $publicmode, "." or die $!;
 229         return 0;
 230     }
 231
 232     git_for_each_ref('refs/tags', sub {
 233         my ($objid,$objtype,$fullrefname,$tagname) = @_;
 234         add_taint_by_tag($tagname,$objid,$objtype);
 235     });
 236     $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";
 237
 238     return FRESHREPO;
 239 }
 240
 241 sub action_push () {
 242     # we suppose that NEW has a version which is already in our
 243     # history, as otherwise the repo would have been blown away
 244
 245     getpackage();
 246     return 0 unless $pkg_exists;
 247     return 0 unless $pkg_secret;
 248
 249     xxx up to here
 250 }
 251
 252
 253
 254 if (defined $pkg) {
 255     selectpackage;
 256 }
 257
 258 my $fn = ${*::}{"action__$cmd"};
 259 $fn or die "unknown ACTION";
 260
 261 poldb_setup();
 262
 263 my $rcode = $fn->();
 264 die unless defined $rcode;
 265
 266 poldb_commit();
 267 exit $rcode;