2 # Mass rebuild packages.
3 # Written By Richard W.M. Jones.
4 # Copyright (C) 2012 Red Hat Inc.
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.
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.
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.
23 #----------------------------------------------------------------------
24 # Configuration section.
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.";
30 # These are regular expressions matching all the *source* packages
31 # that we want to rebuild.
32 my @package_regexps = (
47 # Packages that match the above regexps, but which you nevertheless
49 my @package_ignored = (
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";
58 # Branch to perform rebuilds in. ('master' = Rawhide, otherwise 'f17' etc.)
59 my $branch = "master";
61 # End of configuration.
62 #----------------------------------------------------------------------
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: $!";
69 push @all_source_packages, $_;
75 foreach $rex (@package_regexps) {
76 foreach (@all_source_packages) {
80 foreach $rex2 (@package_ignored) {
81 $ignore = 1 if $_ =~ $rex2;
83 push @packages, $_ unless $ignore;
88 @packages = sort @packages;
89 print "packages considered for mass rebuild: ", join (" ", @packages),
90 " (", 0+@packages, " packages)\n";
92 # Make a hashtable from @packages, so we can quickly tell if a package
95 $packages{$_} = 1 foreach @packages;
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
100 my @all_binary_packages;
101 my %binary_to_source;
102 open PIPE, "repoquery -q -a --qf='%{name} %{sourcerpm}' | sort -u |" or die "repoquery: $!";
105 if (/^(.*) (.*?)-\d/) {
106 push @all_binary_packages, $1;
107 $binary_to_source{$1} = $2;
109 warn "ignored repoquery output: $_\n";
114 # For each package that needs rebuilding, get the dependencies. These
115 # form a directed graph which is (hopefully though not necessarily)
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: $!";
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);
134 #warn "ignored non-existent build requires: $_ (from package $pkg)\n";
139 # If we didn't add any edges, just add the disconnected vertex.
140 $depends->add_vertex ($pkg) if $nr_edges_added == 0;
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";
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
154 print "by deleting edge $v -> $v\n";
155 $depends->delete_edge ($v, $v);
156 } else { # A -> B -> ... -> Z -> A
159 print "by deleting edge $u -> $v\n";
160 $depends->delete_edge ($u, $v);
164 die unless $depends->is_dag;
166 # Sort the dependencies into a build order.
167 my @build_order = $depends->topological_sort;
169 print "build order for mass rebuild: ", join (" ", @build_order),
170 " (", 0+@build_order, " packages)\n\n";
172 # Now start checking out the packages under $dir.
174 foreach $pkg (@build_order) {
175 if (! -d "$dir/$pkg") {
176 $cmd = "cd $dir && fedpkg clone -B $pkg";
178 system ($cmd) == 0 or die "fedpkg: failed for $pkg: $?";
180 elsif (-f "$dir/$pkg/$branch/$pkg.spec" ||
181 -f "$dir/$pkg/$branch/dead.package") {
182 # already cloned with fedpkg -B
184 elsif (-f "$dir/$pkg/$pkg.spec" || -f "$dir/$pkg/dead.package") {
185 # already cloned with fedpkg
188 print "$dir/$pkg exists, but contents are unexpected.\n";
189 print "Fix this directory, and rerun the script (or fix the script).\n";
194 # Notes for each package.
197 # Build each package in order.
199 foreach $pkg (@build_order) {
200 # Are all the dependencies of this package ready?
201 my @v = $depends->predecessors ($pkg);
203 if (!$package_notes{$_}{build_done}) {
204 print "skipping $pkg because $_ was not built\n";
205 $package_notes{$pkg}{error} = "skipped-dependency-not-built";
210 # Make sure the package checkout is up to date.
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") {
218 $spec = "$dir/$pkg/$pkg.spec";
219 $cmd = "cd $d && git pull --rebase && git checkout $branch";
224 system ($cmd) == 0 or die "git: failed for $pkg: $?";
226 # Dead package? We will note and ignore these.
227 if (-f "$d/dead.package") {
228 $package_notes{$pkg}{error} = "dead-package";
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 |"
235 my $unpushed_changes = <PIPE>;
236 chomp $unpushed_changes;
238 if ($unpushed_changes > 0) {
239 $package_notes{$pkg}{error} = "unpushed-changes";
243 # Get the current NVR of the package.
244 open PIPE, "cd $d && fedpkg verrel |" or die "fedpkg: $!";
249 # Has the package been bumped already?
250 my $bumped = grep_file ("^- $message", $spec);
253 print "Checking if there is a build of $nvr ... ";
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);
259 if (/No such build/) {
268 if ($no_build) { # Bumped, but no build exists.
270 if (!do_build_and_wait ($pkg, $d)) {
271 $package_notes{$pkg}{error} = "build-failed";
274 $package_notes{$pkg}{build_done} = 1;
276 } elsif (defined $state) {
277 if ($state eq "COMPLETE") {
279 $package_notes{$pkg}{build_done} = 1;
282 elsif ($state eq "FAILED") {
283 print "yes, but it failed\n";
284 $package_notes{$pkg}{error} = "build-failed";
288 die "unknown build state: $state"
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";
296 system ($cmd) == 0 or die "rpmdev-bumpspec: $?";
298 if (!do_build_and_wait ($pkg, $d)) {
299 $package_notes{$pkg}{error} = "build-failed";
303 $package_notes{$pkg}{build_done} = 1;
306 sub do_build_and_wait
313 open PIPE, "cd $d && LANG=C fedpkg build --nowait |"
314 or die "fedpkg: failed to build $pkg: $?";
317 $taskid = $1 if /Created task: (\d+)/;
321 return 0 unless defined $taskid;
325 open PIPE, "cd $d && timeout 5m koji watch-task $taskid |" or next;
328 $failed = 1 if /FAILED/;
329 $ok = 1 if /^$taskid build .* completed successfully/;
343 my $filename = shift;
345 my @cmd = ("grep", "--quiet", $rex, $filename);
346 my $r = system (@cmd);
349 } elsif ($r == 256) {
352 die "grep: $filename: $?"