mass-rebuild.pl

   1 #!/usr/bin/perl -w
   2 # Mass rebuild packages.
   3 # Written By Richard W.M. Jones.
   4 # Copyright (C) 2012 Red Hat Inc.
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use Graph::Directed;
  22
  23 #----------------------------------------------------------------------
  24 # Configuration section.
  25
  26 # The name of the rebuild.  This is used in commit messages, and also
  27 # used to tell if we have rebuilt a package already.
  28 my $message = "Rebuild for OCaml 4.00.0.";
  29
  30 # These are regular expressions matching all the *source* packages
  31 # that we want to rebuild.
  32 my @package_regexps = (
  33     qr/\bocaml\b/,
  34     qr/^cduce$/,
  35     qr/^coccinelle$/,
  36     qr/^coq$/,
  37     qr/^frama-c$/,
  38     qr/^hivex$/,
  39     qr/^libguestfs$/,
  40     qr/^llvm$/,
  41     qr/^plplot$/,
  42     qr/^virt-dmesg$/,
  43     qr/^virt-top$/,
  44     qr/^why$/
  45     );
  46
  47 # Packages that match the above regexps, but which you nevertheless
  48 # want to ignore.
  49 my @package_ignored = (
  50     qr/^ocaml$/,
  51     );
  52
  53 # Directory to use when checking out Fedora packages.  This directory
  54 # must exist.  Packages are cloned into directories under here.  If a
  55 # directory already exists, then it is updated.
  56 my $dir = "$ENV{HOME}/d/fedora";
  57
  58 # Branch to perform rebuilds in.  ('master' = Rawhide, otherwise 'f17' etc.)
  59 my $branch = "master";
  60
  61 # End of configuration.
  62 #----------------------------------------------------------------------
  63
  64 # Get a list of all source package names.
  65 my @all_source_packages;
  66 open PIPE, "repoquery --enablerepo=fedora-source -q -a --archlist=src --qf='%{name}' | sort -u |" or die "repoquery: $!";
  67 while (<PIPE>) {
  68     chomp;
  69     push @all_source_packages, $_;
  70 }
  71 close PIPE or die;
  72
  73 my @packages;
  74 my $rex;
  75 foreach $rex (@package_regexps) {
  76     foreach (@all_source_packages) {
  77         if ($_ =~ $rex) {
  78             my $ignore;
  79             my $rex2;
  80             foreach $rex2 (@package_ignored) {
  81                 $ignore = 1 if $_ =~ $rex2;
  82             }
  83             push @packages, $_ unless $ignore;
  84         }
  85     }
  86 }
  87
  88 @packages = sort @packages;
  89 print "packages considered for mass rebuild: ", join (" ", @packages),
  90     " (", 0+@packages, " packages)\n";
  91
  92 # Make a hashtable from @packages, so we can quickly tell if a package
  93 # is in the list.
  94 my %packages;
  95 $packages{$_} = 1 foreach @packages;
  96
  97 # Get a list of all binary packages.  So that we can relate binary
  98 # packages to what source they come from, also list the source RPM
  99 # name for each.
 100 my @all_binary_packages;
 101 my %binary_to_source;
 102 open PIPE, "repoquery -q -a --qf='%{name} %{sourcerpm}' | sort -u |" or die "repoquery: $!";
 103 while (<PIPE>) {
 104     chomp;
 105     if (/^(.*) (.*?)-\d/) {
 106         push @all_binary_packages, $1;
 107         $binary_to_source{$1} = $2;
 108     } else {
 109         warn "ignored repoquery output: $_\n";
 110     }
 111 }
 112 close PIPE or die;
 113
 114 # For each package that needs rebuilding, get the dependencies.  These
 115 # form a directed graph which is (hopefully though not necessarily)
 116 # acyclic.
 117 my $pkg;
 118 my $depends = Graph::Directed->new;
 119 foreach $pkg (@packages) {
 120     my $nr_edges_added = 0;
 121     open PIPE, "repoquery --enablerepo=fedora-source --requires $pkg.src | awk '{print \$1}' |" or die "repoquery: $!";
 122     while (<PIPE>) {
 123         chomp;
 124         # Resolve the binary package to its source package.
 125         # XXX Should resolve file dependencies here.
 126         if (exists $binary_to_source{$_}) {
 127             my $br = $binary_to_source{$_};
 128             # Is the BR in the list of packages?  If not, ignore.
 129             if (exists $packages{$br}) {
 130                 $depends->add_edge ($br, $pkg);
 131                 $nr_edges_added++;
 132             }
 133         } else {
 134             #warn "ignored non-existent build requires: $_ (from package $pkg)\n";
 135         }
 136     }
 137     close PIPE or die;
 138
 139     # If we didn't add any edges, just add the disconnected vertex.
 140     $depends->add_vertex ($pkg) if $nr_edges_added == 0;
 141 }
 142
 143 # Print some stats about the dependency graph.
 144 print "dependency graph:\n";
 145 print "  vertices (packages):   ", 0+$depends->vertices, "\n";
 146 print "  edges (BuildRequires): ", 0+$depends->edges, "\n";
 147
 148 # Break cycles.
 149 while ($depends->has_a_cycle) {
 150     print "warning: breaking dependency graph cycle ";
 151     my @vs = $depends->find_a_cycle;
 152     if (@vs == 1) {             # A -> A
 153         my $v = $vs[0];
 154         print "by deleting edge $v -> $v\n";
 155         $depends->delete_edge ($v, $v);
 156     } else {                    # A -> B -> ... -> Z -> A
 157         my $u = $vs[0];
 158         my $v = $vs[1];
 159         print "by deleting edge $u -> $v\n";
 160         $depends->delete_edge ($u, $v);
 161     }
 162 }
 163
 164 die unless $depends->is_dag;
 165
 166 # Sort the dependencies into a build order.
 167 my @build_order = $depends->topological_sort;
 168
 169 print "build order for mass rebuild: ", join (" ", @build_order),
 170     " (", 0+@build_order, " packages)\n\n";
 171
 172 # Now start checking out the packages under $dir.
 173 my $cmd;
 174 foreach $pkg (@build_order) {
 175     if (! -d "$dir/$pkg") {
 176         $cmd = "cd $dir && fedpkg clone -B $pkg";
 177         print $cmd, "\n";
 178         system ($cmd) == 0 or die "fedpkg: failed for $pkg: $?";
 179     }
 180     elsif (-f "$dir/$pkg/$branch/$pkg.spec" ||
 181            -f "$dir/$pkg/$branch/dead.package") {
 182         # already cloned with fedpkg -B
 183     }
 184     elsif (-f "$dir/$pkg/$pkg.spec" || -f "$dir/$pkg/dead.package") {
 185         # already cloned with fedpkg
 186     }
 187     else {
 188         print "$dir/$pkg exists, but contents are unexpected.\n";
 189         print "Fix this directory, and rerun the script (or fix the script).\n";
 190         exit 1;
 191     }
 192 }
 193
 194 # Notes for each package.
 195 my %package_notes;
 196
 197 # Build each package in order.
 198 BUILD:
 199 foreach $pkg (@build_order) {
 200     # Are all the dependencies of this package ready?
 201     my @v = $depends->predecessors ($pkg);
 202     foreach (@v) {
 203         if (!$package_notes{$_}{build_done}) {
 204             print "skipping $pkg because $_ was not built\n";
 205             $package_notes{$pkg}{error} = "skipped-dependency-not-built";
 206             next BUILD;
 207         }
 208     }
 209
 210     # Make sure the package checkout is up to date.
 211     my ($d, $spec);
 212     if (-d "$dir/$pkg/$branch") {
 213         $d = "$dir/$pkg/$branch";
 214         $spec = "$dir/$pkg/$branch/$pkg.spec";
 215         $cmd = "cd $d && git pull --rebase";
 216     } elsif (-d "$dir/$pkg") {
 217         $d = "$dir/$pkg";
 218         $spec = "$dir/$pkg/$pkg.spec";
 219         $cmd = "cd $d && git pull --rebase && git checkout $branch";
 220     } else {
 221         die
 222     }
 223     print $cmd, "\n";
 224     system ($cmd) == 0 or die "git: failed for $pkg: $?";
 225
 226     # Dead package?  We will note and ignore these.
 227     if (-f "$d/dead.package") {
 228         $package_notes{$pkg}{error} = "dead-package";
 229         next BUILD;
 230     }
 231
 232     # Are there unpushed changes?  If so we have to skip this package.
 233     open PIPE, "cd $d && git log --oneline $branch ^origin/$branch | wc -l |"
 234         or die "git: $!";
 235     my $unpushed_changes = <PIPE>;
 236     chomp $unpushed_changes;
 237     close PIPE or die;
 238     if ($unpushed_changes > 0) {
 239         $package_notes{$pkg}{error} = "unpushed-changes";
 240         next BUILD;
 241     }
 242
 243     # Get the current NVR of the package.
 244     open PIPE, "cd $d && fedpkg verrel |" or die "fedpkg: $!";
 245     my $nvr = <PIPE>;
 246     chomp $nvr;
 247     close PIPE or die;
 248
 249     # Has the package been bumped already?
 250     my $bumped = grep_file ("^- $message", $spec);
 251
 252     if ($bumped) {
 253         print "Checking if there is a build of $nvr ... ";
 254
 255         # If the package has been bumped, does a successful build exist?
 256         open PIPE, "cd $d && LANG=C koji buildinfo $nvr |" or die "koji: $!";
 257         my ($state, $no_build);
 258         while (<PIPE>) {
 259             if (/No such build/) {
 260                 $no_build = 1; last;
 261             }
 262             if (/State: (.*)/) {
 263                 $state = $1; last;
 264             }
 265         }
 266         close PIPE or die;
 267
 268         if ($no_build) {        # Bumped, but no build exists.
 269             print "no\n";
 270             if (!do_build_and_wait ($pkg, $d)) {
 271                 $package_notes{$pkg}{error} = "build-failed";
 272                 next BUILD;
 273             }
 274             $package_notes{$pkg}{build_done} = 1;
 275             next BUILD;
 276         } elsif (defined $state) {
 277             if ($state eq "COMPLETE") {
 278                 print "yes\n";
 279                 $package_notes{$pkg}{build_done} = 1;
 280                 next BUILD;
 281             }
 282             elsif ($state eq "FAILED") {
 283                 print "yes, but it failed\n";
 284                 $package_notes{$pkg}{error} = "build-failed";
 285                 next BUILD;
 286             }
 287             else {
 288                 die "unknown build state: $state"
 289             }
 290         }
 291     }
 292
 293     # Bump the package and build it.
 294     $cmd = "cd $d && rpmdev-bumpspec -c '- $message' $spec && git add $spec && git commit -m '$message' && git push";
 295     print $cmd, "\n";
 296     system ($cmd) == 0 or die "rpmdev-bumpspec: $?";
 297
 298     if (!do_build_and_wait ($pkg, $d)) {
 299         $package_notes{$pkg}{error} = "build-failed";
 300         next BUILD;
 301     }
 302
 303     $package_notes{$pkg}{build_done} = 1;
 304 }
 305
 306 sub do_build_and_wait
 307 {
 308     my $pkg = shift;
 309     my $d = shift;
 310
 311     my $taskid;
 312
 313     open PIPE, "cd $d && LANG=C fedpkg build --nowait |"
 314         or die "fedpkg: failed to build $pkg: $?";
 315     while (<PIPE>) {
 316         print;
 317         $taskid = $1 if /Created task: (\d+)/;
 318     }
 319     close PIPE or die;
 320
 321     return 0 unless defined $taskid;
 322
 323     while (1) {
 324         my ($ok, $failed);
 325         open PIPE, "cd $d && timeout 5m koji watch-task $taskid |" or next;
 326         while (<PIPE>) {
 327             print;
 328             $failed = 1 if /FAILED/;
 329             $ok = 1 if /^$taskid build .* completed successfully/;
 330         }
 331         close PIPE;
 332
 333         return 1 if $ok;
 334         return 0 if $failed;
 335     }
 336
 337     return 1;
 338 }
 339
 340 sub grep_file
 341 {
 342     my $rex = shift;
 343     my $filename = shift;
 344
 345     my @cmd = ("grep", "--quiet", $rex, $filename);
 346     my $r = system (@cmd);
 347     if ($r == 0) {
 348         return 1;
 349     } elsif ($r == 256) {
 350         return 0;
 351     } else {
 352         die "grep: $filename: $?"
 353     }
 354 }