GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2025-10-14 06:57:25 +02:00
Code Issues Projects Releases Wiki Activity

applets/pbot-vm: restore VSOCK functionality

Browse Source 
- 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 2025-10-05 06:22:44 -07:00
parent 891baed35f
commit 483a782021
No known key found for this signature in database
GPG Key ID: CC916B6E3C84ECCE
7 changed files with 166 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
applets/pbot-vm/guest/lib/Guest.pm
View File

@ -22,42 +22,63 @@ use English;
use Encode; use Encode;
use File::Basename; use File::Basename;
use JSON::XS; use JSON::XS;
use Time::HiRes qw/gettimeofday/;
use POSIX;
use Data::Dumper; 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) { sub read_input($input, $buffer, $tag) {
my $line; info("$tag waiting for input...\n");
print STDERR "$tag waiting for input...\n";
my $ret = sysread($input, my $buf, 4096); my $ret = sysread($input, my $buf, 4096);
if (not defined $ret) { if (not defined $ret) {
print STDERR "Error reading $tag: $!\n"; info("Error reading $tag: $!\n");
return undef; return undef;
} }
if ($ret == 0) { if ($ret == 0) {
print STDERR "$tag input closed.\n"; info("$tag input closed.\n");
return 0; return 0;
} }
print STDERR "$tag read $ret bytes [$buf]\n"; info("$tag read $ret [" . (Dumper $buf) . "]\n");
if ($buf ne "\n") { $$buffer .= $buf;
chomp $buf;
$$buffer .= $buf; # info("$tag buffer [" . (Dumper $$buffer) . "]\n", 8192);
if ($$buffer !~ /\n\n/) {
return undef; return undef;
} }
$line = $$buffer; my $line;
$$buffer = ''; ($line, $$buffer) = split /\n\n/, $$buffer, 2;
$line =~ s/\n//g;
print STDERR "-" x 40, "\n"; info(("-" x 40) . "\n");
print STDERR "$tag got [$line]\n";
# info("$tag got [" . (Dumper $line) . "]\n", 8192);
# info("$tag buffer [" . (Dumper $$buffer) . "]\n", 8192);
my $command = eval { decode_json($line) }; my $command = eval { decode_json($line) };
if ($@) { if ($@) {
print STDERR "Failed to decode JSON: $@\n"; info("Failed to decode JSON: $@\n", 1024);
return { return {
arguments => '', arguments => '',
cmdline => 'sh prog.sh', cmdline => 'sh prog.sh',
@ -73,8 +94,7 @@ sub read_input($input, $buffer, $tag) {
$command->{arguments} //= ''; $command->{arguments} //= '';
$command->{input} //= ''; $command->{input} //= '';
print STDERR Dumper($command), "\n"; info("command: " . Dumper($command), 2048);
return $command; return $command;
} }
@ -82,14 +102,14 @@ sub process_command($command, $mod, $user, $tag) {
my ($uid, $gid, $home) = (getpwnam $user)[2, 3, 7]; my ($uid, $gid, $home) = (getpwnam $user)[2, 3, 7];
if (not $uid and not $gid) { if (not $uid and not $gid) {
print STDERR "Could not find user $user: $!\n"; info("Could not find user $user: $!\n");
return undef; return undef;
} }
my $pid = fork; my $pid = fork;
if (not defined $pid) { if (not defined $pid) {
print STDERR "process_command: fork failed: $!\n"; info("process_command: fork failed: $!\n");
return undef; return undef;
} }
@ -108,9 +128,10 @@ sub process_command($command, $mod, $user, $tag) {
system("chmod -R 755 $dir 1>&2"); system("chmod -R 755 $dir 1>&2");
system("chown -R $user $dir 1>&2"); system("chown -R $user $dir 1>&2");
system("chgrp -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{USER} = $user;
$ENV{LOGNAME} = $user; $ENV{LOGNAME} = $user;
@ -124,7 +145,7 @@ sub process_command($command, $mod, $user, $tag) {
my $result = run_command($command, $mod); my $result = run_command($command, $mod);
print STDERR "=" x 40, "\n"; info(("=" x 40) . "\n");
# ensure output is newline-terminated # ensure output is newline-terminated
$result .= "\n" unless $result =~ /\n$/; $result .= "\n" unless $result =~ /\n$/;
@ -132,7 +153,16 @@ sub process_command($command, $mod, $user, $tag) {
return $result; return $result;
} else { } else {
# wait for child to finish # 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 # clean up persistent factoid storage
if ($command->{'persist-key'}) { if ($command->{'persist-key'}) {
@ -141,8 +171,8 @@ sub process_command($command, $mod, $user, $tag) {
system ("rm -rf \"/home/$user/$command->{'persist-key'}\""); system ("rm -rf \"/home/$user/$command->{'persist-key'}\"");
} }
# kill any left-over processes started by $user # kill any left-over processes started by user
system("pkill -u $user"); system("pkill -P $pid");
system("rm -rf /home/$user/$pid"); system("rm -rf /home/$user/$pid");
return 0; return 0;
} }

26
applets/pbot-vm/guest/lib/Languages/_default.pm
View File

@ -8,15 +8,34 @@ package _default;
use warnings; use warnings;
use strict; use strict;
use feature qw/signatures/;
no warnings qw/experimental::signatures/;
use IPC::Run qw/run timeout/; use IPC::Run qw/run timeout/;
use Encode; use Encode;
use SplitLine; use SplitLine;
use Time::HiRes qw/gettimeofday/;
use POSIX;
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Terse = 1; $Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
$Data::Dumper::Useqq = 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 { sub new {
my ($class, %conf) = @_; my ($class, %conf) = @_;
@ -82,7 +101,7 @@ sub execute {
$stdin = encode('UTF-8', $stdin); $stdin = encode('UTF-8', $stdin);
@cmdline = map { encode('UTF-8', $_) } @cmdline; @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 ($exitval, $stdout, $stderr) = eval {
my ($stdout, $stderr); my ($stdout, $stderr);
@ -96,10 +115,7 @@ sub execute {
($exitval, $stdout, $stderr) = (-1, '', $exception); ($exitval, $stdout, $stderr) = (-1, '', $exception);
} }
$Data::Dumper::Indent = 0; info("exitval $exitval stderr [" . Dumper($stderr) . "] stdout [" . Dumper($stdout) . "]\n");
print STDERR "exitval $exitval stderr [", Dumper($stderr), "] stdout [", Dumper($stdout), "]\n";
$Data::Dumper::Indent = 1;
return ($exitval, $stdout, $stderr); return ($exitval, $stdout, $stderr);
} }

45
applets/pbot-vm/host/bin/vm-exec
View File

@ -38,14 +38,34 @@ use File::Basename;
use JSON::XS; use JSON::XS;
use IPC::Open2; use IPC::Open2;
use IO::Socket; 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 FindBin qw($RealBin);
use lib "$RealBin/../lib"; 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) { sub connect_vsock($context) {
return undef if not $context->{'vm-cid'}; 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'}"; my $command = "socat - VSOCK-CONNECT:$context->{'vm-cid'}:$context->{'vm-vport'}";
@ -55,12 +75,12 @@ sub connect_vsock($context) {
}; };
if ($@) { if ($@) {
print STDERR "Failed to connect to VM socket: $@\n"; info("Failed to connect to VM socket: $@\n");
return undef; return undef;
} }
if (not defined $pid) { if (not defined $pid) {
print STDERR "Failed to connect to VM socket: $!\n"; info("Failed to connect to VM socket: $!\n");
return undef; return undef;
} }
@ -68,7 +88,7 @@ sub connect_vsock($context) {
} }
sub connect_serial($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( my $vm = IO::Socket::INET->new(
PeerAddr => $context->{'vm-addr'}, PeerAddr => $context->{'vm-addr'},
@ -77,6 +97,9 @@ sub connect_serial($context) {
Type => SOCK_STREAM Type => SOCK_STREAM
); );
$vm->autoflush(1);
$vm->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1);
# return same $vm handle for ($input, $output) # return same $vm handle for ($input, $output)
return ($vm, $vm); return ($vm, $vm);
} }
@ -96,7 +119,7 @@ sub connect_vm($context) {
die "Could not create connection to VM: $!"; die "Could not create connection to VM: $!";
} }
print STDERR "Connected to VM.\n"; info("Connected to VM.\n");
return ($input, $output); return ($input, $output);
} }
@ -123,14 +146,14 @@ sub make_context_from_args(@args_in) {
# set extracted leading options # set extracted leading options
foreach my $opt (keys %opts) { foreach my $opt (keys %opts) {
print STDERR "Setting option `$opt`.\n"; info("Setting option `$opt`.\n");
$context->{$opt} = 1; $context->{$opt} = 1;
} }
# parse options specific to vm-exec # 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*//) { while ($context->{code} =~ s/^-(lang|revert|health|vm-domain|vm-health|vm-cid|vm-vport|vm-serial|vm)=([^ ]+)\s*//) {
my ($option, $value) = ($1, $2); my ($option, $value) = ($1, $2);
print STDERR "Overriding `$option` to `$value`.\n"; info("Overriding `$option` to `$value`.\n");
$context->{$option} = lc $value; $context->{$option} = lc $value;
} }
@ -264,7 +287,7 @@ sub main() {
configure_context($context, $config); configure_context($context, $config);
if ($context->{revert} && $context->{health}) { 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; exit 0;
} }
@ -274,7 +297,7 @@ sub main() {
$context->{'vm-domain'} = $config->{aliases}->{$context->{'vm-domain'}}; $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'}) { if ($context->{'vm-vagrant'}) {
system("virsh -c qemu:///system snapshot-revert $context->{'vm-domain'} 1"); system("virsh -c qemu:///system snapshot-revert $context->{'vm-domain'} 1");
@ -295,7 +318,7 @@ sub main() {
); );
if (not defined $health) { 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; exit 2;
} }
@ -313,7 +336,7 @@ sub main() {
}; };
if ($@) { if ($@) {
print STDERR "Failed to get health: $@\n"; info("Failed to get health: $@\n");
exit 1; exit 1;
} }

60
applets/pbot-vm/host/bin/vm-server
View File

@ -22,28 +22,46 @@ use Net::hostent;
use IPC::Shareable; use IPC::Shareable;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
use Encode; use Encode;
use POSIX;
use Data::Dumper;
$Data::Dumper::Useqq = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 0;
use constant { use constant {
SERVER_PORT => $ENV{PBOTVM_PORT} // 9000, SERVER_PORT => $ENV{PBOTVM_PORT} // 9000,
COMPILE_TIMEOUT => $ENV{PBOTVM_TIMEOUT} // 10, 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) { sub vm_revert($input) {
return if $ENV{PBOTVM_NOREVERT}; return if $ENV{PBOTVM_NOREVERT};
print "Reverting vm...\n"; info("Reverting vm...\n");
execute("perl vm-exec -revert $input", 1000); execute("perl vm-exec -revert $input", 1000);
print "Reverted.\n"; info("Reverted.\n");
} }
sub vm_check_health($input) { sub vm_check_health($input) {
print "Checking health...\n"; info("Checking health...\n");
my ($ret, $result) = execute("perl vm-exec -health $input", 2); 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); return ($ret, $result);
} }
sub execute($command, $timeout = COMPILE_TIMEOUT) { sub execute($command, $timeout = COMPILE_TIMEOUT) {
print "execute ($command)\n"; info("execute ($command)\n", 1024);
# to get $? from pipe # to get $? from pipe
local $SIG{CHLD} = 'DEFAULT'; local $SIG{CHLD} = 'DEFAULT';
@ -51,7 +69,7 @@ sub execute($command, $timeout = COMPILE_TIMEOUT) {
my $pid = open(my $fh, '-|', split / /, encode('UTF-8', $command)); my $pid = open(my $fh, '-|', split / /, encode('UTF-8', $command));
if (not defined $pid) { if (not defined $pid) {
print "Couldn't fork: $!\n"; info("Couldn't fork: $!\n");
return (-13, "[Fatal error]"); return (-13, "[Fatal error]");
} }
@ -94,27 +112,27 @@ sub server_listen($port) {
Reuse => 1, Reuse => 1,
); );
die "Can't setup server: $!" unless $server; 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; return $server;
} }
sub do_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) }; my $server = eval { server_listen(SERVER_PORT) };
if ($@) { if ($@) {
print STDERR $@; info($@);
return; return;
} }
while (my $client = $server->accept) { while (my $client = $server->accept) {
print '-' x 20, "\n"; info('-' x 20 . "\n");
my $hostinfo = gethostbyaddr($client->peeraddr); my $hostinfo = gethostbyaddr($client->peeraddr);
print "Connect from ", $client->peerhost, " at ", scalar localtime, "\n"; info("Connect from " . $client->peerhost . "\n");
handle_client($client); handle_client($client);
} }
print "Shutting down server.\n"; info("Shutting down server.\n");
} }
sub handle_client($client) { sub handle_client($client) {
@ -123,7 +141,7 @@ sub handle_client($client) {
my $r = fork; my $r = fork;
if (not defined $r) { 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"; print $client "Fatal error.\n";
close $client; close $client;
return; return;
@ -151,19 +169,19 @@ sub handle_client($client) {
# give client 5 more seconds # give client 5 more seconds
alarm 5; alarm 5;
print "[$$] Read [$input]\n"; info("Read [" . Dumper($input) . "]\n");
# check health # check health
my ($health, $health_message) = vm_check_health($input); my ($health, $health_message) = vm_check_health($input);
if ($health == 2) { 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"; print $client "Virtual machine is offline.\n";
last; last;
} }
if ($health == 1 || $health == -13) { 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"; print $client "Virtual machine is temporarily unavailable, try again soon.\n";
last; last;
} }
@ -183,7 +201,7 @@ sub handle_client($client) {
my ($ret, $result) = execute("perl vm-exec $input"); my ($ret, $result) = execute("perl vm-exec $input");
$result =~ s/\s+$//; $result =~ s/\s+$//;
print "Ret: $ret; result: [$result]\n"; info("Ret: $ret; result: [" . Dumper($result) . "]\n");
if ($result =~ m/\[Killed\]$/) { if ($result =~ m/\[Killed\]$/) {
$killed = 1; $killed = 1;
@ -202,20 +220,20 @@ sub handle_client($client) {
}; };
# print client time-out exception # print client time-out exception
print "[$$] $@" if $@; info($@) if $@;
alarm 0; alarm 0;
close $client; close $client;
print "[$$] timed out: $timed_out; killed: $killed\n"; info("timed out: $timed_out; killed: $killed\n");
if ($timed_out || $killed) { if ($timed_out || $killed) {
vm_revert($input); vm_revert($input);
} }
# child done # child done
print "[$$] client exit\n"; info("client exit\n");
print "=" x 20, "\n"; info("=" x 20 . "\n");
exit; exit;
} }

2
applets/pbot-vm/host/lib/InteractiveEdit.pm
View File

@ -21,8 +21,6 @@ our @EXPORT = qw(interactive_edit);
sub interactive_edit($self) { sub interactive_edit($self) {
my $code = $self->{code}; my $code = $self->{code};
print " code: [$code]\n" if $self->{debug};
my $subcode = $code; my $subcode = $code;
while ($subcode =~ s/^\s*(-[^ ]+)\s*//) {} while ($subcode =~ s/^\s*(-[^ ]+)\s*//) {}

27
applets/pbot-vm/host/lib/Languages/_default.pm
View File

@ -21,6 +21,7 @@ use POSIX;
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Useqq = 1; $Data::Dumper::Useqq = 1;
$Data::Dumper::Terse = 1;
use FindBin qw($RealBin); use FindBin qw($RealBin);
@ -140,7 +141,7 @@ sub preprocess_code($self, %opts) {
unless($self->{got_run} and $self->{copy_code}) { unless($self->{got_run} and $self->{copy_code}) {
$self->info("---- preprocess\n"); $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 # replace \n outside of quotes with literal newline
@ -257,7 +258,7 @@ sub execute {
} }
$self->info("---- executing\n"); $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 = { my $compile_in = {
lang => $self->{lang}, lang => $self->{lang},
@ -283,14 +284,14 @@ sub execute {
my @lines = unpack("(A$chunk_size)*", $compile_json); my @lines = unpack("(A$chunk_size)*", $compile_json);
push @lines, ''; 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) { foreach my $line (@lines) {
$line .= "\n"; $line .= "\n";
my $length = length $line; my $length = length $line;
my $sent = 0; 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) { while ($sent < $length) {
my $ret = syswrite($input, $line, $chunk_size + 1, $sent); my $ret = syswrite($input, $line, $chunk_size + 1, $sent);
@ -333,9 +334,7 @@ sub execute {
} }
close $input; close $input;
$self->{output} = $result; $self->{output} = $result;
return $result; return $result;
} }
@ -492,22 +491,28 @@ sub show_output($self) {
close $fh; close $fh;
} }
sub debug($self, $text, $timestamp = 1) { sub debug($self, $text, $timestamp = 1, $maxlen = 255) {
return if not $self->{debug}; 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}) { if (not exists $self->{logh}) {
open $self->{logh}, '>>:encoding(UTF-8)', "$RealBin/../log.txt" or die "Could not open log file: $!"; 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) { if ($timestamp) {
my ($sec, $usec) = gettimeofday; my ($sec, $usec) = gettimeofday;
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec; my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
$time .= sprintf ".%03d", $usec / 1000; $time .= sprintf ".%03d", $usec / 1000;
print STDERR "$time :: $text"; print STDERR "[$$] $time :: $text";
print { $self->{logh} } "$time :: $text"; print { $self->{logh} } "[$$] $time :: $text";
} else { } else {
print STDERR $text; print STDERR $text;
print { $self->{logh} } $text; print { $self->{logh} } $text;

4
lib/PBot/VERSION.pm
View File

@ -25,8 +25,8 @@ use PBot::Imports;
# These are set by the /misc/update_version script # These are set by the /misc/update_version script
use constant { use constant {
BUILD_NAME => "PBot", BUILD_NAME => "PBot",
BUILD_REVISION => 4898, BUILD_REVISION => 4900,
BUILD_DATE => "2025-09-28", BUILD_DATE => "2025-10-05",
}; };
sub initialize {} sub initialize {}