lib/Fedora/Rebuild.pm

   1 package Fedora::Rebuild;
   2 use strict;
   3 use warnings;
   4 use version 0.77; our $VERSION = version->declare("v0.2.0");
   5
   6 use Moose;
   7 use Moose::Util::TypeConstraints;
   8 use Carp;
   9 use IO::Handle;
  10 use Fedora::Rebuild::Set::Package;
  11 use Fedora::Rebuild::Package;
  12 use Fedora::Rebuild::Scheduler;
  13 use namespace::clean;
  14
  15 has 'all' => (is => 'ro', isa => 'Str', required => 1);
  16 has 'done' => (is => 'ro', isa => 'Str', required => 1);
  17 has 'failed' => (is => 'ro', isa => 'Str', required => 1);
  18 has 'workdir' => (is => 'ro', isa => 'Str', required => 1);
  19 # Git branch name
  20 # "f14", "f15" etc. Use "rawhide" for latest one.
  21 has 'dist' => (is => 'ro', isa => 'Str', required => 1);
  22 # Build target name
  23 # "dist-f14", "dist-f15" etc. Use "dist-rawhide" for latest one.
  24 has 'target' => (is => 'ro', isa => 'Str', required => 1);
  25 has 'message' => (is => 'ro', isa => 'Str', required => 1);
  26 # Reference to function with three arguments (BuildRequire name, relation
  27 # flag, version) returning false the BuildRequire should be considered, true
  28 # otherwise. If attribute is undef or missing, no filtering will be performed
  29 # (i.e. the same effect as sub {1}).
  30 has 'buildrequiresfilter' => (is => 'ro', isa => 'CodeRef', required => 0);
  31 # Pass true for committing and building locally only. Default is false to
  32 # build in Koji.
  33 has 'local' => (is => 'ro', isa => 'Bool', required => 0);
  34 # Run rebuild in given number of threads. Default is 1.
  35 has 'threads' => (is => 'ro', isa => subtype('Int' => where {$_>0} =>
  36         message {"Attribute threads must be positive integer (was $_)"}),
  37     required => 0);
  38 # Load binary provides of already done packages or buildrequires in given
  39 # number of threads. This is to lower local I/O load. Default is 1.
  40 has 'loadthreads' => (is => 'ro', isa => subtype('Int' => where {$_>0} =>
  41         message {"Attribute loadthreads must be positive integer (was $_)"}),
  42     required => 0);
  43 # Maximal count of immediately sequential failures to accept and continue
  44 # rebuild process. If the limit exceeds, rebuild process will terminate. This
  45 # is good to catch pathologic cases when something is obviously wrong and
  46 # should be fixed before rebuilding (e.g. Koji is down, or you have not SSH
  47 # key loaded into SSH agent). Use non-positive number to disable this check.
  48 # Default value is 0 (i.e. not to check).
  49 has 'failurelimit' => (is => 'ro', isa => 'Int', required => 0, default => 0);
  50
  51 has 'remaining_packages' => (is => 'ro', isa => 'Fedora::Rebuild::Set::Package',
  52     lazy_build => 1, init_arg => undef);
  53 has 'done_packages' => (is => 'ro', isa => 'Fedora::Rebuild::Set::Package',
  54     lazy_build => 1, init_arg => undef);
  55 has 'failed_packages' => (is => 'ro', isa => 'Fedora::Rebuild::Set::Package',
  56     lazy_build => 1, init_arg => undef);
  57 has 'subsequent_failures' => (is => 'rw', isa => 'Int', default => 0,
  58     init_arg => undef);
  59 has 'last_failed' => (is => 'rw', isa => 'Bool', default => 0,
  60     init_arg => undef);
  61
  62
  63 # Creates set of packages not yet rebuilt.
  64 sub _build_done_packages {
  65     my $self = shift;
  66     my $packages = Fedora::Rebuild::Set::Package->new();
  67     my $file;
  68
  69     if (not -e $self->done) {
  70         print "No packages have been rebuilt yet.\n";
  71         return $packages;
  72     }
  73
  74     open($file, '<', $self->done) or
  75         croak "Could not open `" . $self->done .
  76             "' for loading list of already rebuilt packages: $!";
  77     print "Loading list of already rebuilt package names...\n";
  78     while (local $_ = <$file>) {
  79         chomp;
  80         if (m/^\s*$/) { next; }
  81
  82         my $package = Fedora::Rebuild::Package->new(name => $_,
  83             workdir => $self->workdir, dist => $self->dist,
  84             target => $self->target, message => $self->message);
  85         $packages->insert($package);
  86     }
  87     if ($!) {
  88         croak "Could not read list of rebuilt package names from file `" .
  89         $self->done . "': $!";
  90     }
  91     close $file;
  92     print "Number of done packages: " . $packages->size() . "\n";
  93
  94     return $packages;
  95 }
  96
  97
  98 sub mark_done {
  99     my ($self, $package) = @_;
 100     my $file = IO::Handle->new();
 101
 102     open($file, '>>', $self->done) or
 103         croak "Could not open `" . $self->done . "' for appending: $!";
 104     printf $file $package->name . "\n" or
 105         croak "Could not write data into `" . $self->done . "': $!";
 106     $file->flush && $file->sync && close($file) or
 107         croak "Could not flush and close `" . $self->done . "': $!";
 108
 109     $self->done_packages->insert($package);
 110     $self->last_fail(0);
 111     $self->subsequent_failures(0);
 112 }
 113
 114 # Creates set of packages not yet rebuilt not already failed.
 115 sub _build_remaining_packages {
 116     my $self = shift;
 117     my $packages = Fedora::Rebuild::Set::Package->new();
 118     my $file;
 119
 120     open($file, '<', $self->all) or
 121         croak "Could not open " . $self->all .
 122             " for loading list of package names to rebuild: $!";
 123     print "Loading list of all package names to rebuild...\n";
 124
 125     while (local $_ = <$file>) {
 126         chomp;
 127         if (m/^\s*$/) { next; }
 128         if ($packages->contains($_)) { next; }
 129         if (! $self->done_packages->contains($_) &&
 130                 ! $self->failed_packages->contains($_)) {
 131             $packages->insert(Fedora::Rebuild::Package->new(name => $_,
 132                 workdir => $self->workdir, dist => $self->dist,
 133                 target => $self->target, message => $self->message));
 134         }
 135     }
 136     if ($!) {
 137         croak "Could not read list of package names to rebuild from file `" .
 138             $self->all . "' :$!";
 139     }
 140     close $file;
 141
 142     print "Number of all packages: " .
 143         ($packages->size + $self->done_packages->size
 144             + $self->failed_packages->size) . "\n";
 145     print "Number of not yet rebuilt packages: " . $packages->size() . "\n";
 146     return $packages;
 147 }
 148
 149
 150 # Set of packages whose rebuild failed.
 151 sub _build_failed_packages {
 152     my $self = shift;
 153     my $packages = Fedora::Rebuild::Set::Package->new();
 154     my $file;
 155
 156     if (not -e $self->failed) {
 157         print "No packages have failed yet.\n";
 158         return $packages;
 159     }
 160
 161     open($file, '<', $self->failed) or
 162         croak "Could not open `" . $self->failed .
 163             "' for loading list of already failed packages: $!";
 164     print "Loading list of already failed package names...\n";
 165     while (local $_ = <$file>) {
 166         chomp;
 167         if (m/^\s*$/) { next; }
 168
 169         my $package = Fedora::Rebuild::Package->new(name => $_,
 170             workdir => $self->workdir, dist => $self->dist,
 171             target => $self->target, message => $self->message);
 172         $packages->insert($package);
 173     }
 174     if ($!) {
 175         croak "Could not read list of failed package names from file `" .
 176         $self->failed . "': $!";
 177     }
 178     close $file;
 179     print "Number of failed packages: " . $packages->size() . "\n";
 180
 181     return $packages;
 182 }
 183
 184 # Record package names into log of failed packages
 185 sub mark_failed {
 186     my ($self, $package) = @_;
 187     my $file = IO::Handle->new();
 188
 189     # Log failure
 190     open($file, '>>', $self->failed) or
 191         croak "Could not open `" . $self->failed . "' for appending: $!";
 192     printf $file $package->name . "\n" or
 193         croak "Could not write data into `" . $self->failed . "': $!";
 194     $file->flush && $file->sync && close($file) or
 195         croak "Could not flush and close `" . $self->failed . "': $!";
 196
 197     # Move to list of failed
 198     $self->failed_packages->insert($package);
 199
 200     # Check for very failures
 201     if ($self->last_failed) {
 202         $self->subsequent_failures($self->subsequent_failures + 1);
 203     } else {
 204         $self->last_failed(1);
 205         $self->subsequent_failures(1);
 206     }
 207     if ($self->failurelimit > 0 &&
 208             $self->subsequent_failures > $self->failurelimit) {
 209         croak "More then " . $self->failurelimit .
 210             " package(s) failed subsequently which is more then set " .
 211             "threshold. Aborting now.\n";
 212     }
 213 }
 214
 215 # Load binary provides of each done package.
 216 # Return true in case of success or croaks in case of failure.
 217 sub load_binaryprovides {
 218     my $self = shift;
 219     my $scheduler = Fedora::Rebuild::Scheduler->new($self->loadthreads);
 220     my %jobs = ();
 221     my @packages = $self->done_packages->packages;
 222     my $i = 0;
 223
 224     print "Loading binary provides of already rebuilt packages...\n";
 225
 226     foreach my $package (@packages) {
 227         my $job = $scheduler->schedule($package->can('get_binaryprovides'),
 228             $package, $self->local);
 229         if (! defined $job) { next; }
 230         $jobs{$job} = $package;
 231         my %finished = $scheduler->finish(++$i < @packages);
 232
 233         while (my ($job, $status) = each %finished) {
 234             my $package = $jobs{$job};
 235             if (!$status) {
 236                 print "Could not load binary provides for already built " .
 237                     "package `" . $package->name . "'.\n";
 238                 print "Waiting for finishing scheduled jobs...\n";
 239                 $scheduler->finish(1);
 240                 print "All jobs loading binary provides have finished.\n";
 241                 croak "Could not load binary provides\n";
 242             }
 243         }
 244     }
 245
 246     print "Binary provides of already rebuilt packages loaded successfully.\n";
 247     return 1;
 248 }
 249
 250 # Decides a package is rebuildable now.
 251 # Return 0 for false, 1 or true, undef for error while deciding.
 252 sub is_rebuildable {
 253     my ($self, $package) = @_;
 254
 255     if (!defined $package->get_buildrequires()) {
 256         return undef;
 257     }
 258
 259     # Each requirement of $package must be satisfied by at least one already
 260     # rebuilt package.
 261     for my $rname (keys %{$package->requires}) {
 262         for my $require (@{${$package->requires}{$rname}}) {
 263             my $rflag = $$require[0];
 264             my $rversion = $$require[1];
 265             my $is_satisfied = 0;
 266
 267             if (defined $self->buildrequiresfilter and
 268                     &{$self->buildrequiresfilter}($rname, $rflag, $rversion)) {
 269                 # Avoid user-defined BuildRequires from dependency eva;uation
 270                 next;
 271             }
 272
 273             for my $rebuilt_package ($self->done_packages->packages) {
 274                 if (Fedora::Rebuild::RPM::is_satisfied($rname, $rflag,
 275                         $rversion, $rebuilt_package->provides)) {
 276                     $is_satisfied = 1;
 277                     last;
 278                 }
 279             }
 280
 281             if (!$is_satisfied) {
 282                 print qq{Package `} . $package->name . qq{' cannot be rebuilt }
 283                     . qq{now because `}. $rname . qq{ } .
 284                     Fedora::Rebuild::RPM::flag_as_string($rflag) .
 285                     qq{ } . $rversion . qq{' could not been satisfied.} . "\n";
 286                 return 0;
 287             }
 288         }
 289     }
 290
 291     print "BuildRequires for `" . $package->name . "' fulfilled.\n";
 292     return 1;
 293 }
 294
 295
 296 # Return F:R:Set:Packages than can be rebuilt now
 297 sub select_rebuildable {
 298     my $self = shift;
 299     my $scheduler = Fedora::Rebuild::Scheduler->new($self->loadthreads);
 300     my %jobs = ();
 301     my %finished = ();
 302     print "Selecting rebuildable packages...\n";
 303
 304     my $rebuildables = Fedora::Rebuild::Set::Package->new;
 305     foreach my $package ($self->remaining_packages->packages) {
 306         my $job = $scheduler->schedule($self->can('is_rebuildable'), $self,
 307             $package);
 308         if (! defined $job) { next; }
 309         $jobs{$job} = $package;
 310         %finished = (%finished, ($scheduler->finished()));
 311     }
 312     %finished = (%finished, ($scheduler->finish()));
 313
 314     for my $job (keys %finished) {
 315         my $job_status = $finished{$job};
 316         my $package = $jobs{$job};
 317
 318         if ($job_status) {
 319             $rebuildables->insert($package);
 320         } elsif (!defined $job_status) {
 321             # Could not decide whether the $package is rebuildable. This is
 322             # fatal for the package. Move it to failed packages.
 323             $self->remaining_packages->delete($package);
 324             $self->mark_failed($package);
 325         }
 326     }
 327
 328     print "Packages selected to rebuild (" . $rebuildables->size .
 329         "): " . $rebuildables->string . "\n";
 330     return $rebuildables;
 331 }
 332
 333
 334 # Rebuild all remaining packages
 335 sub run {
 336     my $self = shift;
 337     print "remaining_packages: " . $self->remaining_packages->string . "\n";
 338     print "done_packages: " . $self->done_packages->string . "\n";
 339     print "Rebuild mode: " . (($self->local)?"local":"public") . "\n";
 340
 341     $self->load_binaryprovides;
 342
 343     while ($self->remaining_packages->size > 0) {
 344         my $rebuildable_packages = $self->select_rebuildable;
 345         if ($rebuildable_packages->size == 0) {
 346             printf "No more packages can be rebuilt!\n";
 347             last;
 348         }
 349
 350         my $scheduler = Fedora::Rebuild::Scheduler->new($self->threads);
 351         my %jobs = ();
 352         my @packages = $rebuildable_packages->packages;
 353         my $i = 0;
 354
 355         foreach my $package (@packages) {
 356             $self->remaining_packages->delete($package);
 357
 358             my $job = $scheduler->schedule($package->can('rebuild'), $package,
 359                 $self->local);
 360             if (! defined $job) { next; }
 361             $jobs{$job} = $package;
 362             my %finished = $scheduler->finish(++$i < @packages);
 363
 364             while (my ($job, $status) = each %finished) {
 365                 my $package = $jobs{$job};
 366                 if ($status) {
 367                     # TODO: Push Provides into global list of available
 368                     # provides.
 369                     $self->mark_done($package);
 370                 } else {
 371                     $self->mark_failed($package);
 372                 }
 373             }
 374         }
 375     }
 376
 377     if ($self->failed_packages->size > 0) {
 378         print "Rebuild of following packages failed (" .
 379             $self->failed_packages->size . "): " .
 380             $self->failed_packages->string . "\n";
 381         return 0;
 382     } else {
 383         print "All packages have been rebuilt.\n";
 384         return 1;
 385     }
 386 }
 387
 388 1;
 389 __END__
 390 =encoding utf8
 391
 392 =head1 NAME
 393
 394 Fedora::Rebuild - Rebuilds Fedora packages from scratch
 395
 396 =head1 DESCRIPTION
 397
 398 Main goal is to rebuild perl modules packages for Fedora. The rebuild is
 399 driven from bottom to top, i.e. from perl interpreter to modules depending on
 400 intermediate modules. This way, it's possible to upgrade perl interpreter to
 401 incompatible version and to rebuild all modules against the new interpreter.
 402
 403 Procedure is following: We have a set of source package to rebuild. We
 404 distill all build-time dependencies for each source package. We ignore
 405 non-perl dependencies as we focus on Perl only.
 406
 407 We select all source packages that do not depend on anything and push them
 408 into Koji to rebuild. Obviously, the only fulfilling package is Perl interpret
 409 only.
 410
 411 Once the first subset of packages is rebuilt, we gather their binary packages
 412 and distill their binary provides. These freshly available provides are put
 413 into new set of available provides. At the same time we remove the rebuilt
 414 subset from original set of all source packages.
 415
 416 Then we wait for build root rotation in Koji to get rebuilt binary packages
 417 available in build root.
 418
 419 (Of course we could get provides of new binary packages from koji repository
 420 after rotation and we can get provides through repoquery instead of
 421 inspecting binary packages manually.)
 422
 423 If package rebuild fails, the package is removed from future consideration.
 424
 425 Then we return to start of this procedure to select other subset of source
 426 packages whose build-time dependecies can be satisfied from set of binary
 427 provides we have obtained till now.
 428
 429 This loop cycles until set of source packages is empty.
 430
 431 =head1 SYNCHRONIZATION
 432
 433 Because mass rebuild is long term issue and lot of intermediate failures can
 434 emerge, one must be able to resume failed rebuild process.
 435
 436 Safe resume is assured by proper logging. Once a package has been rebuilt, its
 437 name is logged into list of done packages. Restarting rebuild program with the
 438 same arguments loads done packages, remove them from set of remaining
 439 packages, and populates list of available provides. In additon, packages whose
 440 rebuild failed are removed from set of remaining packages.
 441
 442 =head1 AUTHOR
 443
 444 Petr Písař <ppisar@redhat.com>
 445
 446 =head1 COPYING
 447
 448 Copyright (C) 2011  Petr Pisar <ppisar@redhat.com>
 449
 450 This program is free software: you can redistribute it and/or modify
 451 it under the terms of the GNU General Public License as published by
 452 the Free Software Foundation, either version 3 of the License, or
 453 (at your option) any later version.
 454
 455 This program is distributed in the hope that it will be useful,
 456 but WITHOUT ANY WARRANTY; without even the implied warranty of
 457 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 458 GNU General Public License for more details.
 459
 460 You should have received a copy of the GNU General Public License
 461 along with this program.  If not, see <http://www.gnu.org/licenses/>.
 462
 463 =cut
 464