290 lines
7.6 KiB
Perl
290 lines
7.6 KiB
Perl
# ex:ts=8 sw=4:
|
|
# $OpenBSD: External.pm,v 1.31 2023/08/14 14:01:42 espie Exp $
|
|
#
|
|
# Copyright (c) 2017 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 v5.36;
|
|
|
|
# socket for external commands
|
|
|
|
package DPB::External;
|
|
use IO::Socket;
|
|
use IO::Select;
|
|
use File::Basename;
|
|
|
|
my $motto = "shut up and hack!";
|
|
sub server($class, $state)
|
|
{
|
|
my $o = bless {state => $state,
|
|
subdirlist => {},
|
|
path => $state->expand_path($state->{subst}->value('CONTROL')),
|
|
prompt => $state->expand_path('dpb@%h[%$]$ ')
|
|
}, $class;
|
|
|
|
$state->{log_user}->make_path(File::Basename::dirname($o->{path}));
|
|
# this ensures the socket belongs to log_user.
|
|
$state->{log_user}->run_as(
|
|
sub() {
|
|
unlink($o->{path});
|
|
$o->{server} = IO::Socket::UNIX->new(
|
|
Type => SOCK_STREAM,
|
|
Local => $o->{path});
|
|
if (!defined $o->{server}) {
|
|
$state->errsay("Can't create socket named #1: #2",
|
|
$o->{path}, $!);
|
|
} elsif (!chmod 0700, $o->{path}) {
|
|
$state->errsay(
|
|
"Can't enforce permissions for socket #1:#2",
|
|
$o->{path}, $!);
|
|
unlink($o->{path});
|
|
delete $o->{server};
|
|
}
|
|
});
|
|
if (defined $o->{server}) {
|
|
# NOW we can listen
|
|
$o->{server}->listen;
|
|
$o->{select} = IO::Select->new($o->{server});
|
|
$state->say("Control socket: #1", $o->{path});
|
|
return $o;
|
|
} else {
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
sub cleanup($self)
|
|
{
|
|
$self->{state}{log_user}->unlink($self->{path});
|
|
}
|
|
|
|
sub status($self, $v)
|
|
{
|
|
if (!defined $v->{info}) {
|
|
return "unscanned/unknown";
|
|
}
|
|
if ($v->{info}->is_stub) {
|
|
return "ignored";
|
|
}
|
|
my $status = $self->{state}->{engine}->status($v);
|
|
if (!defined $status) {
|
|
$status = DPB::Core->status($v);
|
|
}
|
|
if (!defined $status) {
|
|
return "???";
|
|
}
|
|
return $status;
|
|
}
|
|
|
|
sub wipe($self, $fh, $p)
|
|
{
|
|
my $v = DPB::PkgPath->new($p);
|
|
my $state = $self->{state};
|
|
my $info = $state->locker->get_info($v);
|
|
if ($info->is_bad) {
|
|
$fh->print($p, " is not locked\n");
|
|
} elsif (defined $info->{locked}) {
|
|
if ($info->{same_pid} && !$info->{errored}) {
|
|
$fh->print($p, " is still running\n");
|
|
return;
|
|
}
|
|
my $h = DPB::Host->retrieve($info->{host});
|
|
if (!defined $h) {
|
|
$fh->print("Can't wipe on $info->{host}: no such host\n");
|
|
} elsif (!$h->is_alive) {
|
|
$fh->print("Can't wipe on $info->{host}: host is AWOL\n");
|
|
} else {
|
|
$fh->print("cleaning up $info->{locked}\n");
|
|
my $w = DPB::PkgPath->new($info->{locked});
|
|
# steal a temporary core
|
|
$state->engine->wipe($w, DPB::Core->new_noreg($h));
|
|
}
|
|
}
|
|
}
|
|
|
|
sub stub_out($self, $fh, $p)
|
|
{
|
|
my $v = DPB::PkgPath->new($p);
|
|
my $state = $self->{state};
|
|
my $info = $state->locker->get_info($v);
|
|
if ($info->is_bad) {
|
|
$state->engine->stub_out($v);
|
|
} elsif (defined $info->{locked}) {
|
|
if ($info->{same_pid} && !$info->{errored}) {
|
|
$fh->print($p, " is still running\n");
|
|
return;
|
|
}
|
|
my $w = DPB::PkgPath->new($info->{locked});
|
|
if ($w ne $v) {
|
|
$fh->print($p, " doesn't match ", $w->fullpkgpath, "\n");
|
|
return;
|
|
}
|
|
$state->engine->stub_out($v);
|
|
$state->locker->unlock($v);
|
|
}
|
|
}
|
|
|
|
sub wipehost($self, $fh, $h)
|
|
{
|
|
# kill the stuff that's running
|
|
DPB::Core->wipehost($h);
|
|
my $state = $self->{state};
|
|
# zap the locks as well
|
|
$state->locker->wipehost($h);
|
|
for my $p (DPB::PkgPath->seen) {
|
|
next unless defined $p->{affinity};
|
|
next unless $p->{affinity} eq $h;
|
|
$state->{affinity}->unmark($p);
|
|
}
|
|
}
|
|
|
|
sub summary($self, $fh, $name)
|
|
{
|
|
my $state = $self->{state};
|
|
my $f = $state->logger->append($name);
|
|
if (!defined $f) {
|
|
$fh->print("Can't append to $name: $!\n");
|
|
return;
|
|
}
|
|
# XXX smart_dump is destructive, so run it on a copy
|
|
my $pid = CORE::fork;
|
|
if (!defined $pid) {
|
|
$fh->print("Couldn't fork: $!\n");
|
|
return;
|
|
}
|
|
if ($pid == 0) {
|
|
$state->engine->smart_dump($f);
|
|
exit(0);
|
|
} else {
|
|
waitpid($pid, 0);
|
|
$fh->print("Summary written to ".
|
|
$state->logger->logfile($name)."\n");
|
|
}
|
|
}
|
|
|
|
sub handle_command($self, $line, $fh)
|
|
{
|
|
my $state = $self->{state};
|
|
if ($line =~ m/^dontclean\s+(.*)/) {
|
|
for my $p (split(/\s+/, $1)) {
|
|
$state->{dontclean}{$p} = 1;
|
|
}
|
|
} elsif ($line =~ m/^addhost\s+(.*)/) {
|
|
my @list = split(/\s+/, $1);
|
|
if (!DPB::Config->add_host($state, @list)) {
|
|
$fh->print("Can't add: host already exists\n");
|
|
}
|
|
} elsif ($line =~ m/^stats\b/) {
|
|
$fh->print($state->engine->statline, "\n");
|
|
} elsif ($line =~ m/^info\s+cores\b/) {
|
|
DPB::Core->stats($fh, $state);
|
|
} elsif ($line =~ m/^info\s+queue\b/) {
|
|
$state->engine->dump_queue($fh, $state);
|
|
} elsif ($line =~ m/^status\s+(.*)/) {
|
|
for my $p (split(/\s+/, $1)) {
|
|
my $v = DPB::PkgPath->new($p);
|
|
$v->quick_dump($fh);
|
|
$fh->print("\t", $self->status($v), "\n");
|
|
}
|
|
} elsif ($line =~ m/^pf{6}\b/) {
|
|
$fh->print($motto, "\n");
|
|
} elsif ($line =~ m/^addpath\s+(.*)/) {
|
|
$state->interpret_paths(split(/\s+/, $1),
|
|
sub($pkgpath, $weight = undef) {
|
|
if (defined $weight) {
|
|
$state->heuristics->set_weight($pkgpath);
|
|
}
|
|
$pkgpath->add_to_subdirlist($self->{subdirlist});
|
|
});
|
|
if (defined $state->{bad_paths}) {
|
|
$fh->print("Bad package path ",
|
|
join(" ", @{$state->{bad_paths}}), "\n");
|
|
delete $state->{bad_paths};
|
|
}
|
|
} elsif ($line =~ m/^wipe\s+(.*)/) {
|
|
for my $p (split(/\s+/, $1)) {
|
|
$self->wipe($fh, $1);
|
|
}
|
|
} elsif ($line =~ m/^stub\s+(.*)/) {
|
|
for my $p (split(/\s+/, $1)) {
|
|
$self->stub_out($fh, $1);
|
|
}
|
|
} elsif ($line =~ m/^wipehost\s+(.*)/) {
|
|
for my $p (split(/\s+/, $1)) {
|
|
$self->wipehost($fh, $1);
|
|
}
|
|
} elsif ($line =~ m/^rescan\b/) {
|
|
for my $v (DPB::PkgPath->seen) {
|
|
if (defined $v->{info} && $v->{info}->is_stub) {
|
|
$v->add_to_subdirlist($self->{subdirlist});
|
|
}
|
|
}
|
|
} elsif ($line =~ m/^summary(?:\s+(.*))?/) {
|
|
$self->summary($fh, $1 // 'summary');
|
|
} elsif ($line =~ m/^help\b/) {
|
|
$fh->print(
|
|
"Commands:\n",
|
|
"\taddhost <hostline>\n",
|
|
"\taddpath <fullpkgpath>...\n",
|
|
"\tbye\n",
|
|
"\tdontclean <pkgpath>...\n",
|
|
"\tinfo cores\n",
|
|
"\trescan\n",
|
|
"\tstats\n",
|
|
"\tstatus <fullpkgpath>...\n",
|
|
"\tstub <fullpkgpath>...\n",
|
|
"\tsummary [<logname>]\n",
|
|
"\twipe <fullpkgpath>...\n",
|
|
"\twipehost <hostname>...\n"
|
|
);
|
|
} else {
|
|
$fh->print("Unknown command or bad syntax: ", $line, " (help for details)\n");
|
|
}
|
|
$fh->print($self->{prompt});
|
|
}
|
|
|
|
sub receive_commands($self)
|
|
{
|
|
while (my @ready = $self->{select}->can_read(0)) {
|
|
foreach my $fh (@ready) {
|
|
if ($fh == $self->{server}) {
|
|
my $n = $fh->accept;
|
|
$self->{select}->add($n);
|
|
$n->print($self->{prompt});
|
|
} else {
|
|
my $line = $fh->getline;
|
|
if (!defined $line || $line =~ m/^bye$/) {
|
|
$fh->close;
|
|
$self->{select}->remove($fh);
|
|
} else {
|
|
chomp $line;
|
|
$self->handle_command($line, $fh);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
my $state = $self->{state};
|
|
|
|
if (keys %{$self->{subdirlist}} > 0 &&
|
|
DPB::Core->avail($state->{listing_host})) {
|
|
# XXX store value first, re-entrancy
|
|
my $subdirlist = $self->{subdirlist};
|
|
$self->{subdirlist} = {};
|
|
my $core = DPB::Core->get($state->{listing_host});
|
|
$state->grabber->grab_subdirs($core, $subdirlist, undef);
|
|
$state->grabber->complete_subdirs($core, undef, 0);
|
|
$core->mark_ready;
|
|
}
|
|
}
|
|
|
|
1;
|