mirror of
https://github.com/pragma-/pbot.git
synced 2025-10-13 22:47:26 +02:00
applets/pbot-vm: restore VSOCK functionality
- restore ability to execute VM commands concurrently via VSOCK - add PID to log messages and truncate overly long messages
This commit is contained in:
Pragmatic Software
parent
891baed35f
commit
483a782021
@ -22,42 +22,63 @@ use English;
|
||||
use Encode;
|
||||
use File::Basename;
|
||||
use JSON::XS;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use POSIX;
|
||||
|
||||
use Data::Dumper;
|
||||
$Data::Dumper::Useqq = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$Data::Dumper::Indent = 0;
|
||||
|
||||
sub info($text, $maxlen = 255) {
|
||||
my $rest;
|
||||
($text, $rest) = $text =~ m/^(.{0,$maxlen})(.*)/ms;
|
||||
$rest = length $rest;
|
||||
$text .= " [... $rest more]" if $rest;
|
||||
$text .= "\n" if $text !~ /\n$/;
|
||||
my ($sec, $usec) = gettimeofday;
|
||||
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
|
||||
$time .= sprintf ".%03d", $usec / 1000;
|
||||
print STDERR "$$ $time :: $text";
|
||||
}
|
||||
|
||||
sub read_input($input, $buffer, $tag) {
|
||||
my $line;
|
||||
|
||||
print STDERR "$tag waiting for input...\n";
|
||||
info("$tag waiting for input...\n");
|
||||
my $ret = sysread($input, my $buf, 4096);
|
||||
|
||||
if (not defined $ret) {
|
||||
print STDERR "Error reading $tag: $!\n";
|
||||
info("Error reading $tag: $!\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
if ($ret == 0) {
|
||||
print STDERR "$tag input closed.\n";
|
||||
info("$tag input closed.\n");
|
||||
return 0;
|
||||
}
|
||||
|
||||
print STDERR "$tag read $ret bytes [$buf]\n";
|
||||
info("$tag read $ret [" . (Dumper $buf) . "]\n");
|
||||
|
||||
if ($buf ne "\n") {
|
||||
chomp $buf;
|
||||
$$buffer .= $buf;
|
||||
$$buffer .= $buf;
|
||||
|
||||
# info("$tag buffer [" . (Dumper $$buffer) . "]\n", 8192);
|
||||
|
||||
if ($$buffer !~ /\n\n/) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
$line = $$buffer;
|
||||
$$buffer = '';
|
||||
my $line;
|
||||
($line, $$buffer) = split /\n\n/, $$buffer, 2;
|
||||
$line =~ s/\n//g;
|
||||
|
||||
print STDERR "-" x 40, "\n";
|
||||
print STDERR "$tag got [$line]\n";
|
||||
info(("-" x 40) . "\n");
|
||||
|
||||
# info("$tag got [" . (Dumper $line) . "]\n", 8192);
|
||||
# info("$tag buffer [" . (Dumper $$buffer) . "]\n", 8192);
|
||||
|
||||
my $command = eval { decode_json($line) };
|
||||
|
||||
if ($@) {
|
||||
print STDERR "Failed to decode JSON: $@\n";
|
||||
info("Failed to decode JSON: $@\n", 1024);
|
||||
return {
|
||||
arguments => '',
|
||||
cmdline => 'sh prog.sh',
|
||||
@ -73,8 +94,7 @@ sub read_input($input, $buffer, $tag) {
|
||||
$command->{arguments} //= '';
|
||||
$command->{input} //= '';
|
||||
|
||||
print STDERR Dumper($command), "\n";
|
||||
|
||||
info("command: " . Dumper($command), 2048);
|
||||
return $command;
|
||||
}
|
||||
|
||||
@ -82,14 +102,14 @@ sub process_command($command, $mod, $user, $tag) {
|
||||
my ($uid, $gid, $home) = (getpwnam $user)[2, 3, 7];
|
||||
|
||||
if (not $uid and not $gid) {
|
||||
print STDERR "Could not find user $user: $!\n";
|
||||
info("Could not find user $user: $!\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $pid = fork;
|
||||
|
||||
if (not defined $pid) {
|
||||
print STDERR "process_command: fork failed: $!\n";
|
||||
info("process_command: fork failed: $!\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
@ -108,9 +128,10 @@ sub process_command($command, $mod, $user, $tag) {
|
||||
system("chmod -R 755 $dir 1>&2");
|
||||
system("chown -R $user $dir 1>&2");
|
||||
system("chgrp -R $user $dir 1>&2");
|
||||
system("pkill -u $user 1>&2");
|
||||
|
||||
system("date -s \@$command->{date} 1>&2");
|
||||
if (time - $command->{date} > 60) {
|
||||
system("date -s \@$command->{date} 1>&2");
|
||||
}
|
||||
|
||||
$ENV{USER} = $user;
|
||||
$ENV{LOGNAME} = $user;
|
||||
@ -124,7 +145,7 @@ sub process_command($command, $mod, $user, $tag) {
|
||||
|
||||
my $result = run_command($command, $mod);
|
||||
|
||||
print STDERR "=" x 40, "\n";
|
||||
info(("=" x 40) . "\n");
|
||||
|
||||
# ensure output is newline-terminated
|
||||
$result .= "\n" unless $result =~ /\n$/;
|
||||
@ -132,7 +153,16 @@ sub process_command($command, $mod, $user, $tag) {
|
||||
return $result;
|
||||
} else {
|
||||
# wait for child to finish
|
||||
waitpid($pid, 0);
|
||||
my $kid = waitpid($pid, 0);
|
||||
my $status = $?;
|
||||
|
||||
if (WIFEXITED($status)) {
|
||||
info("child normal exit: " . WEXITSTATUS($status) . "\n");
|
||||
}
|
||||
|
||||
if (WIFSIGNALED($status)) {
|
||||
info("child signaled exit: " . WTERMSIG($status) . "\n");
|
||||
}
|
||||
|
||||
# clean up persistent factoid storage
|
||||
if ($command->{'persist-key'}) {
|
||||
@ -141,8 +171,8 @@ sub process_command($command, $mod, $user, $tag) {
|
||||
system ("rm -rf \"/home/$user/$command->{'persist-key'}\"");
|
||||
}
|
||||
|
||||
# kill any left-over processes started by $user
|
||||
system("pkill -u $user");
|
||||
# kill any left-over processes started by user
|
||||
system("pkill -P $pid");
|
||||
system("rm -rf /home/$user/$pid");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -8,15 +8,34 @@ package _default;
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use feature qw/signatures/;
|
||||
no warnings qw/experimental::signatures/;
|
||||
|
||||
use IPC::Run qw/run timeout/;
|
||||
use Encode;
|
||||
|
||||
use SplitLine;
|
||||
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use POSIX;
|
||||
|
||||
use Data::Dumper;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$Data::Dumper::Sortkeys = 1;
|
||||
$Data::Dumper::Useqq = 1;
|
||||
$Data::Dumper::Indent = 0;
|
||||
|
||||
sub info($text, $maxlen = 255) {
|
||||
my $rest;
|
||||
($text, $rest) = $text =~ m/^(.{0,$maxlen})(.*)/ms;
|
||||
$rest = length $rest;
|
||||
$text .= " [... $rest more]" if $rest;
|
||||
$text .= "\n" if $text !~ /\n$/;
|
||||
my ($sec, $usec) = gettimeofday;
|
||||
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
|
||||
$time .= sprintf ".%03d", $usec / 1000;
|
||||
print STDERR "$$ $time :: $text";
|
||||
}
|
||||
|
||||
sub new {
|
||||
my ($class, %conf) = @_;
|
||||
@ -82,7 +101,7 @@ sub execute {
|
||||
$stdin = encode('UTF-8', $stdin);
|
||||
@cmdline = map { encode('UTF-8', $_) } @cmdline;
|
||||
|
||||
print STDERR "execute ($timeout) [$stdin] @cmdline\n";
|
||||
info("execute ($timeout) [$stdin] @cmdline\n");
|
||||
|
||||
my ($exitval, $stdout, $stderr) = eval {
|
||||
my ($stdout, $stderr);
|
||||
@ -96,10 +115,7 @@ sub execute {
|
||||
($exitval, $stdout, $stderr) = (-1, '', $exception);
|
||||
}
|
||||
|
||||
$Data::Dumper::Indent = 0;
|
||||
print STDERR "exitval $exitval stderr [", Dumper($stderr), "] stdout [", Dumper($stdout), "]\n";
|
||||
$Data::Dumper::Indent = 1;
|
||||
|
||||
info("exitval $exitval stderr [" . Dumper($stderr) . "] stdout [" . Dumper($stdout) . "]\n");
|
||||
return ($exitval, $stdout, $stderr);
|
||||
}
|
||||
|
||||
|
||||
@ -38,14 +38,34 @@ use File::Basename;
|
||||
use JSON::XS;
|
||||
use IPC::Open2;
|
||||
use IO::Socket;
|
||||
use Socket qw/IPPROTO_TCP TCP_NODELAY/;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use POSIX;
|
||||
|
||||
use Data::Dumper;
|
||||
$Data::Dumper::Useqq = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$Data::Dumper::Indent = 0;
|
||||
|
||||
use FindBin qw($RealBin);
|
||||
use lib "$RealBin/../lib";
|
||||
|
||||
sub info($text, $maxlen = 255) {
|
||||
my $rest;
|
||||
($text, $rest) = $text =~ m/^(.{0,$maxlen})(.*)/ms;
|
||||
$rest = length $rest;
|
||||
$text .= " [... $rest more]" if $rest;
|
||||
$text .= "\n" if $text !~ /\n$/;
|
||||
my ($sec, $usec) = gettimeofday;
|
||||
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
|
||||
$time .= sprintf ".%03d", $usec / 1000;
|
||||
print STDERR "[$$] $time :: $text";
|
||||
}
|
||||
|
||||
sub connect_vsock($context) {
|
||||
return undef if not $context->{'vm-cid'};
|
||||
|
||||
print STDERR "Connecting to remote VM socket CID $context->{'vm-cid'} port $context->{'vm-vport'}\n";
|
||||
info("Connecting to remote VM socket CID $context->{'vm-cid'} port $context->{'vm-vport'}\n");
|
||||
|
||||
my $command = "socat - VSOCK-CONNECT:$context->{'vm-cid'}:$context->{'vm-vport'}";
|
||||
|
||||
@ -55,12 +75,12 @@ sub connect_vsock($context) {
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print STDERR "Failed to connect to VM socket: $@\n";
|
||||
info("Failed to connect to VM socket: $@\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
if (not defined $pid) {
|
||||
print STDERR "Failed to connect to VM socket: $!\n";
|
||||
info("Failed to connect to VM socket: $!\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
@ -68,7 +88,7 @@ sub connect_vsock($context) {
|
||||
}
|
||||
|
||||
sub connect_serial($context) {
|
||||
print STDERR "Connecting to remote VM serial port $context->{'vm-serial'}\n";
|
||||
info("Connecting to remote VM serial port $context->{'vm-serial'}\n");
|
||||
|
||||
my $vm = IO::Socket::INET->new(
|
||||
PeerAddr => $context->{'vm-addr'},
|
||||
@ -77,6 +97,9 @@ sub connect_serial($context) {
|
||||
Type => SOCK_STREAM
|
||||
);
|
||||
|
||||
$vm->autoflush(1);
|
||||
$vm->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1);
|
||||
|
||||
# return same $vm handle for ($input, $output)
|
||||
return ($vm, $vm);
|
||||
}
|
||||
@ -96,7 +119,7 @@ sub connect_vm($context) {
|
||||
die "Could not create connection to VM: $!";
|
||||
}
|
||||
|
||||
print STDERR "Connected to VM.\n";
|
||||
info("Connected to VM.\n");
|
||||
return ($input, $output);
|
||||
}
|
||||
|
||||
@ -123,14 +146,14 @@ sub make_context_from_args(@args_in) {
|
||||
|
||||
# set extracted leading options
|
||||
foreach my $opt (keys %opts) {
|
||||
print STDERR "Setting option `$opt`.\n";
|
||||
info("Setting option `$opt`.\n");
|
||||
$context->{$opt} = 1;
|
||||
}
|
||||
|
||||
# parse options specific to vm-exec
|
||||
while ($context->{code} =~ s/^-(lang|revert|health|vm-domain|vm-health|vm-cid|vm-vport|vm-serial|vm)=([^ ]+)\s*//) {
|
||||
my ($option, $value) = ($1, $2);
|
||||
print STDERR "Overriding `$option` to `$value`.\n";
|
||||
info("Overriding `$option` to `$value`.\n");
|
||||
$context->{$option} = lc $value;
|
||||
}
|
||||
|
||||
@ -264,7 +287,7 @@ sub main() {
|
||||
configure_context($context, $config);
|
||||
|
||||
if ($context->{revert} && $context->{health}) {
|
||||
print STDERR "-health and -revert cannot be used together; aborting.\n";
|
||||
info("-health and -revert cannot be used together; aborting.\n");
|
||||
exit 0;
|
||||
}
|
||||
|
||||
@ -274,7 +297,7 @@ sub main() {
|
||||
$context->{'vm-domain'} = $config->{aliases}->{$context->{'vm-domain'}};
|
||||
}
|
||||
|
||||
print STDERR "REVERT $context->{'vm-domain'}\n";
|
||||
info("REVERT $context->{'vm-domain'}\n");
|
||||
|
||||
if ($context->{'vm-vagrant'}) {
|
||||
system("virsh -c qemu:///system snapshot-revert $context->{'vm-domain'} 1");
|
||||
@ -295,7 +318,7 @@ sub main() {
|
||||
);
|
||||
|
||||
if (not defined $health) {
|
||||
print STDERR "Unable to connect to health $context->{'vm-addr'} $context->{'vm-health'}\n";
|
||||
info("Unable to connect to health $context->{'vm-addr'} $context->{'vm-health'}\n");
|
||||
exit 2;
|
||||
}
|
||||
|
||||
@ -313,7 +336,7 @@ sub main() {
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print STDERR "Failed to get health: $@\n";
|
||||
info("Failed to get health: $@\n");
|
||||
exit 1;
|
||||
}
|
||||
|
||||
|
||||
@ -22,28 +22,46 @@ use Net::hostent;
|
||||
use IPC::Shareable;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Encode;
|
||||
use POSIX;
|
||||
|
||||
use Data::Dumper;
|
||||
$Data::Dumper::Useqq = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$Data::Dumper::Indent = 0;
|
||||
|
||||
use constant {
|
||||
SERVER_PORT => $ENV{PBOTVM_PORT} // 9000,
|
||||
COMPILE_TIMEOUT => $ENV{PBOTVM_TIMEOUT} // 10,
|
||||
};
|
||||
|
||||
sub info($text, $maxlen = 255) {
|
||||
my $rest;
|
||||
($text, $rest) = $text =~ m/^(.{0,$maxlen})(.*)/ms;
|
||||
$rest = length $rest;
|
||||
$text .= " [... $rest more]" if $rest;
|
||||
$text .= "\n" if $text !~ /\n$/;
|
||||
my ($sec, $usec) = gettimeofday;
|
||||
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
|
||||
$time .= sprintf ".%03d", $usec / 1000;
|
||||
print STDERR "[$$] $time :: $text";
|
||||
}
|
||||
|
||||
sub vm_revert($input) {
|
||||
return if $ENV{PBOTVM_NOREVERT};
|
||||
print "Reverting vm...\n";
|
||||
info("Reverting vm...\n");
|
||||
execute("perl vm-exec -revert $input", 1000);
|
||||
print "Reverted.\n";
|
||||
info("Reverted.\n");
|
||||
}
|
||||
|
||||
sub vm_check_health($input) {
|
||||
print "Checking health...\n";
|
||||
info("Checking health...\n");
|
||||
my ($ret, $result) = execute("perl vm-exec -health $input", 2);
|
||||
print "$result\n" if length $result;
|
||||
info("$result\n") if length $result;
|
||||
return ($ret, $result);
|
||||
}
|
||||
|
||||
sub execute($command, $timeout = COMPILE_TIMEOUT) {
|
||||
print "execute ($command)\n";
|
||||
info("execute ($command)\n", 1024);
|
||||
|
||||
# to get $? from pipe
|
||||
local $SIG{CHLD} = 'DEFAULT';
|
||||
@ -51,7 +69,7 @@ sub execute($command, $timeout = COMPILE_TIMEOUT) {
|
||||
my $pid = open(my $fh, '-|', split / /, encode('UTF-8', $command));
|
||||
|
||||
if (not defined $pid) {
|
||||
print "Couldn't fork: $!\n";
|
||||
info("Couldn't fork: $!\n");
|
||||
return (-13, "[Fatal error]");
|
||||
}
|
||||
|
||||
@ -94,27 +112,27 @@ sub server_listen($port) {
|
||||
Reuse => 1,
|
||||
);
|
||||
die "Can't setup server: $!" unless $server;
|
||||
print "Server $0 accepting clients at :$port\n";
|
||||
info("Server $0 accepting clients at :$port\n");
|
||||
return $server;
|
||||
}
|
||||
|
||||
sub do_server() {
|
||||
print "Starting PBot VM Server on port " . SERVER_PORT . "\n";
|
||||
info("Starting PBot VM Server on port " . SERVER_PORT . "\n");
|
||||
my $server = eval { server_listen(SERVER_PORT) };
|
||||
|
||||
if ($@) {
|
||||
print STDERR $@;
|
||||
info($@);
|
||||
return;
|
||||
}
|
||||
|
||||
while (my $client = $server->accept) {
|
||||
print '-' x 20, "\n";
|
||||
info('-' x 20 . "\n");
|
||||
my $hostinfo = gethostbyaddr($client->peeraddr);
|
||||
print "Connect from ", $client->peerhost, " at ", scalar localtime, "\n";
|
||||
info("Connect from " . $client->peerhost . "\n");
|
||||
handle_client($client);
|
||||
}
|
||||
|
||||
print "Shutting down server.\n";
|
||||
info("Shutting down server.\n");
|
||||
}
|
||||
|
||||
sub handle_client($client) {
|
||||
@ -123,7 +141,7 @@ sub handle_client($client) {
|
||||
my $r = fork;
|
||||
|
||||
if (not defined $r) {
|
||||
print "Could not fork to handle client: $!\n";
|
||||
info("Could not fork to handle client: $!\n");
|
||||
print $client "Fatal error.\n";
|
||||
close $client;
|
||||
return;
|
||||
@ -151,19 +169,19 @@ sub handle_client($client) {
|
||||
# give client 5 more seconds
|
||||
alarm 5;
|
||||
|
||||
print "[$$] Read [$input]\n";
|
||||
info("Read [" . Dumper($input) . "]\n");
|
||||
|
||||
# check health
|
||||
my ($health, $health_message) = vm_check_health($input);
|
||||
|
||||
if ($health == 2) {
|
||||
print "[$$] Unable to connect to VM health check, ignoring compile attempt.\n";
|
||||
info("Unable to connect to VM health check, ignoring compile attempt.\n");
|
||||
print $client "Virtual machine is offline.\n";
|
||||
last;
|
||||
}
|
||||
|
||||
if ($health == 1 || $health == -13) {
|
||||
print "[$$] VM not responding to health check, ignoring compile attempt.\n";
|
||||
info("VM not responding to health check, ignoring compile attempt.\n");
|
||||
print $client "Virtual machine is temporarily unavailable, try again soon.\n";
|
||||
last;
|
||||
}
|
||||
@ -183,7 +201,7 @@ sub handle_client($client) {
|
||||
my ($ret, $result) = execute("perl vm-exec $input");
|
||||
|
||||
$result =~ s/\s+$//;
|
||||
print "Ret: $ret; result: [$result]\n";
|
||||
info("Ret: $ret; result: [" . Dumper($result) . "]\n");
|
||||
|
||||
if ($result =~ m/\[Killed\]$/) {
|
||||
$killed = 1;
|
||||
@ -202,20 +220,20 @@ sub handle_client($client) {
|
||||
};
|
||||
|
||||
# print client time-out exception
|
||||
print "[$$] $@" if $@;
|
||||
info($@) if $@;
|
||||
|
||||
alarm 0;
|
||||
close $client;
|
||||
|
||||
print "[$$] timed out: $timed_out; killed: $killed\n";
|
||||
info("timed out: $timed_out; killed: $killed\n");
|
||||
|
||||
if ($timed_out || $killed) {
|
||||
vm_revert($input);
|
||||
}
|
||||
|
||||
# child done
|
||||
print "[$$] client exit\n";
|
||||
print "=" x 20, "\n";
|
||||
info("client exit\n");
|
||||
info("=" x 20 . "\n");
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
@ -21,8 +21,6 @@ our @EXPORT = qw(interactive_edit);
|
||||
sub interactive_edit($self) {
|
||||
my $code = $self->{code};
|
||||
|
||||
print " code: [$code]\n" if $self->{debug};
|
||||
|
||||
my $subcode = $code;
|
||||
while ($subcode =~ s/^\s*(-[^ ]+)\s*//) {}
|
||||
|
||||
|
||||
@ -21,6 +21,7 @@ use POSIX;
|
||||
|
||||
use Data::Dumper;
|
||||
$Data::Dumper::Useqq = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
|
||||
use FindBin qw($RealBin);
|
||||
|
||||
@ -140,7 +141,7 @@ sub preprocess_code($self, %opts) {
|
||||
|
||||
unless($self->{got_run} and $self->{copy_code}) {
|
||||
$self->info("---- preprocess\n");
|
||||
$self->info("$self->{nick} $self->{channel}: [$self->{arguments}] $self->{cmdline_options}\n$self->{code}\n",0);
|
||||
$self->info("$self->{nick} $self->{channel}: [$self->{arguments}] $self->{cmdline_options}\n$self->{code}\n", 0, 8192);
|
||||
}
|
||||
|
||||
# replace \n outside of quotes with literal newline
|
||||
@ -257,7 +258,7 @@ sub execute {
|
||||
}
|
||||
|
||||
$self->info("---- executing\n");
|
||||
$self->info("$cmdline\n$stdin\n$pretty_code\n", 0);
|
||||
$self->info("$cmdline\n$stdin\n$pretty_code\n", 0, 8192);
|
||||
|
||||
my $compile_in = {
|
||||
lang => $self->{lang},
|
||||
@ -283,14 +284,14 @@ sub execute {
|
||||
my @lines = unpack("(A$chunk_size)*", $compile_json);
|
||||
push @lines, '';
|
||||
|
||||
$self->debug("Lines:\n" . (Dumper(\@lines))) if $self->{debug} > 1;
|
||||
$self->info("Lines:\n" . Dumper(\@lines) . "\n", 1, 8192) if $self->{debug} > 1;
|
||||
|
||||
foreach my $line (@lines) {
|
||||
$line .= "\n";
|
||||
my $length = length $line;
|
||||
my $sent = 0;
|
||||
|
||||
$self->debug("writing [$line]\n") if $self->{debug} > 1;
|
||||
$self->debug("writing [" . (Dumper $line) . "]\n") if $self->{debug} > 1;
|
||||
|
||||
while ($sent < $length) {
|
||||
my $ret = syswrite($input, $line, $chunk_size + 1, $sent);
|
||||
@ -333,9 +334,7 @@ sub execute {
|
||||
}
|
||||
|
||||
close $input;
|
||||
|
||||
$self->{output} = $result;
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
@ -492,22 +491,28 @@ sub show_output($self) {
|
||||
close $fh;
|
||||
}
|
||||
|
||||
sub debug($self, $text, $timestamp = 1) {
|
||||
sub debug($self, $text, $timestamp = 1, $maxlen = 255) {
|
||||
return if not $self->{debug};
|
||||
$self->info($text, $timestamp);
|
||||
$self->info($text, $timestamp, $maxlen);
|
||||
}
|
||||
|
||||
sub info($self, $text, $timestamp = 1) {
|
||||
sub info($self, $text, $timestamp = 1, $maxlen = 255) {
|
||||
if (not exists $self->{logh}) {
|
||||
open $self->{logh}, '>>:encoding(UTF-8)', "$RealBin/../log.txt" or die "Could not open log file: $!";
|
||||
}
|
||||
|
||||
my $rest;
|
||||
($text, $rest) = $text =~ m/^(.{0,$maxlen})(.*)/ms;
|
||||
$rest = length $rest;
|
||||
$text .= " [... $rest more]" if $rest;
|
||||
$text .= "\n" if $text !~ /\n$/;
|
||||
|
||||
if ($timestamp) {
|
||||
my ($sec, $usec) = gettimeofday;
|
||||
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
|
||||
$time .= sprintf ".%03d", $usec / 1000;
|
||||
print STDERR "$time :: $text";
|
||||
print { $self->{logh} } "$time :: $text";
|
||||
print STDERR "[$$] $time :: $text";
|
||||
print { $self->{logh} } "[$$] $time :: $text";
|
||||
} else {
|
||||
print STDERR $text;
|
||||
print { $self->{logh} } $text;
|
||||
|
||||
@ -25,8 +25,8 @@ use PBot::Imports;
|
||||
# These are set by the /misc/update_version script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 4898,
|
||||
BUILD_DATE => "2025-09-28",
|
||||
BUILD_REVISION => 4900,
|
||||
BUILD_DATE => "2025-10-05",
|
||||
};
|
||||
|
||||
sub initialize {}
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user