openbsd-ports/infrastructure/bin/dpb

293 lines
6.6 KiB
Perl
Executable File

#! /usr/bin/perl
# ex:ts=8 sw=4:
# $OpenBSD: dpb,v 1.113 2015/07/15 14:30:26 espie Exp $
#
# Copyright (c) 2010-2013 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;
use FindBin;
BEGIN {
$ports1 = $ENV{PORTSDIR} || '/usr/ports';
}
use lib ("$ports1/infrastructure/lib", "$FindBin::Bin/../lib");
package main;
use DPB::State;
use DPB::PkgPath;
use DPB::Core;
use DPB::Core::Init;
use DPB::HostProperties;
use DPB::Shell;
use DPB::Host;
use DPB::Vars;
use DPB::PortInfo;
use DPB::Engine;
use DPB::PortBuilder;
use DPB::Reporter;
use OpenBSD::Error;
use DPB::Job;
use DPB::Grabber;
use DPB::Trace;
my $keep_going = 1;
sub report
{
return DPB::Util->time2string(time)." [$$]".
($keep_going ? "" : " STOPPED!").
"\n";
}
sub affinityclass
{
if (DPB::Core::Init->hostcount > 1 ||
DPB::HostProperties->has_mem) {
require DPB::Affinity;
return "DPB::Affinity";
} else {
require DPB::AffinityStub;
return "DPB::AffinityStub";
}
}
my $subdirlist = {};
DPB::Trace->setup(\%SIG);
my $state = DPB::State->new('dpb');
$state->handle_options;
$state->{all} = 1;
my $default_handling =
sub {
my ($pkgpath, $weight) = @_;
if (defined $weight) {
$state->heuristics->set_weight($pkgpath);
}
$pkgpath->add_to_subdirlist($subdirlist);
$state->{all} = 0;
};
$state->interpret_paths(@{$state->{paths}}, @ARGV,
sub {
&$default_handling(@_);
});
$state->interpret_paths(@{$state->{ipaths}},
sub {
&$default_handling(@_);
my $p = shift;
$p->{wantinstall} = 1;
});
$state->interpret_paths(@{$state->{cpaths}},
sub {
my $p = shift;
$state->{dontclean}{$p->pkgpath} = 1;
});
$state->interpret_paths(@{$state->{xpaths}},
sub {
my $p = shift;
$p->{dontjunk} = 1;
});
if ($state->opt('a')) {
$state->{all} = 1;
}
$state->{build_once} //= $state->{all};
DPB::Core->reap;
$state->handle_build_files;
$state->{builder} = DPB::PortBuilder->new($state);
$state->{affinity} = affinityclass()->new($state, join("/", $state->logdir, "affinity"));
$state->{engine} = DPB::Engine->new($state);
$state->{grabber} = DPB::Grabber->new($state, \&handle_non_waiting_jobs);
my $reporter = DPB::Reporter->new($state, "main", "DPB::Core", $state->engine);
DPB::Trace->set_reporter($reporter);
print "Waiting for hosts to finish STARTUP...";
while (!DPB::Core->avail) {
DPB::Core->reap;
sleep 1;
}
# XXX placeholder
sub reread_config
{
}
my $core = DPB::Core->get;
print "ready on ", $core->hostname, "\n";
if (!$state->{fetch_only} && !$state->{scan_only} &&
DPB::Core::Init->hostcount == 1 && $core->prop->{jobs} == 1) {
$core->clone->mark_ready;
$state->{opt}{e} = 1;
}
my $dump = DPB::Util->make_hot($state->logger->append('dump'));
my $debug = DPB::Util->make_hot($state->logger->append('debug'));
DPB::Trace->set_logger($debug);
sub handle_non_waiting_jobs
{
my $checked = 0;
my $force_report = 0;
my $reaped = DPB::Core->reap;
$keep_going = !-e $state->logdir."/stop";
if (DPB::Core->avail > 1) {
$state->engine->recheck_errors;
}
if (DPB::Core->avail) {
$state->engine->check_buildable;
$checked = 1;
}
while ($keep_going && DPB::Core->avail && $state->engine->can_build) {
$force_report = 1;
if (!$state->engine->start_new_job) {
my $q = $state->engine->{tobuild}{queue};
print $debug "SPINNING ON MAIN\n";
while (my ($k, $v) = each %{$q->{o}}) {
print $debug $k, "=>", $v->logname, "\n";
}
last;
}
}
while ($keep_going && DPB::Core::Fetcher->avail &&
$state->engine->can_fetch) {
if (!$checked) {
$state->engine->check_buildable;
$checked = 1;
}
$force_report = 1;
if (!$state->engine->start_new_fetch) {
print $debug "SPINNING ON FETCH\n";
my $q = $state->engine->{tofetch}{queue};
while (my ($k, $v) = each %{$q->{o}}) {
print $debug $k, "=>", $v->logname, "\n";
}
last;
}
}
DPB::Core->log_concurrency(time(), $state->{concurrent});
DPB::Core->wake_jobs;
$reporter->report($force_report);
}
sub main_loop
{
while (1) {
while (1) {
handle_non_waiting_jobs();
if (!DPB::Core->running) {
last if !$keep_going;
if (!$state->engine->can_build) {
$state->engine->check_buildable(1);
if (!$state->engine->can_build) {
last;
}
}
}
if (DPB::Core->running) {
DPB::Core->reap_wait;
}
if ($state->{fetch_only}) {
if (!DPB::Core::Fetcher->running &&
(!$keep_going || !$state->engine->can_fetch)) {
$state->engine->check_buildable;
if (!$state->engine->can_fetch) {
last;
}
}
}
}
if (!$state->opt('q') || !$state->engine->recheck_errors) {
last;
}
}
}
if ($state->{all} && !$state->{random}) {
# when restarting interrupted dpb,
# find the most important paths first
my $list = $state->engine->find_best($state->logger->logfile("dependencies"), 10);
# if we have them, list them before the full ports tree walk.
if (@$list > 0) {
my $actual = {};
for my $name (@$list) {
DPB::PkgPath->new($name)->add_to_subdirlist($actual);
}
$state->grabber->grab_subdirs($core, $actual);
}
}
if (keys %$subdirlist > 0) {
$state->grabber->grab_subdirs($core, $subdirlist);
}
$state->grabber->complete_subdirs($core);
if ($state->{all}) {
$state->grabber->grab_subdirs($core);
}
$state->grabber->complete_subdirs($core);
# give back "our" core to the pool.
my $occupied = 0;
if ($state->{all}) {
$state->engine->dump_dependencies;
if (!$state->defines('NO_HISTORY')) {
if ($state->grabber->expire_old_distfiles($core,
$state->opt('e'))) {
$occupied = 1;
}
}
}
if (!$state->opt('e') && !$occupied) {
$core->mark_ready;
}
DPB::PkgPath->sanity_check($state);
$state->engine->check_buildable;
if ($state->{scan_only}) {
# very shortened loop
$reporter->report;
if (DPB::Core->running) {
DPB::Core->reap_wait;
}
} else {
# and let's wait for all jobs now.
DPB::Core->start_clock($reporter);
main_loop();
}
$reporter->reset;
DPB::Core->cleanup;
print $state->engine->report;
$state->engine->end_dump($state->logger->append('dump'));