--- /dev/null
+#!/usr/bin/perl -w
+# Mass rebuild packages.
+# Written By Richard W.M. Jones.
+# Copyright (C) 2012 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use Graph::Directed;
+
+#----------------------------------------------------------------------
+# Configuration section.
+
+# The name of the rebuild. This is used in commit messages, and also
+# used to tell if we have rebuilt a package already.
+my $message = "Rebuild for OCaml 4.00.0.";
+
+# These are regular expressions matching all the *source* packages
+# that we want to rebuild.
+my @package_regexps = (
+ qr/\bocaml\b/,
+ qr/^cduce$/,
+ qr/^coccinelle$/,
+ qr/^coq$/,
+ qr/^frama-c$/,
+ qr/^hivex$/,
+ qr/^libguestfs$/,
+ qr/^llvm$/,
+ qr/^plplot$/,
+ qr/^virt-dmesg$/,
+ qr/^virt-top$/,
+ qr/^why$/
+ );
+
+# Packages that match the above regexps, but which you nevertheless
+# want to ignore.
+my @package_ignored = (
+ qr/^ocaml$/,
+ );
+
+# Directory to use when checking out Fedora packages. This directory
+# must exist. Packages are cloned into directories under here. If a
+# directory already exists, then it is updated.
+my $dir = "$ENV{HOME}/d/fedora";
+
+# Branch to perform rebuilds in. ('master' = Rawhide, otherwise 'f17' etc.)
+my $branch = "master";
+
+# End of configuration.
+#----------------------------------------------------------------------
+
+# Get a list of all source package names.
+my @all_source_packages;
+open PIPE, "repoquery --enablerepo=fedora-source -q -a --archlist=src --qf='%{name}' | sort -u |" or die "repoquery: $!";
+while (<PIPE>) {
+ chomp;
+ push @all_source_packages, $_;
+}
+close PIPE or die;
+
+my @packages;
+my $rex;
+foreach $rex (@package_regexps) {
+ foreach (@all_source_packages) {
+ if ($_ =~ $rex) {
+ my $ignore;
+ my $rex2;
+ foreach $rex2 (@package_ignored) {
+ $ignore = 1 if $_ =~ $rex2;
+ }
+ push @packages, $_ unless $ignore;
+ }
+ }
+}
+
+@packages = sort @packages;
+print "packages considered for mass rebuild: ", join (" ", @packages),
+ " (", 0+@packages, " packages)\n";
+
+# Make a hashtable from @packages, so we can quickly tell if a package
+# is in the list.
+my %packages;
+$packages{$_} = 1 foreach @packages;
+
+# Get a list of all binary packages. So that we can relate binary
+# packages to what source they come from, also list the source RPM
+# name for each.
+my @all_binary_packages;
+my %binary_to_source;
+open PIPE, "repoquery -q -a --qf='%{name} %{sourcerpm}' | sort -u |" or die "repoquery: $!";
+while (<PIPE>) {
+ chomp;
+ if (/^(.*) (.*?)-\d/) {
+ push @all_binary_packages, $1;
+ $binary_to_source{$1} = $2;
+ } else {
+ warn "ignored repoquery output: $_\n";
+ }
+}
+close PIPE or die;
+
+# For each package that needs rebuilding, get the dependencies. These
+# form a directed graph which is (hopefully though not necessarily)
+# acyclic.
+my $pkg;
+my $depends = Graph::Directed->new;
+foreach $pkg (@packages) {
+ my $nr_edges_added = 0;
+ open PIPE, "repoquery --enablerepo=fedora-source --requires $pkg.src | awk '{print \$1}' |" or die "repoquery: $!";
+ while (<PIPE>) {
+ chomp;
+ # Resolve the binary package to its source package.
+ # XXX Should resolve file dependencies here.
+ if (exists $binary_to_source{$_}) {
+ my $br = $binary_to_source{$_};
+ # Is the BR in the list of packages? If not, ignore.
+ if (exists $packages{$br}) {
+ $depends->add_edge ($br, $pkg);
+ $nr_edges_added++;
+ }
+ } else {
+ #warn "ignored non-existent build requires: $_ (from package $pkg)\n";
+ }
+ }
+ close PIPE or die;
+
+ # If we didn't add any edges, just add the disconnected vertex.
+ $depends->add_vertex ($pkg) if $nr_edges_added == 0;
+}
+
+# Print some stats about the dependency graph.
+print "dependency graph:\n";
+print " vertices (packages): ", 0+$depends->vertices, "\n";
+print " edges (BuildRequires): ", 0+$depends->edges, "\n";
+
+# Break cycles.
+while ($depends->has_a_cycle) {
+ print "warning: breaking dependency graph cycle ";
+ my @vs = $depends->find_a_cycle;
+ if (@vs == 1) { # A -> A
+ my $v = $vs[0];
+ print "by deleting edge $v -> $v\n";
+ $depends->delete_edge ($v, $v);
+ } else { # A -> B -> ... -> Z -> A
+ my $u = $vs[0];
+ my $v = $vs[1];
+ print "by deleting edge $u -> $v\n";
+ $depends->delete_edge ($u, $v);
+ }
+}
+
+die unless $depends->is_dag;
+
+# Sort the dependencies into a build order.
+my @build_order = $depends->topological_sort;
+
+print "build order for mass rebuild: ", join (" ", @build_order),
+ " (", 0+@build_order, " packages)\n\n";
+
+# Now start checking out the packages under $dir.
+my $cmd;
+foreach $pkg (@build_order) {
+ if (! -d "$dir/$pkg") {
+ $cmd = "cd $dir && fedpkg clone -B $pkg";
+ print $cmd, "\n";
+ system ($cmd) == 0 or die "fedpkg: failed for $pkg: $?";
+ }
+ elsif (-f "$dir/$pkg/$branch/$pkg.spec" ||
+ -f "$dir/$pkg/$branch/dead.package") {
+ # already cloned with fedpkg -B
+ }
+ elsif (-f "$dir/$pkg/$pkg.spec" || -f "$dir/$pkg/dead.package") {
+ # already cloned with fedpkg
+ }
+ else {
+ print "$dir/$pkg exists, but contents are unexpected.\n";
+ print "Fix this directory, and rerun the script (or fix the script).\n";
+ exit 1;
+ }
+}
+
+# Notes for each package.
+my %package_notes;
+
+# Build each package in order.
+BUILD:
+foreach $pkg (@build_order) {
+ # Are all the dependencies of this package ready?
+ my @v = $depends->predecessors ($pkg);
+ foreach (@v) {
+ if (!$package_notes{$_}{build_done}) {
+ print "skipping $pkg because $_ was not built\n";
+ $package_notes{$pkg}{error} = "skipped-dependency-not-built";
+ next BUILD;
+ }
+ }
+
+ # Make sure the package checkout is up to date.
+ my ($d, $spec);
+ if (-d "$dir/$pkg/$branch") {
+ $d = "$dir/$pkg/$branch";
+ $spec = "$dir/$pkg/$branch/$pkg.spec";
+ $cmd = "cd $d && git pull --rebase";
+ } elsif (-d "$dir/$pkg") {
+ $d = "$dir/$pkg";
+ $spec = "$dir/$pkg/$pkg.spec";
+ $cmd = "cd $d && git pull --rebase && git checkout $branch";
+ } else {
+ die
+ }
+ print $cmd, "\n";
+ system ($cmd) == 0 or die "git: failed for $pkg: $?";
+
+ # Dead package? We will note and ignore these.
+ if (-f "$d/dead.package") {
+ $package_notes{$pkg}{error} = "dead-package";
+ next BUILD;
+ }
+
+ # Are there unpushed changes? If so we have to skip this package.
+ open PIPE, "cd $d && git log --oneline $branch ^origin/$branch | wc -l |"
+ or die "git: $!";
+ my $unpushed_changes = <PIPE>;
+ chomp $unpushed_changes;
+ close PIPE or die;
+ if ($unpushed_changes > 0) {
+ $package_notes{$pkg}{error} = "unpushed-changes";
+ next BUILD;
+ }
+
+ # Get the current NVR of the package.
+ open PIPE, "cd $d && fedpkg verrel |" or die "fedpkg: $!";
+ my $nvr = <PIPE>;
+ chomp $nvr;
+ close PIPE or die;
+
+ # Has the package been bumped already?
+ my $bumped = grep_file ("^- $message", $spec);
+
+ if ($bumped) {
+ print "Checking if there is a build of $nvr ... ";
+
+ # If the package has been bumped, does a successful build exist?
+ open PIPE, "cd $d && LANG=C koji buildinfo $nvr |" or die "koji: $!";
+ my ($state, $no_build);
+ while (<PIPE>) {
+ if (/No such build/) {
+ $no_build = 1; last;
+ }
+ if (/State: (.*)/) {
+ $state = $1; last;
+ }
+ }
+ close PIPE or die;
+
+ if ($no_build) { # Bumped, but no build exists.
+ print "no\n";
+ if (!do_build_and_wait ($pkg, $d)) {
+ $package_notes{$pkg}{error} = "build-failed";
+ next BUILD;
+ }
+ $package_notes{$pkg}{build_done} = 1;
+ next BUILD;
+ } elsif (defined $state) {
+ if ($state eq "COMPLETE") {
+ print "yes\n";
+ $package_notes{$pkg}{build_done} = 1;
+ next BUILD;
+ }
+ elsif ($state eq "FAILED") {
+ print "yes, but it failed\n";
+ $package_notes{$pkg}{error} = "build-failed";
+ next BUILD;
+ }
+ else {
+ die "unknown build state: $state"
+ }
+ }
+ }
+
+ # Bump the package and build it.
+ $cmd = "cd $d && rpmdev-bumpspec -c '- $message' $spec && git add $spec && git commit -m '$message' && git push";
+ print $cmd, "\n";
+ system ($cmd) == 0 or die "rpmdev-bumpspec: $?";
+
+ if (!do_build_and_wait ($pkg, $d)) {
+ $package_notes{$pkg}{error} = "build-failed";
+ next BUILD;
+ }
+
+ $package_notes{$pkg}{build_done} = 1;
+}
+
+sub do_build_and_wait
+{
+ my $pkg = shift;
+ my $d = shift;
+
+ my $taskid;
+
+ open PIPE, "cd $d && LANG=C fedpkg build --nowait |"
+ or die "fedpkg: failed to build $pkg: $?";
+ while (<PIPE>) {
+ print;
+ $taskid = $1 if /Created task: (\d+)/;
+ }
+ close PIPE or die;
+
+ return 0 unless defined $taskid;
+
+ while (1) {
+ my ($ok, $failed);
+ open PIPE, "cd $d && timeout 5m koji watch-task $taskid |" or next;
+ while (<PIPE>) {
+ print;
+ $failed = 1 if /FAILED/;
+ $ok = 1 if /^$taskid build .* completed successfully/;
+ }
+ close PIPE;
+
+ return 1 if $ok;
+ return 0 if $failed;
+ }
+
+ return 1;
+}
+
+sub grep_file
+{
+ my $rex = shift;
+ my $filename = shift;
+
+ my @cmd = ("grep", "--quiet", $rex, $filename);
+ my $r = system (@cmd);
+ if ($r == 0) {
+ return 1;
+ } elsif ($r == 256) {
+ return 0;
+ } else {
+ die "grep: $filename: $?"
+ }
+}
git.annexia.org / mass-rebuild.git / commitdiff