testconfig_enforcer: allow specifying reviewers on the command-line
[qt:qtqa.git] / scripts / generic / testconfig_enforcer.pl
1 #!/usr/bin/env perl
2 #############################################################################
3 ##
4 ## Copyright (C) 2012 Digia Plc and/or its subsidiary(-ies).
5 ## Contact: http://www.qt-project.org/legal
6 ##
7 ## This file is part of the Quality Assurance module of the Qt Toolkit.
8 ##
9 ## $QT_BEGIN_LICENSE:LGPL$
10 ## Commercial License Usage
11 ## Licensees holding valid commercial Qt licenses may use this file in
12 ## accordance with the commercial license agreement provided with the
13 ## Software or, alternatively, in accordance with the terms contained in
14 ## a written agreement between you and Digia.  For licensing terms and
15 ## conditions see http://qt.digia.com/licensing.  For further information
16 ## use the contact form at http://qt.digia.com/contact-us.
17 ##
18 ## GNU Lesser General Public License Usage
19 ## Alternatively, this file may be used under the terms of the GNU Lesser
20 ## General Public License version 2.1 as published by the Free Software
21 ## Foundation and appearing in the file LICENSE.LGPL included in the
22 ## packaging of this file.  Please review the following information to
23 ## ensure the GNU Lesser General Public License version 2.1 requirements
24 ## will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.
25 ##
26 ## In addition, as a special exception, Digia gives you certain additional
27 ## rights.  These rights are described in the Digia Qt LGPL Exception
28 ## version 1.1, included in the file LGPL_EXCEPTION.txt in this package.
29 ##
30 ## GNU General Public License Usage
31 ## Alternatively, this file may be used under the terms of the GNU
32 ## General Public License version 3.0 as published by the Free Software
33 ## Foundation and appearing in the file LICENSE.GPL included in the
34 ## packaging of this file.  Please review the following information to
35 ## ensure the GNU General Public License version 3.0 requirements will be
36 ## met: http://www.gnu.org/copyleft/gpl.html.
37 ##
38 ##
39 ## $QT_END_LICENSE$
40 ##
41 #############################################################################
42
43 use strict;
44 use warnings;
45 use v5.10;
46
47 =head1 NAME
48
49 testconfig_enforcer - set Qt CI test configurations enforcing when appropriate
50
51 =head1 SYNOPSIS
52
53   # from a daily cron job, or similar...
54   ./testconfig_enforcer.pl --testconfig-path [path to local qtqa/testconfig]
55
56 Check the latest test results on testresults.qt-project.org, cross-reference
57 with the settings in the testconfig repository, and push a commit removing
58 any appropriate `forcesuccess' or `*insignificant*' properties.
59
60 =head2 OPTIONS
61
62 =over
63
64 =item --testconfig-path PATH
65
66 Path to a local clone of the qtqa/testconfig repository.
67 This must exist prior to running the script.
68
69 =item --no-update
70
71 If set, do not attempt to update the local testconfig clone to the newest
72 version.
73
74 =item --dry-run
75
76 If set, use `--dry-run' when performing the git push to gerrit; in other words,
77 the commit is not actually pushed. A `git log' in the local testconfig repository
78 will show what would have been pushed.
79
80 =item --reviewer <reviewer1> [ --reviewer <reviewer2> ... ]
81
82 =item -r <reviewer1> [ -r <reviewer2> ... ]
83
84 Add the named reviewer(s) to the change in gerrit.
85 Reviewers may be specified by email address or username.
86
87 =item --random
88
89 Randomly remove some properties regardless of the test results.
90
91 For testing purposes only (i.e. to make it likely that the script will decide
92 to do something, since the stable state is always that there is nothing to do).
93
94 =item --author-only
95
96 When creating the git commit, only set the git author field to this script's
97 identity; don't set the git committer field.
98
99 Use this if pushing to gerrit fails due to missing "forge identity" permissions.
100
101 =item --man
102
103 Show extended documentation (man page).
104
105 =back
106
107 =head1 DESCRIPTION
108
109 When introducing new test configurations into the Qt Project CI system, the
110 standard practice is to first introduce the configurations in a non-enforcing
111 mode, then progressively set configurations enforcing for each project as they
112 are verified passing. The latter can be partially automated by this script,
113 which performs roughly the following steps:
114
115 =over
116
117 =item *
118
119 updates the qtqa/testconfig repository to the latest version
120
121 =item *
122
123 enumerates all properties under qtqa/testconfig which represent a non-enforcing
124 (or partially non-enforcing) test configuration - e.g. forcesuccess, qt.tests.insignificant
125
126 =item *
127
128 for each non-enforcing test configuration, the latest successful test log is downloaded
129 from testresults.qt-project.org and scanned; if the log indicates that the test
130 configuration would pass if it were enforcing, the appropriate files are removed from
131 the local copy of qtqa/testconfig
132
133 =item *
134
135 local changes to qtqa/testconfig are committed and pushed to gerrit for review
136
137 =back
138
139 The script attempts to re-use the same Change-Id for each commit until that commit
140 is accepted; for example, if run daily and nobody reviews the generated commits
141 for three days, there will be one change with three patch sets rather than three
142 changes.
143
144 =cut
145
146 package QtQA::QtTestconfigEnforcer;
147
148 use Const::Fast;
149 use English qw(-no_match_vars);
150 use File::Basename;
151 use File::Find::Rule;
152 use File::chdir;
153 use Getopt::Long qw(GetOptionsFromArray);
154 use LWP::UserAgent::Determined;
155 use Memoize;
156 use Pod::Usage;
157 use Text::Wrap;
158 use autodie;
159
160 use FindBin;
161 use lib "$FindBin::Bin/../lib/perl5";
162
163 use QtQA::Gerrit;
164
165 const my $CI_BASE_URL => 'http://testresults.qt-project.org/ci';
166
167 const my $BOT_NAME => 'Qt Testconfig Enforcer Bot';
168
169 const my @UNDESIRABLES => qw(
170     forcesuccess
171     qt.tests.insignificant
172     qt.qtqa-tests.insignificant
173 );
174
175 const my $MAGIC_REMOVE_PATTERN => qr{This may indicate it is safe to remove ["']?([a-zA-Z0-9\-_\.]+)["']?\.};
176
177 const my $GERRIT_SERVER => 'codereview.qt-project.org';
178 const my $GERRIT_PORT => 29418;
179 const my $GERRIT_PROJECT => 'qtqa/testconfig';
180 const my $GERRIT_URL => "ssh://$GERRIT_SERVER:$GERRIT_PORT/$GERRIT_PROJECT";
181 const my $GERRIT_SRC_REF => 'refs/heads/master';
182 const my $GERRIT_DEST_REF => 'refs/for/master';
183
184 my $RAND = 0;
185
186 # system(), but die on failure
187 sub exe
188 {
189     my (@cmd) = @_;
190     system( @cmd );
191     if ($? != 0) {
192         die "@cmd exited with status $?";
193     }
194 }
195
196 # Returns all files which need to be checked for deletion
197 sub find_files_to_check
198 {
199     return File::Find::Rule
200         ->file( )
201         ->name( @UNDESIRABLES )
202         ->in( 'projects' );
203 }
204
205 # Given a property filename, returns a tuple of
206 # ($project, $stage, $property)
207 sub parse_filename
208 {
209     my ($file) = @_;
210     return unless $file =~ m{
211         projects/
212         ([^/]+)
213         /stages/
214         ([^/]+)
215         /(?:properties/)?
216         ([^/]+)
217         \z
218     }xms;
219
220     return ($1, $2, $3);
221 }
222
223 # Returns the URL of the latest successful build of a given project and stage
224 sub latest_log_url
225 {
226     my ($project, $stage) = @_;
227     return "$CI_BASE_URL/$project/latest-success/$stage/log.txt.gz";
228 }
229
230 # Return content of the given $url, or an empty string if the resource
231 # doesn't exist (e.g. a test configuration which has never been executed)
232 sub get_content_from_url
233 {
234     my ($url) = @_;
235     my $browser = LWP::UserAgent::Determined->new( );
236     my $response = $browser->get( $url );
237     if ($response->is_success) {
238         return $response->decoded_content;
239     } elsif ($response->code( ) == 404) {
240         # Treat 404 non-fatal, it generally means the stage hasn't been run yet.
241         return q{};
242     }
243     die $response->decoded_content;
244 }
245
246 # Returns a set of all testconfig properties (basename only) which appear
247 # to be safely removable according to the log at $url.
248 # The returned set may include 'forcesuccess', although that is technically
249 # not a property.
250 sub removable_properties
251 {
252     my ($url) = @_;
253     my $data = get_content_from_url( $url );
254     my %out;
255
256     while ($data =~ m{$MAGIC_REMOVE_PATTERN}g) {
257         ++$out{ $1 };
258     }
259
260     return %out;
261 }
262 # memoize to avoid needlessly fetching and scanning the log multiple times
263 memoize( 'removable_properties' );
264
265 # Calculates if the given property $file should be removed.
266 # If so, returns the URL used as evidence for removal of the file; otherwise,
267 # returns nothing.
268 # May fetch logs from testresults.
269 sub should_remove
270 {
271     my ($file) = @_;
272     my ($project, $stage, $key) = parse_filename( $file );
273
274     if (!$key) {
275         # some uncheckable special case.
276         return;
277     }
278
279     my $url = latest_log_url( $project, $stage );
280
281     # for test purposes
282     if ($RAND && int(rand(5)) == 1) {
283         return $url;
284     }
285
286     my %removable = removable_properties( $url );
287     if ($removable{ $key }) {
288         return $url;
289     }
290     return;
291 }
292
293 # Given a list of files @to_check, checks them all and returns
294 # a hash of the form:
295 #   (
296 #       "url1" => [ "file1", "file2", ...],
297 #       "url2" => [ "file3", ... ],
298 #       ...
299 #   )
300 # ... where the returned filenames represent property files to be removed,
301 # and the returned URLs contain the evidence used to decide that they should
302 # be removed.
303 sub find_files_to_remove
304 {
305     my (@to_check) = @_;
306     my %logs;
307
308     foreach my $file (@to_check) {
309         {
310             local $OUTPUT_AUTOFLUSH = 1;
311             print "$file ... ";
312         }
313         if (my ($url) = should_remove( $file )) {
314             print "can be removed :)\n";
315             push @{ $logs{ $url } }, $file;
316         } else {
317             print "needs to stay for now :(\n";
318         }
319     }
320
321     return %logs;
322 }
323
324 # Given output from find_files_to_remove,
325 # creates a git commit which removes said files,
326 # with a reasonable commit message.
327 #
328 # Returns a ($change_id, $sha1) tuple for the generated commit
329 # (which is guaranteed to be at HEAD when the function returns).
330 sub create_git_commit
331 {
332     my (%to_remove) = @_;
333     my %projects;
334
335     my @all_files = map { @{$_} } values %to_remove;
336     foreach my $file (@all_files) {
337         exe( qw(git rm -f), $file );
338         my ($project) = parse_filename( $file );
339         # "QtBase_master_Integration" => "QtBase"
340         ($project) = split(/_/, $project);
341         ++$projects{ $project };
342     }
343
344     my @projects = sort keys %projects;
345
346     # We say 'some configs' if there's more than one file removed.
347     # If there's only one file removed, we try to get it directly in the summary,
348     # e.g.
349     #
350     #  QtBase: set win32-msvc2010 enforcing
351     #
352     my $some_configs = 'some configs';
353     my $these_are = 'These are';
354     my $they_stay = 'they stay';
355     if (@all_files == 1) {
356         my (undef, $stage) = parse_filename( $all_files[0] );
357         $some_configs = $stage;
358         $some_configs =~ s/_/ /g;
359         $these_are = 'This is';
360         $they_stay = 'it stays';
361     }
362
363     local $LIST_SEPARATOR = ', ';
364     my $message_summary = "@projects: set $some_configs enforcing";
365     my $message_body = "$these_are passing.  Make sure $they_stay that way.";
366
367     if (length( $message_summary ) > 75) {
368         # If we can't reasonably fit all affected projects into the oneline summary,
369         # put them in the body instead.
370         $message_summary = 'Set various configurations enforcing';
371         local $Text::Wrap::columns = 75;
372         $message_body = wrap(
373             q{},
374             q{},
375             "These configs on @projects are passing.  Make sure they stay that way."
376         );
377     }
378
379     my $change_id = QtQA::Gerrit::next_change_id( );
380     $message_body .= "\n\nChange-Id: $change_id";
381
382     {
383         no autodie qw(open);  # autodie open doesn't support |- by default
384         open( my $fh, '|-', qw(git commit -F -) ) || die "open git commit: $!";
385         print $fh "$message_summary\n\n$message_body";
386         close( $fh ) || die "close git commit: $! ($?)";
387     }
388
389     my $sha1 = qx(git rev-parse HEAD);
390     chomp $sha1;
391
392     return ($change_id, $sha1);
393 }
394
395 # Add a message to the commit $sha1 in gerrit.
396 # The message will advise the approver(s) to check all relevant logs
397 # (according to the values in %removed) before accepting the change.
398 #
399 # This is important because some test configurations which were passing
400 # at the time the commit was generated might become failing by the time
401 # the commit is reviewed.
402 sub add_gerrit_message
403 {
404     my ($sha1, %removed) = @_;
405     my $message = "Before submitting, please check these logs:";
406
407     while (my ($url, $files_ref) = each %removed) {
408         local $LIST_SEPARATOR = ', ';
409         my @properties = map { basename($_) } @{ $files_ref };
410         $message .= "\n\n* $url (@properties)";
411     }
412
413     my $cv = AE::cv();
414     QtQA::Gerrit::review(
415         $sha1,
416         url => $GERRIT_URL,
417         message => $message,
418         project => $GERRIT_PROJECT,
419         on_success => sub { $cv->send() },
420         on_error => sub { $cv->croak(@_) },
421     );
422     $cv->recv();
423
424     return;
425 }
426
427 sub new
428 {
429     my ($self, @args) = @_;
430     my $out = bless {
431         update => 1,
432     }, $self;
433
434     GetOptionsFromArray( \@args,
435         'h|help|?' => sub { pod2usage(1) },
436         'man' => sub { pod2usage(-verbose => 2) },
437         'testconfig-path=s' => \$out->{ testconfig_path },
438         'author-only' => \$out->{ author_only },
439         'update!' => \$out->{ update },
440         'dry-run' => \$out->{ dry_run },
441         'r|reviewer=s@' => \$out->{ reviewers },
442         'random' => \$RAND,
443     ) || die;
444
445     if (!$out->{ testconfig_path }) {
446         die 'missing mandatory --testconfig-path argument';
447     }
448
449     return $out;
450 }
451
452 sub run
453 {
454     my ($self) = @_;
455     local $CWD = $self->{ testconfig_path };
456     local %ENV = QtQA::Gerrit::git_environment(
457         bot_name => $BOT_NAME,
458         author_only => $self->{ author_only },
459     );
460
461     if ($self->{ update }) {
462         exe( qw(git fetch), $GERRIT_URL, $GERRIT_SRC_REF );
463         exe( qw(git reset --hard FETCH_HEAD) );
464     }
465
466     my @to_check = find_files_to_check( );
467     my %to_remove = find_files_to_remove( @to_check );
468
469     if (!%to_remove) {
470         print "Nothing to be done.\n";
471         return;
472     }
473
474     my ($change_id, $sha1) = create_git_commit( %to_remove );
475
476     my @git_push = (
477         qw(git push --verbose),
478         $self->{ dry_run } ? '--dry-run' : (),
479     );
480
481     if (my @reviewers = @{ $self->{ reviewers } || [] }) {
482         push @git_push, "--receive-pack=git receive-pack ".join(' ', map { "--reviewer=$_" } @reviewers);
483     }
484
485     push @git_push, (
486         $GERRIT_URL,
487         "HEAD:$GERRIT_DEST_REF",
488     );
489
490     {
491         local $LIST_SEPARATOR = '] [';
492         print "Running: [@git_push]\n";
493     }
494
495     exe( @git_push );
496
497     if (!$self->{ dry_run }) {
498         add_gerrit_message( $sha1, %to_remove );
499     }
500
501     return;
502 }
503
504 QtQA::QtTestconfigEnforcer->new( @ARGV )->run( ) unless caller;
505 1;