summaryrefslogtreecommitdiff
path: root/infra/dgit-repos-policy-debian
blob: 0f9d70f514edcd62431465132d29c1de10874fea (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
#!/usr/bin/perl -w
# dgit repos policy hook script for Debian
#
# usages:
#   dgit-repos-policy-debian DISTRO DGIT-REPOS-DIR ACTION...
# ie.
#   dgit-repos-policy-debian ... check-list [...]
#   dgit-repos-policy-debian ... check-package PACKAGE [...]
#   dgit-repos-policy-debian ... push PACKAGE \
#         VERSION SUITE TAGNAME DELIBERATELIES [...]
#
# cwd for push is a temporary repo where the to-be-pushed objects have
#  been received; TAGNAME is the version-based tag
#
# if push requested FRESHREPO, push-confirm happens in said fresh repo
#
# policy hook for a particular package will be invoked only once at
# a time

use strict;
use POSIX;
use JSON;
use File::Temp;

use Debian::Dgit qw(:DEFAULT :policyflags);

our $distro = shift @ARGV // die "need DISTRO";
our $repos = shift @ARGV // die "need DGIT-REPOS-DIR";
our $action = shift @ARGV // die "need ACTION";

our $publicmode = 02775;
our $policydb = "dbi:SQLite:$repos/policy";
our $new_upload_propagation_slop = 3600*4 + 100;

our $poldbh;
our $pkg;
our $pkgdir;
our ($pkg_exists,$pkg_secret);

# We assume that it is not possible for NEW to have a version older
# than sid.

# Whenever pushing, we check for
#   source-package-local tainted history
#   global tainted history
#   can be overridden by --deliberately except for an admin prohib taint
# 
# ALL of the following apply only if history is secret:
# 
# if NEW has no version, or a version which is not in our history[1]
#   (always)
#   check all suites
#   if any suite's version is in our history[1], publish our history
#   otherwise discard our history,
#     tainting --deliberately-include-questionable-history
# 
# if NEW has a version which is in our history[1]
#   (on push only)
#   require explicit specification of one of
#     --deliberately-include-questionable-history
#     --deliberately-not-fast-forward
#       (latter will taint old NEW version --d-i-q-h)
#   (otherwise)
#   leave it be
# 
# [1] looking for the relevant git tag for the version number and not
#    caring what that tag refers to.
#
# A wrinkle: if we approved a push recently, we treat NEW as having
# a version which is in our history.  This is because the package may
# still be being uploaded.  (We record this using the timestamp of the
# package's git repo directory.)


sub poldb_setup () {
    $poldbh = DBI->connect($policydb,'','', {
	RaiseError=>1, PrintError=>1, AutoCommit=>0
			   });
    $poldbh->do("PRAGMA foreign_keys = ON");

    $poldbh->do(<<END);
	CREATE TABLE IF NOT EXISTS taints (
	    taint_id   INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT,
	    package    TEXT    NOT NULL,
	    gitobjid   TEXT    NOT NULL,
	    comment    TEXT    NOT NULL,
	    time       INTEGER,
	    gitobjtype TEXT,
	    gitobjdata TEXT
	    )
END
    $poldbh->do(<<END);
	CREATE INDEX IF NOT EXISTS taints_by_package
	    ON taints (package, gitobject)
END
    # any one of of the listed deliberatelies will override its taint
    $poldbh->do(<<END);
	CREATE TABLE IF NOT EXISTS taintoverrides (
	    taint_id  INTEGER NOT NULL
		      REFERENCES taints (taint_id)
			  ON UPDATE RESTRICT
			  ON DELETE CASCADE
		      DEFERRABLE INITIALLY DEFERRED,
	    deliberately TEXT NOT NULL,
	    PRIMARY KEY (taint_id, deliberately)
	)
END
}

sub poldb_commit () {
    $poldbh->commit;
}

sub apiquery ($) {
    my ($subpath) = @_;
    local $/=undef;
    $!=0; $?=0; my $json = `dgit -d $distro archive-api-query $subpath`;
    defined $json or die "$subpath $! $?";
    return decode_json $json;
}

sub specific_suite_has_vsn_in_our_history ($) {
    my ($suite) = @_;
    my $in_new = apiquery "/dsc_in_suite/$suite/$pkg";
    foreach my $entry (@$in_new) {
	my $vsn = $entry->{version};
	die "$pkg ?" unless defined $vsn;
	my $tag = debiantag $vsn;
	$?=0; my $r = system qw(git show-ref --verify --quiet), $tag;
	return 1 if !$r;
	next if $r==256;
	die "$pkg tag $tag $? $!";
    }
    return 0;
}

sub new_has_vsn_in_our_history () {
    stat $pkgdir or die "$pkgdir $!";
    my $mtime = ((stat _)[9]);
    my $age = time -  $mtime;
    return 1 if $age < $new_upload_propagation_slop;
    return specific_suite_has_vsn_in_our_history('new');
}

sub good_suite_has_vsn_in_our_history () {
    my $suites = apiquery "/suites";
    foreach my $suitei (@$suites) {
	my $suite = $suitei->{name};
	die unless defined $suite;
	next if $suite =~ m/\bnew$/;
	return 1 if specific_suite_has_vsn_in_our_history($suite);
    }
    return 0;
}

sub getpackage () {
    die unless @ARGV > 1;
    $pkg = shift @ARGV;
    die if $pkg =~ m#[^-+.0-9a-z]#;
    die unless $pkg =~ m#^[^-]#;

    $pkgdir = "$repos/$pkg";
    if (!stat $pkgdir) {
	die "$pkgdir $!" unless $!==ENOENT;
	$pkg_exists = 0;
    }
    $pkg_exists = 1;
    $pkg_secret = !!(~(stat _)[2] & 05);
}

sub add_taint_by_tag ($$$) {
    my ($tagname, $refobjid, $refobjtype) = @_;

    my $tf = new File::Temp or die $!;
    print $tf "$refobjid^0\n" or die $!;

    my $gcfpid = open GCF, "-|";
    defined $gcfpid or die $!;
    if (!$gcfpid) {
	open STDIN, "<&", $tf or die $!;
	exec 'git', 'cat-file';
	die $!;
    }

    close $tf or die $!;
    $_ = <GCF>;
    m/^(\w+) (\w+) (\d+)\n/ or die "$objline ?";
    my $gitobjid = $1;
    my $gitobjtype = $2;
    my $bytes = $3;

    my $gitobjdata;
    if ($gitobjtype eq 'commit' or $gitobjtype eq 'tag') {
	$!=0; read GCF, $gitobjdata, $bytes == $bytes
	    or die "$gitobjid $bytes $!";
    }
    close GCF;

    my $reason =
	"tag $tagname referred to this object in git tree but all".
	" previously pushed versions were found to have been".
	" removed from NEW (ie, rejected) (or never arrived)";

    $poldbh->do("INSERT INTO taints".
		" (package, gitobjid, gitobjtype, gitobjdata, time, comment)",
		" VALUES (?,?,?,?,?,?)", {},
		$pkg, $gitobjid, $gitobjtype, $gitobjdata, time, $reason);

    my $taint_id = $poldbh->last_insert_id(undef,undef,"taints","taint_id");
    die unless defined $taint_id;

    $poldbh->do("INSERT INTO taintoverrides".
		" (taint_id, 'include-questionable-history')",
		" VALUES (?)", {},
		$taint_id);
}


sub action__check_package () {
    getpackage();
    return 0 unless $pkg_exists;
    return 0 unless $pkg_secret;

    chdir $pkgdir or die "$pkgdir $!";
    return if new_has_vsn_in_our_history();

    if (good_suite_has_vsn_in_our_history) {
	chmod $publicmode, "." or die $!;
	return 0;
    }

    git_for_each_ref('refs/tags', sub {
	my ($objid,$objtype,$fullrefname,$tagname) = @_;
	add_taint_by_tag($tagname,$objid,$objtype);
    });
    $?=0; $!=0; close TAGL or die "git for-each-ref $? $!";

    return FRESHREPO;
}

sub action_push () {
    # we suppose that NEW has a version which is already in our
    # history, as otherwise the repo would have been blown away

    getpackage();
    return 0 unless $pkg_exists;
    return 0 unless $pkg_secret;

    xxx up to here
}



if (defined $pkg) {
    selectpackage;
}

my $fn = ${*::}{"action__$cmd"};
$fn or die "unknown ACTION";

poldb_setup();

my $rcode = $fn->();
die unless defined $rcode;

poldb_commit();
exit $rcode;