#! /usr/bin/perl # ex:ts=8 sw=4: # $OpenBSD: dpb,v 1.2 2010/08/20 15:22:21 espie Exp $ # # Copyright (c) 2010 Marc Espie # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. use strict; use warnings; my $ports1; BEGIN { $ports1 = $ENV{PORTSDIR} || '/usr/ports'; } use lib "$ports1/infrastructure/lib"; use DPB::PkgPath; use DPB::Core; use DPB::Vars; use DPB::PortInfo; use DPB::Engine; use DPB::PortBuilder; use DPB::Reporter; use OpenBSD::Error; use OpenBSD::State; use DPB::Heuristics; use DPB::Locks; use DPB::Logger; use DPB::Job; use DPB::Grabber; use OpenBSD::Paths; my $make = $ENV{MAKE} || OpenBSD::Paths->make; our ($opt_t, $opt_e, $opt_T, $opt_c, $opt_h, $opt_A, $opt_j, $opt_a, $opt_r, $opt_s, $opt_u, $opt_U, $opt_L, $opt_m, $opt_f, $opt_x); my @subdirlist; sub parse_size_file { my ($fname, @consumers) = @_; open my $fh, '<', $fname or die "Couldn't open build file $fname\n"; my $_; while (<$fh>) { chomp; my ($pkgpath, $sz, $sz2) = split(/\s+/, $_); if (defined $sz2) { $sz += $sz2; } my $o = DPB::PkgPath->new_hidden($pkgpath); for my $c (@consumers) { $c->add_size_info($o, $sz); } } } sub parse_build_line { return split(/\s+/, shift); } sub parse_build_file { my ($fname, @consumers) = @_; open my $fh, '<', $fname or die "Couldn't open build file $fname\n"; my $_; while (<$fh>) { chomp; my ($pkgpath, $host, $time, $sz, @rest) = parse_build_line($_); next if (!defined $sz) || $sz =~ m/!$/; my $o = DPB::PkgPath->new_hidden($pkgpath); for my $c (@consumers) { $c->add_build_info($o, $host, $time, $sz); } } } my @build_files = (); my $heuristics = DPB::Heuristics->new; my $ui = OpenBSD::State->new('dpb3'); $ui->{opt} = { P => sub { my $file = shift; open my $fh, '<', $file or die "Can't open $file\n"; my $_; while (<$fh>) { chomp; next if m/^\#/; unshift @ARGV, $_; } }, b => sub { push(@build_files, shift); }, S => sub { parse_size_file(shift, $heuristics); } }; $ui->handle_options('acersuUh:xA:f:j:m:P:b:L:S:t:T:', "[-acersuUx] [-A arch] [-j N] [-P plist] [-h hosts] [-L logdir]", "[-b log] [-t ctimeout] [-T dtimeout] [-m threshold] [path ...]"); if ($opt_r) { $heuristics->random; } if ($opt_m) { $heuristics->set_threshold($opt_m); } my $dpb = $opt_f ? "fetch" : "normal"; if (@ARGV == 0) { $opt_a = 1; } for my $arg (@ARGV) { my ($path, $weight) = ($arg, 5000); if ($arg =~ m/^(.*)\=(\d+)$/) { ($path, $weight) = ($1, $2); } if ($arg =~ m/^\./) { $ui->usage("Invalid pkgpath: #1", $arg); } my $pkgpath = DPB::PkgPath->new($path); $heuristics->set_weight($pkgpath, $weight); $pkgpath->add_to_subdirlist(\@subdirlist); } my ($ports, $repo, $localarch, $distdir) = DPB::Vars->get($make, "PORTSDIR", "PACKAGE_REPOSITORY", "MACHINE_ARCH", "DISTDIR"); my $arch = $opt_A // $localarch; my $logdir = $opt_L // $ENV{LOGDIR} // "$ports/logs/$arch"; my $lockdir = "$logdir/locks"; my $logger = DPB::Logger->new($logdir, $opt_c); $heuristics->set_logger($logger); if (defined $opt_j && $localarch ne $arch) { $ui->usage("Can't use -j if -A arch is not local architecture"); } if (defined $opt_j && $opt_j !~ m/^\d+$/) { $ui->usage("-j takes a numerical argument"); } my $fullrepo = "$repo/$arch/all"; if ($opt_h) { DPB::Core->parse_hosts_file($opt_h, $arch, $opt_t, $logger, $heuristics); } my $prop = {}; if ($opt_j) { $prop->{jobs} = $opt_j; } if ($opt_j || !$opt_h) { DPB::Core::Factory->new('localhost', $prop); } if (@build_files > 0) { for my $file (@build_files) { parse_build_file($file, $heuristics, "DPB::Job::Port"); } $heuristics->finished_parsing; } DPB::Core::Factory->init_cores($logger); my $builder = DPB::PortBuilder->new( $opt_c, $opt_s, $opt_u, $opt_U, $fullrepo, $logger, $ports, $make, $heuristics); my $locker = DPB::Locks->new($lockdir); my $engine = DPB::Engine->new($builder, $heuristics, $logger, $locker); my $reporter = DPB::Reporter->new($opt_x, $heuristics, "DPB::Core", "DPB::Vars", $engine); while (!DPB::Core->avail) { DPB::Core->reap; sleep 1; } my $core = DPB::Core->get; #my $dump = DPB::Util->make_hot($logger->open('dump')); my $keep_going = 1; $opt_T //= 10; my $last_time = time() - $opt_T; sub handle_non_waiting_jobs { my $need_clock = shift; my $reaped = DPB::Core->reap; $keep_going = !-e "$logdir/stop"; if (DPB::Core->avail) { $engine->check_buildable; } while ($keep_going && DPB::Core->avail && $engine->can_build) { $engine->start_new_job; } if ($need_clock) { my $current = time(); if ($current >= $last_time + $opt_T || $reaped) { $reporter->report; $last_time = $current; } } else { $reporter->report; } return $keep_going; } my $grabber = DPB::Grabber->new($ports, $make, $logger, $engine, $dpb, sub { handle_non_waiting_jobs(1) }); if (@subdirlist > 0) { $grabber->grab_subdirs($core, \@subdirlist); } $grabber->complete_subdirs($core); if ($opt_a) { $grabber->grab_subdirs($core); } $grabber->complete_subdirs($core); # give back "our" core to the pool. if (!$opt_e) { $core->mark_ready; } # and let's wait for all jobs now. $engine->finished_scanning; #$engine->dump($dump); $engine->check_buildable; #$engine->dump($dump); DPB::Core->start_clock($opt_T); while (1) { handle_non_waiting_jobs(0); if (!DPB::Core->running && (!$keep_going || !$engine->can_build)) { $engine->check_buildable; if (!$engine->can_build) { last; } } if (DPB::Core->running) { DPB::Core->reap_wait; } } $reporter->reset; DPB::Core->cleanup; print $engine->report; $engine->dump_category('tobuild', $logger->open('dump'));