273 lines
6.3 KiB
Perl
Executable File
273 lines
6.3 KiB
Perl
Executable File
#! /usr/bin/perl
|
|
|
|
# ex:ts=8 sw=4:
|
|
# $OpenBSD: dpb3,v 1.19 2010/06/09 12:01:08 espie Exp $
|
|
#
|
|
# Copyright (c) 2010 Marc Espie <espie@openbsd.org>
|
|
#
|
|
# 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';
|
|
}
|
|
$0 = 'dpb';
|
|
use FindBin;
|
|
use lib "$FindBin::Bin";
|
|
use lib "$ports1/infrastructure/build";
|
|
use DPB::PkgPath;
|
|
use DPB::Core;
|
|
use DPB::Vars;
|
|
use DPB::PortInfo;
|
|
use DPB::Engine;
|
|
use DPB::PortBuilder;
|
|
use DPB::Reporter;
|
|
use OpenBSD::Getopt;
|
|
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 $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->usage_is("[-acersuUx] [-A arch] [-j N] [-P plist] [-h hosts] [-L logdir]",
|
|
"[-b log] [-t ctimeout] [-T dtimeout] [-m threshold] [path ...]");
|
|
$ui->do_options(
|
|
sub {
|
|
getopts('acersuUh:xA:f:j:m:P:b:L:S:t:T:', {
|
|
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);
|
|
}
|
|
}
|
|
);
|
|
});
|
|
|
|
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'));
|