lib/Fedora/Rebuild.pm

   1 package Fedora::Rebuild;
   2 use strict;
   3 use warnings;
   4 use version 0.77; our $VERSION = version->declare("v0.4.1");
   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_failed(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 requires and provides of each done package.
 216 # Return true in case of success or croaks in case of failure.
 217 sub load_binarydependencies {
 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 dependenices of already rebuilt packages...\n";
 225
 226     foreach my $package (@packages) {
 227         my $job = $scheduler->schedule($package->can('get_binarydependencies'),
 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 dependencies 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 dependcies have finished.\n";
 241                 croak "Could not load binary dependencies\n";
 242             }
 243         }
 244     }
 245
 246     print "Binary dependencies of already rebuilt packages loaded " .
 247         "successfully.\n";
 248     return 1;
 249 }
 250
 251 # Decides a package is installable in build root now.
 252 # Package that has been rebuild may be uinstallable bacause it can require
 253 # dependencies that have not buil built alreade (i.e. the Requres does not
 254 # need to match BuildRequire).
 255 # This is hard problem as it requires recursive evaluation of each package
 256 # satisifying run-time dependency of previous package.
 257 # Return 0 for false, 1 or true, undef for error while deciding.
 258 sub is_installable {
 259     my ($self, $package) = @_;
 260
 261     # TODO: Implement
 262     ...;
 263
 264     if (!defined $package->get_buildrequires()) {
 265         return undef;
 266     }
 267
 268     # Each requirement of $package must be satisfied by at least one already
 269     # rebuilt package.
 270     for my $rname (keys %{$package->requires}) {
 271         for my $require (@{${$package->requires}{$rname}}) {
 272             my $rflag = $$require[0];
 273             my $rversion = $$require[1];
 274             my $is_satisfied = 0;
 275
 276             if (defined $self->buildrequiresfilter and
 277                     &{$self->buildrequiresfilter}($rname, $rflag, $rversion)) {
 278                 # Avoid user-defined BuildRequires from dependency eva;uation
 279                 next;
 280             }
 281
 282             for my $rebuilt_package ($self->done_packages->packages) {
 283                 if (Fedora::Rebuild::RPM::is_satisfied($rname, $rflag,
 284                         $rversion, $rebuilt_package->provides)) {
 285                     $is_satisfied = 1;
 286                     last;
 287                 }
 288             }
 289
 290             if (!$is_satisfied) {
 291                 print qq{Package `} . $package->name . qq{' cannot be rebuilt }
 292                     . qq{now because `}. $rname . qq{ } .
 293                     Fedora::Rebuild::RPM::flag_as_string($rflag) .
 294                     qq{ } . $rversion . qq{' could not been satisfied.} . "\n";
 295                 return 0;
 296             }
 297         }
 298     }
 299
 300     print "BuildRequires for `" . $package->name . "' fulfilled.\n";
 301     return 1;
 302 }
 303
 304
 305 # Decides a package is rebuildable now.
 306 # Return 0 for false, 1 or true, undef for error while deciding.
 307 sub is_rebuildable {
 308     my ($self, $package) = @_;
 309
 310     if (!defined $package->get_buildrequires()) {
 311         return undef;
 312     }
 313
 314     # Each requirement of $package must be satisfied by at least one already
 315     # rebuilt package.
 316     for my $rname (keys %{$package->requires}) {
 317         for my $require (@{${$package->requires}{$rname}}) {
 318             my $rflag = $$require[0];
 319             my $rversion = $$require[1];
 320             my $is_satisfied = 0;
 321
 322             if (defined $self->buildrequiresfilter and
 323                     &{$self->buildrequiresfilter}($rname, $rflag, $rversion)) {
 324                 # Avoid user-defined BuildRequires from dependency eva;uation
 325                 next;
 326             }
 327
 328             for my $rebuilt_package ($self->done_packages->packages) {
 329                 if (Fedora::Rebuild::RPM::is_satisfied($rname, $rflag,
 330                         $rversion, $rebuilt_package->provides)) {
 331                     $is_satisfied = 1;
 332                     last;
 333                 }
 334             }
 335
 336             if (!$is_satisfied) {
 337                 print qq{Package `} . $package->name . qq{' cannot be rebuilt }
 338                     . qq{now because `}. $rname . qq{ } .
 339                     Fedora::Rebuild::RPM::flag_as_string($rflag) .
 340                     qq{ } . $rversion . qq{' could not been satisfied.} . "\n";
 341                 return 0;
 342             }
 343         }
 344     }
 345
 346     print "BuildRequires for `" . $package->name . "' fulfilled.\n";
 347     return 1;
 348 }
 349
 350
 351 # Return F:R:Set:Packages than can be rebuilt now
 352 sub select_rebuildable {
 353     my $self = shift;
 354     my $scheduler = Fedora::Rebuild::Scheduler->new($self->loadthreads);
 355     my %jobs = ();
 356     my %finished = ();
 357     print "Selecting rebuildable packages...\n";
 358
 359     my $rebuildables = Fedora::Rebuild::Set::Package->new;
 360     foreach my $package ($self->remaining_packages->packages) {
 361         my $job = $scheduler->schedule($self->can('is_rebuildable'), $self,
 362             $package);
 363         if (! defined $job) { next; }
 364         $jobs{$job} = $package;
 365         %finished = (%finished, ($scheduler->finished()));
 366     }
 367     %finished = (%finished, ($scheduler->finish()));
 368
 369     for my $job (keys %finished) {
 370         my $job_status = $finished{$job};
 371         my $package = $jobs{$job};
 372
 373         if ($job_status) {
 374             $rebuildables->insert($package);
 375         } elsif (!defined $job_status) {
 376             # Could not decide whether the $package is rebuildable. This is
 377             # fatal for the package. Move it to failed packages.
 378             $self->remaining_packages->delete($package);
 379             $self->mark_failed($package);
 380         }
 381     }
 382
 383     print "Packages selected to rebuild (" . $rebuildables->size .
 384         "): " . $rebuildables->string . "\n";
 385     return $rebuildables;
 386 }
 387
 388
 389 # Rebuild all remaining packages
 390 sub run {
 391     my $self = shift;
 392     print "remaining_packages: " . $self->remaining_packages->string . "\n";
 393     print "done_packages: " . $self->done_packages->string . "\n";
 394     print "Rebuild mode: " . (($self->local)?"local":"public") . "\n";
 395
 396     $self->load_binarydependencies;
 397
 398     while ($self->remaining_packages->size > 0) {
 399         my $rebuildable_packages = $self->select_rebuildable;
 400         if ($rebuildable_packages->size == 0) {
 401             printf "No more packages can be rebuilt!\n";
 402             last;
 403         }
 404
 405         my $scheduler = Fedora::Rebuild::Scheduler->new($self->threads);
 406
 407         # Rebuild packages
 408         my %jobs = ();
 409         my @packages = $rebuildable_packages->packages;
 410         my $i = 0;
 411
 412         foreach my $package (@packages) {
 413             $self->remaining_packages->delete($package);
 414
 415             my $job = $scheduler->schedule($package->can('rebuild'), $package,
 416                 $self->local);
 417             if (! defined $job) { next; }
 418             $jobs{$job} = $package;
 419             my %finished = $scheduler->finish(++$i < @packages);
 420
 421             while (my ($job, $status) = each %finished) {
 422                 my $package = $jobs{$job};
 423                 if ($status) {
 424                     # TODO: Push Provides into global list of available
 425                     # provides.
 426                     # XXX: Noting here, fall through to rotation waiting,
 427                     # rebuilt package list tracked in $rebuildable_packages.
 428                 } else {
 429                     $rebuildable_packages->delete($package);
 430                     $self->mark_failed($package);
 431                 }
 432             }
 433         }
 434
 435
 436         # Wait for Koji rotation
 437         # This is separeted from rebuilding process to solve trade-off between
 438         # high threads number (consumes lot of memory and CPU time when
 439         # starting) and the rebuild itself is much faster Koji rotation period
 440         # (lot of time lost to wait for rotation).
 441         %jobs = ();
 442         @packages = $rebuildable_packages->packages;
 443         $i = 0;
 444
 445         foreach my $package (@packages) {
 446             my $job = $scheduler->schedule($package->can('waitforbuildroot'),
 447                 $package, $self->local);
 448             if (! defined $job) { next; }
 449             $jobs{$job} = $package;
 450             my %finished = $scheduler->finish(++$i < @packages);
 451
 452             while (my ($job, $status) = each %finished) {
 453                 my $package = $jobs{$job};
 454                 if ($status) {
 455                     $self->mark_done($package);
 456                 } else {
 457                     $self->mark_failed($package);
 458                 }
 459             }
 460         }
 461     }
 462
 463     if ($self->failed_packages->size > 0) {
 464         print "Rebuild of following packages failed (" .
 465             $self->failed_packages->size . "): " .
 466             $self->failed_packages->string . "\n";
 467         return 0;
 468     } else {
 469         print "All packages have been rebuilt.\n";
 470         return 1;
 471     }
 472 }
 473
 474 1;
 475 __END__
 476 =encoding utf8
 477
 478 =head1 NAME
 479
 480 Fedora::Rebuild - Rebuilds Fedora packages from scratch
 481
 482 =head1 DESCRIPTION
 483
 484 Main goal is to rebuild perl modules packages for Fedora. The rebuild is
 485 driven from bottom to top, i.e. from perl interpreter to modules depending on
 486 intermediate modules. This way, it's possible to upgrade perl interpreter to
 487 incompatible version and to rebuild all modules against the new interpreter.
 488
 489 Procedure is following: We have a set of source package to rebuild. We
 490 distill all build-time dependencies for each source package. We ignore
 491 non-perl dependencies as we focus on Perl only.
 492
 493 We select all source packages that do not depend on anything and push them
 494 into Koji to rebuild. Obviously, the only fulfilling package is Perl interpret
 495 only.
 496
 497 Once the first subset of packages is rebuilt, we gather their binary packages
 498 and distill their binary provides. These freshly available provides are put
 499 into new set of available provides. At the same time we remove the rebuilt
 500 subset from original set of all source packages.
 501
 502 Then we wait for build root rotation in Koji to get rebuilt binary packages
 503 available in build root.
 504
 505 (Of course we could get provides of new binary packages from koji repository
 506 after rotation and we can get provides through repoquery instead of
 507 inspecting binary packages manually.)
 508
 509 If package rebuild fails, the package is removed from future consideration.
 510
 511 Then we return to start of this procedure to select other subset of source
 512 packages whose build-time dependecies can be satisfied from set of binary
 513 provides we have obtained till now.
 514
 515 This loop cycles until set of source packages is empty.
 516
 517 =head1 SYNCHRONIZATION
 518
 519 Because mass rebuild is long term issue and lot of intermediate failures can
 520 emerge, one must be able to resume failed rebuild process.
 521
 522 Safe resume is assured by proper logging. Once a package has been rebuilt, its
 523 name is logged into list of done packages. Restarting rebuild program with the
 524 same arguments loads done packages, remove them from set of remaining
 525 packages, and populates list of available provides. In additon, packages whose
 526 rebuild failed are removed from set of remaining packages.
 527
 528 =head1 AUTHOR
 529
 530 Petr Písař <ppisar@redhat.com>
 531
 532 =head1 COPYING
 533
 534 Copyright (C) 2011  Petr Pisar <ppisar@redhat.com>
 535
 536 This program is free software: you can redistribute it and/or modify
 537 it under the terms of the GNU General Public License as published by
 538 the Free Software Foundation, either version 3 of the License, or
 539 (at your option) any later version.
 540
 541 This program is distributed in the hope that it will be useful,
 542 but WITHOUT ANY WARRANTY; without even the implied warranty of
 543 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 544 GNU General Public License for more details.
 545
 546 You should have received a copy of the GNU General Public License
 547 along with this program.  If not, see <http://www.gnu.org/licenses/>.
 548
 549 =cut
 550