new file mode 100755
@@ -0,0 +1,121 @@
+#!/usr/bin/perl -w
+#
+# usage:
+# ./mg-force-push BRANCH FLIGHT REVISION
+#
+# works only if BRANCH is
+# valid for ap-fetch and ap-print-url
+# the branch of flight FLIGHT
+
+use strict;
+use warnings;
+
+use Osstest;
+
+my @dryrun;
+
+while (@ARGV && $ARGV[0] =~ m/^-/) {
+ $_ = shift @ARGV;
+ last if $_ eq '-';
+ while (m/^-./) {
+ if (s/^-n/-/ || s/^--dry-run$//) {
+ push @dryrun, qw(echo);
+ } else {
+ die "$_ ?";
+ }
+ }
+}
+
+die unless @ARGV==3;
+
+our ($branch, $flight, $revision) = @ARGV;
+
+csreadconfig();
+
+our $url;
+
+sub db_checks () {
+ my $flt_q = $dbh_tests->prepare(<<END);
+ SELECT branch, blessing
+ FROM flights
+ WHERE flight=?
+END
+ my $rev_q = $dbh_tests->prepare(<<END);
+ WITH rv AS (
+ SELECT *
+ FROM runvars
+ WHERE flight=?
+ )
+ SELECT
+ url.job job,
+ built.name bname,
+ built.val brevision
+ FROM rv url
+ JOIN rv built
+ ON url.job = built.job
+ AND url.name like 'tree_%'
+ AND built.name = 'built_revision_' || substring(url.name, 6)
+ WHERE url.val = ?
+END
+
+ my %revuses;
+ printf "checking revisioins used in %s...\n", $flight;
+
+ db_readonly_report();
+ db_retry($dbh_tests, [], sub {
+ $flt_q->execute($flight);
+ my $flt_row = $flt_q->fetchrow_hashref();
+ $flt_row->{blessing} eq 'real' or die "$flt_row->{blessing} ?";
+ $flt_row->{branch} eq $branch or die "$flt_row->{branch} ?";
+
+ %revuses = ();
+ $rev_q->execute($flight, $url);
+ while (my $rev_row = $rev_q->fetchrow_hashref()) {
+ push @{ $revuses{ $rev_row->{brevision} } }, $rev_row;
+ }
+ });
+
+ die unless $revuses{$revision};
+ my $bad;
+ foreach my $brevision (sort { @{ $revuses{$b} } <=>
+ @{ $revuses{$a} } } keys %revuses) {
+ my $rj = $revuses{$brevision};
+ printf " %s%s %d uses\n", $brevision,
+ ($brevision eq $revision ? ' (ours)' : ''),
+ scalar @$rj;
+ foreach my $use (@$rj) {
+ printf " %-30s %s\n", $use->{job}, $use->{bname};
+ }
+ if (@$rj > @{ $revuses{$revision} }) {
+ printf " ^^ more popular!\n";
+ $bad = 1;
+ }
+ }
+ die "our revision $revision is not most popular in $flight !" if $bad;
+}
+
+sub geturl () {
+ $!=0; $?=0; $url = `./ap-print-url $branch`;
+ die "$? $!" unless chomp $url;
+ printf "tree in flights should be %s\n", $url;
+}
+
+sub runcmd_ordryrun {
+ $!=0; $?=0;
+ print "@_\n" unless @dryrun;
+ system((@dryrun, @_))
+ and die "@dryrun @_ $! $?" if $! or $:
+}
+
+sub fetch () {
+ runcmd_ordryrun qw(./ap-fetch-version), $branch;
+}
+
+sub dopush () {
+ runcmd_ordryrun qw(./ap-push), $branch, $revision;
+}
+
+geturl();
+db_checks();
+fetch();
+dopush();
This does some safety checks and reduces the risk of c&p mistakes. It has to be run as osstest@osstest.test-lab (or equivalent). Signed-off-by: Ian Jackson <ian.jackson@eu.citrix.com> --- mg-force-push | 121 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 121 insertions(+) create mode 100755 mg-force-push