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
|
#!/usr/bin/perl
#
# pr-removes-fixed-skips - if PR says "Fixes: #123", no skips should mention 123
#
package Podman::CI::PrRemovesFixedSkips;
use v5.14;
use utf8;
# Grumble. CI system doesn't have 'open'
binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
use strict;
use warnings;
(our $ME = $0) =~ s|.*/||;
our $VERSION = '0.1';
###############################################################################
# BEGIN boilerplate args checking, usage messages
sub usage {
print <<"END_USAGE";
Usage: $ME [OPTIONS]
$ME reads a GitHub PR message, looks for
Fixed/Resolved/Closed issue IDs, then greps for test files
containing 'Skip' instructions or FIXME comments referencing
those IDs. If we find any, we abort with a loud and hopefully
useful message.
$ME is intended to run from Cirrus CI.
OPTIONS:
--help display this message
--version display program name and version
END_USAGE
exit;
}
# Command-line options. Note that this operates directly on @ARGV !
our $debug = 0;
sub handle_opts {
use Getopt::Long;
GetOptions(
'debug!' => \$debug,
help => \&usage,
version => sub { print "$ME version $VERSION\n"; exit 0 },
) or die "Try `$ME --help' for help\n";
}
# END boilerplate args checking, usage messages
###############################################################################
############################## CODE BEGINS HERE ###############################
# The term is "modulino".
__PACKAGE__->main() unless caller();
# Main code.
sub main {
# Note that we operate directly on @ARGV, not on function parameters.
# This is deliberate: it's because Getopt::Long only operates on @ARGV
# and there's no clean way to make it use @_.
handle_opts(); # will set package globals
die "$ME: This script takes no arguments; try $ME --help\n" if @ARGV;
# Check commit messages from both github and git; they often differ
my @issues = fixed_issues(cirrus_change_message(), git_commit_messages())
or exit 0;
my @found = unremoved_skips(@issues)
or exit 0;
# Found unremoved skips. Fail loudly.
my $issues = "issue #$issues[0]";
if (@issues > 1) {
$issues = "issues #" . join ", #", @issues;
}
warn "$ME: Your PR claims to resolve $issues\n";
warn " ...but does not remove associated Skips/FIXMEs:\n";
warn "\n";
warn " $_\n" for @found;
warn "\n";
warn <<"END_ADVICE";
Please do not leave Skips or FIXMEs for closed issues.
If an issue is truly fixed, please remove all Skips referencing it.
If an issue is only PARTIALLY fixed, please file a new issue for the
remaining problem, and update remaining Skips to point to that issue.
And if the issue is fixed but the Skip needs to remain for other
reasons, again, please update the Skip message accordingly.
END_ADVICE
exit 1;
}
#####################
# unremoved_skips # Returns list of <path>:<lineno>:<skip string> matches
#####################
sub unremoved_skips {
my $issues = join('|', @_);
my $re = "(^\\s\+skip|fixme).*#($issues)[^0-9]";
# FIXME FIXME FIXME: use File::Find instead of enumerating directories
# (the important thing here is to exclude vendor)
my @grep = ('egrep', '-rin', $re, "test", "cmd", "libpod", "pkg");
my @skips;
open my $grep_fh, '-|', @grep
or die "$ME: Could not fork: $!\n";
while (my $line = <$grep_fh>) {
chomp $line;
# e.g., test/system/030-run.bats:809: skip "FIXME: #12345 ..."
$line =~ m!^(\S+):\d+:\s!
or die "$ME: Internal error: output from grep does not match <path>:<lineno>:<space>: '$line'";
my $path = $1;
# Any .go or .bats file, or the apply-podman-deltas script
if ($path =~ /\.(go|bats)$/ || $path =~ m!/apply-podman-deltas$!) {
push @skips, $line;
}
# Anything else is probably a backup file, or something else
# we don't care about. (We won't see these in CI, but might
# in a user devel environment)
elsif ($debug) {
print "[ ignoring: $line ]\n";
}
}
close $grep_fh;
return sort @skips;
}
##################
# fixed_issues # Parses change message, looks for Fixes/Closes/Resolves
##################
sub fixed_issues {
my @issues;
for my $msg (@_) {
# https://docs.github.com/en/issues/tracking-your-work-with-issues/linking-a-pull-request-to-an-issue#linking-a-pull-request-to-an-issue-using-a-keyword
#
# 1 1 2 2
while ($msg =~ /\b(Fix|Clos|Resolv)[esd]*[:\s]+\#(\d+)/gis) {
# Skip dups: we're probably checking both github and git messages
push @issues, $2
unless grep { $_ eq $2 } @issues;
}
}
return @issues;
}
###########################
# cirrus_change_message # this is the one from *GitHub*, not *git*
###########################
sub cirrus_change_message {
my $change_message = $ENV{CIRRUS_CHANGE_MESSAGE}
or do {
# OK for it to be unset if we're not running CI on a PR
return if ! $ENV{CIRRUS_PR};
# But if we _are_ running on a PR, something went badly wrong.
die "$ME: \$CIRRUS_CHANGE_MESSAGE is undefined\n";
};
return $change_message;
}
#########################
# git_commit_messages # the ones from the *git history*
#########################
sub git_commit_messages {
# Probably the same as HEAD, but use Cirrus-defined value if available
my $head = $ENV{CIRRUS_CHANGE_IN_REPO} || 'HEAD';
# Base of this PR. Here we absolutely rely on cirrus.
return if ! $ENV{DEST_BRANCH};
chomp(my $base = qx{git merge-base $ENV{DEST_BRANCH} $head});
qx{git log --format=%B $base..$head};
}
1;
|
