2 # dgit repos policy hook script for Debian
5 # dgit-repos-policy-debian DISTRO DGIT-REPOS-DIR ACTION...
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 [...]
12 # cwd for push is a temporary repo where the to-be-pushed objects have
13 # been received; TAGNAME is the version-based tag
15 # if push requested FRESHREPO, push-confirm happens in said fresh repo
17 # policy hook for a particular package will be invoked only once at
25 use Debian::Dgit qw(:DEFAULT :policyflags);
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";
31 our $publicmode = 02775;
32 our $policydb = "dbi:SQLite:$repos/policy";
33 our $new_upload_propagation_slop = 3600*4 + 100;
38 our ($pkg_exists,$pkg_secret);
40 # We assume that it is not possible for NEW to have a version older
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
48 # ALL of the following apply only if history is secret:
50 # if NEW has no version, or a version which is not in our history[1]
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
57 # if NEW has a version which is in our history[1]
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)
66 # [1] looking for the relevant git tag for the version number and not
67 # caring what that tag refers to.
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.)
76 $poldbh = DBI->connect($policydb,'','', {
77 RaiseError=>1, PrintError=>1, AutoCommit=>0
79 $poldbh->do("PRAGMA foreign_keys = ON");
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,
93 CREATE INDEX IF NOT EXISTS taints_by_package
94 ON taints (package, gitobject)
96 # any one of of the listed deliberatelies will override its taint
98 CREATE TABLE IF NOT EXISTS taintoverrides (
99 taint_id INTEGER NOT NULL
100 REFERENCES taints (taint_id)
103 DEFERRABLE INITIALLY DEFERRED,
104 deliberately TEXT NOT NULL,
105 PRIMARY KEY (taint_id, deliberately)
110 sub poldb_commit () {
117 $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
118 defined $json or die "$subpath $! $?";
119 return decode_json $json;
122 sub specific_suite_has_vsn_in_our_history ($) {
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;
132 die "$pkg tag $tag $? $!";
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');
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);
157 die unless @ARGV > 1;
159 die if $pkg =~ m#[^-+.0-9a-z]#;
160 die unless $pkg =~ m#^[^-]#;
162 $pkgdir = "$repos/$pkg";
164 die "$pkgdir $!" unless $!==ENOENT;
168 $pkg_secret = !!(~(stat _)[2] & 05);
172 my ($gitobjid, $gitobjtype, $reason) = @_;
174 my $tf = new File::Temp or die $!;
175 print $tf "$gitobjid\n" or die $!;
177 my $gcfpid = open GCF, "-|";
178 defined $gcfpid or die $!;
180 open STDIN, "<&", $tf or die $!;
181 exec 'git', 'cat-file';
187 m/^(\w+) (\w+) (\d+)\n/ or die "$objline ?";
188 $1 eq $gitobjid or die "$! $gitobjid ?";
189 $2 eq $gitobjtype or die "$! $gitobjtype ?";
193 $!=0; read GCF, $gitobjdata, $bytes == $bytes or die "$gitobjid $bytes $!";
196 $poldbh->do("INSERT INTO taints".
197 " (package, gitobjid, gitobjtype, gitobjdata, time, comment)",
198 " VALUES (?,?,?,?,?,?)", {},
199 $pkg, $gitobjid, $gitobjtype, $gitobjdata, time, $reason);
201 my $taint_id = $poldbh->last_insert_id(undef,undef,"taints","taint_id");
202 die unless defined $taint_id;
204 $poldbh->do("INSERT INTO taintoverrides".
205 " (taint_id, 'include-questionable-history')",
211 sub action__check_package () {
213 return 0 unless $pkg_exists;
214 return 0 unless $pkg_secret;
216 chdir $pkgdir or die "$pkgdir $!";
217 return if new_has_vsn_in_our_history();
219 if (good_suite_has_vsn_in_our_history) {
220 chmod $publicmode, "." or die $!;
224 open TAGL, "git for-each-ref '[r]efs/tags/*' |" or die $!;
226 m#^(\w+) (\w+) (refs/tags/\S+)\s# or die "$_ ?";
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)");
232 $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";
238 # we suppose that NEW has a version which is already in our
239 # history, as otherwise the repo would have been blown away
242 return 0 unless $pkg_exists;
243 return 0 unless $pkg_secret;
254 my $fn = ${*::}{"action__$cmd"};
255 $fn or die "unknown ACTION";
260 die unless defined $rcode;