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 # policy hook for a particular package will be invoked only once at
23 use Debian::Dgit qw(:DEFAULT :policyflags);
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";
29 our $publicmode = 02775;
30 our $policydb = "dbi:SQLite:$repos/policy";
31 our $new_upload_propagation_slop = 3600*4 + 100;
36 our ($pkg_exists,$pkg_secret);
38 # We assume that it is not possible for NEW to have a version older
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
46 # ALL of the following apply only if history is secret:
48 # if NEW has no version, or a version which is not in our history[1]
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
55 # if NEW has a version which is in our history[1]
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)
64 # [1] looking for the relevant git tag for the version number and not
65 # caring what that tag refers to.
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.)
74 $poldbh = DBI->connect($policydb,'','', {
75 RaiseError=>1, PrintError=>1, AutoCommit=>0
77 $poldbh->do("PRAGMA foreign_keys = ON");
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,
91 CREATE INDEX IF NOT EXISTS taints_by_package
92 ON taints (package, gitobject)
94 # any one of of the listed deliberatelies will override its taint
96 CREATE TABLE IF NOT EXISTS taintoverrides (
97 taint_id INTEGER NOT NULL
98 REFERENCES taints (taint_id)
101 DEFERRABLE INITIALLY DEFERRED,
102 deliberately TEXT NOT NULL,
103 PRIMARY KEY (taint_id, deliberately)
108 sub poldb_commit () {
115 $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
116 defined $json or die "$subpath $! $?";
117 return decode_json $json;
120 sub specific_suite_has_vsn_in_our_history ($) {
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;
130 die "$pkg tag $tag $? $!";
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');
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);
155 die unless @ARGV > 1;
157 die if $pkg =~ m#[^-+.0-9a-z]#;
158 die unless $pkg =~ m#^[^-]#;
160 $pkgdir = "$repos/$pkg";
162 die "$pkgdir $!" unless $!==ENOENT;
166 $pkg_secret = !!(~(stat _)[2] & 05);
170 my ($gitobjid, $gitobjtype, $reason) = @_;
172 my $tf = new File::Temp or die $!;
173 print $tf "$gitobjid\n" or die $!;
175 my $gcfpid = open GCF, "-|";
176 defined $gcfpid or die $!;
178 open STDIN, "<&", $tf or die $!;
179 exec 'git', 'cat-file';
185 m/^(\w+) (\w+) (\d+)\n/ or die "$objline ?";
186 $1 eq $gitobjid or die "$! $gitobjid ?";
187 $2 eq $gitobjtype or die "$! $gitobjtype ?";
191 $!=0; read GCF, $gitobjdata, $bytes == $bytes or die "$gitobjid $bytes $!";
194 $poldbh->do("INSERT INTO taints".
195 " (package, gitobjid, gitobjtype, gitobjdata, time, comment)",
196 " VALUES (?,?,?,?,?,?)", {},
197 $pkg, $gitobjid, $gitobjtype, $gitobjdata, time, $reason);
199 my $taint_id = $poldbh->last_insert_id(undef,undef,"taints","taint_id");
200 die unless defined $taint_id;
202 $poldbh->do("INSERT INTO taintoverrides".
203 " (taint_id, 'include-questionable-history')",
209 sub action__check_package () {
211 return 0 unless $pkg_exists;
212 return 0 unless $pkg_secret;
214 chdir $pkgdir or die "$pkgdir $!";
215 return if new_has_vsn_in_our_history();
217 if (good_suite_has_vsn_in_our_history) {
218 chmod $publicmode, "." or die $!;
222 open TAGL, "git for-each-ref '[r]efs/tags/*' |" or die $!;
224 m#^(\w+) (\w+) (refs/tags/\S+)\s# or die "$_ ?";
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)");
230 $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";
236 # we suppose that NEW has a version which is already in our
237 # history, as otherwise the repo would have been blown away
240 return 0 unless $pkg_exists;
241 return 0 unless $pkg_secret;
252 my $fn = ${*::}{"action__$cmd"};
253 $fn or die "unknown ACTION";
258 die unless defined $rcode;