diff --git a/applets/pbot-vm/guest/bin/guest-gdb b/applets/pbot-vm/guest/bin/guest-gdb index c4f662c1..27f9583c 100755 --- a/applets/pbot-vm/guest/bin/guest-gdb +++ b/applets/pbot-vm/guest/bin/guest-gdb @@ -144,6 +144,7 @@ sub gdb_read_result($out) { sub gdbmi_to_json($text, $makejson = 1) { $text =~ s/([\w-]+)=/"$1":/g if $makejson; + $text =~ s/\\(\d{3})/chr oct $1/ge; return decode_json("{$text}"); } @@ -284,7 +285,7 @@ sub get_main_start_end($context) { $braces--; if ($braces == 0) { - $end = $line; + $end = $line - 1; last; } } @@ -609,6 +610,9 @@ sub print_gdb_output($context, $text) { } sub perform_preamble($context) { + gdb_send_and_discard($context, "set charset UTF-8"); + gdb_send_and_discard($context, "set print sevenbit-strings on"); + # get start and end line numbers for main() function my ($start, $end) = get_main_start_end($context); @@ -654,7 +658,7 @@ sub main { # open OUTPUT_FILENAME file to send gdb output unlink OUTPUT_FILENAME; - open($context->{prog_output}, '>>', OUTPUT_FILENAME) or die "Could not open ".OUTPUT_FILENAME." for append: $!"; + open($context->{prog_output}, '>>:encoding(UTF-8)', OUTPUT_FILENAME) or die "Could not open ".OUTPUT_FILENAME." for append: $!"; # time-out after a few seconds start_timeout($context, 8); diff --git a/applets/pbot-vm/guest/bin/guest-server b/applets/pbot-vm/guest/bin/guest-server index cb534f84..226c04e6 100755 --- a/applets/pbot-vm/guest/bin/guest-server +++ b/applets/pbot-vm/guest/bin/guest-server @@ -21,8 +21,6 @@ use constant { MOD_DIR => '/usr/local/share/pbot-vm/', SERIAL => '/dev/ttyS1', HEARTBEAT => '/dev/ttyS2', - INPUT => '/dev/stdin', - OUTPUT => '/dev/stdout', VPORT => $ENV{PBOTVM_VPORT} // 5555, }; diff --git a/applets/pbot-vm/guest/lib/Guest.pm b/applets/pbot-vm/guest/lib/Guest.pm index 011495ff..8b55959a 100644 --- a/applets/pbot-vm/guest/lib/Guest.pm +++ b/applets/pbot-vm/guest/lib/Guest.pm @@ -56,8 +56,6 @@ sub read_input($input, $buffer, $tag) { $$buffer = ''; $total_read = 0; - $line = encode('UTF-8', $line); - print STDERR "-" x 40, "\n"; print STDERR "$tag got [$line]\n"; diff --git a/applets/pbot-vm/guest/lib/Languages/_c_base.pm b/applets/pbot-vm/guest/lib/Languages/_c_base.pm index 39179db8..52e27bc4 100755 --- a/applets/pbot-vm/guest/lib/Languages/_c_base.pm +++ b/applets/pbot-vm/guest/lib/Languages/_c_base.pm @@ -14,7 +14,7 @@ sub preprocess { my $input = $self->{input} // ''; - open(my $fh, '>', '.input'); + open(my $fh, '>:encoding(UTF-8)', '.input'); print $fh "$input\n"; close $fh; @@ -24,7 +24,7 @@ sub preprocess { # remove print_last_statement wrapper in order to get warnings/errors from last statement line my $code = $self->{code}; $code =~ s/print_last_statement\((.*)\);$/$1;/mg; - open(my $fh, '>', $self->{sourcefile}) or die $!; + open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!; print $fh $code . "\n"; close $fh; @@ -37,7 +37,7 @@ sub preprocess { # now compile with print_last_statement intact, ignoring compile results if (not $self->{error}) { - open(my $fh, '>', $self->{sourcefile}) or die $!; + open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!; print $fh $self->{code} . "\n"; close $fh; @@ -45,7 +45,7 @@ sub preprocess { $self->execute(60, undef, @cmd); } } else { - open(my $fh, '>', $self->{sourcefile}) or die $!; + open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!; print $fh $self->{code} . "\n"; close $fh; @@ -64,6 +64,7 @@ sub preprocess { sub postprocess { my $self = shift; + $self->SUPER::postprocess; # no errors compiling, but if output contains something, it must be diagnostic messages diff --git a/applets/pbot-vm/guest/lib/Languages/_default.pm b/applets/pbot-vm/guest/lib/Languages/_default.pm index 042f37b2..c93c6280 100755 --- a/applets/pbot-vm/guest/lib/Languages/_default.pm +++ b/applets/pbot-vm/guest/lib/Languages/_default.pm @@ -42,8 +42,7 @@ sub initialize { sub preprocess { my $self = shift; - open(my $fh, '>', $self->{sourcefile}) or die $!; - binmode($fh, ':utf8'); + open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!; print $fh $self->{code} . "\n"; close $fh; diff --git a/applets/pbot-vm/host/bin/vm-exec b/applets/pbot-vm/host/bin/vm-exec index 68481855..e4eb0e2c 100755 --- a/applets/pbot-vm/host/bin/vm-exec +++ b/applets/pbot-vm/host/bin/vm-exec @@ -258,6 +258,7 @@ sub main() { $lang->postprocess_output; $lang->show_output; + $lang->done; } main(); diff --git a/applets/pbot-vm/host/lib/InteractiveEdit.pm b/applets/pbot-vm/host/lib/InteractiveEdit.pm index e77906b3..15003632 100644 --- a/applets/pbot-vm/host/lib/InteractiveEdit.pm +++ b/applets/pbot-vm/host/lib/InteractiveEdit.pm @@ -18,8 +18,6 @@ use parent qw(Exporter); our @EXPORT = qw(interactive_edit); sub interactive_edit($self) { - my (@last_code, $unshift_last_code); - my $code = $self->{code}; print " code: [$code]\n" if $self->{debug}; @@ -31,22 +29,15 @@ sub interactive_edit($self) { if ($subcode =~ s/^\s*copy\s+(\S+)\s*//) { my $copy = $1; - if (open LOG, "< $RealBin/../history/$copy-$self->{lang}.hist") { - $copy_code = ; - close LOG; - goto COPY_ERROR if not $copy_code;; - chomp $copy_code; - } else { - goto COPY_ERROR; + my @code = load_history("$RealBin/../history/$copy-$self->{lang}.hist"); + + $copy_code = $code[0]; + + if (not defined $copy_code) { + print "No history for $copy.\n"; + exit 0; } - goto COPY_SUCCESS; - - COPY_ERROR: - print "No history for $copy.\n"; - exit 0; - - COPY_SUCCESS: $code = $copy_code; $self->{only_show} = 1; $self->{copy_code} = 1; @@ -56,13 +47,7 @@ sub interactive_edit($self) { $self->{channel} = $1; } - if (open LOG, "< $RealBin/../history/$self->{channel}-$self->{lang}.hist") { - while (my $line = ) { - chomp $line; - push @last_code, $line; - } - close LOG; - } + my @last_code = load_history("$RealBin/../history/$self->{channel}-$self->{lang}.hist"); unshift @last_code, $copy_code if defined $copy_code; @@ -463,6 +448,8 @@ sub interactive_edit($self) { } } + my $unshift_last_code = 0; + unless($got_undo and not $got_changes) { $unshift_last_code = 1 unless $copy_code and not $got_changes; } @@ -480,15 +467,7 @@ sub interactive_edit($self) { unshift @last_code, $code; } - open LOG, "> $RealBin/../history/$self->{channel}-$self->{lang}.hist"; - - my $i = 0; - foreach my $line (@last_code) { - last if (++$i > $self->{max_history}); - print LOG "$line\n"; - } - - close LOG; + save_history("$RealBin/../history/$self->{channel}-$self->{lang}.hist", \@last_code, $self->{max_history}); } if ($got_diff) { @@ -516,4 +495,34 @@ sub interactive_edit($self) { $self->{code} = $code; } +sub save_history($path, $lines, $max_lines) { + open my $fh, '>:encoding(UTF-8)', $path; + return if not $fh; + + my $i = 0; + foreach my $line (@$lines) { + last if (++$i > $max_lines); + print $fh "$line\n"; + } + + close $fh; +} + +sub load_history($path) { + my @lines; + my $fh; + + if (not open $fh, '<:encoding(UTF-8)', $path) { + return undef; + } + + while (my $line = <$fh>) { + chomp $line; + push @lines, $line; + } + + close $fh; + return @lines; +} + 1; diff --git a/applets/pbot-vm/host/lib/Languages/_c_base.pm b/applets/pbot-vm/host/lib/Languages/_c_base.pm index 094248fc..5fbd7af6 100755 --- a/applets/pbot-vm/host/lib/Languages/_c_base.pm +++ b/applets/pbot-vm/host/lib/Languages/_c_base.pm @@ -88,13 +88,13 @@ sub pretty_format { $code = $self->{code} if not defined $code; - open my $fh, ">$self->{sourcefile}" or die "Couldn't write $self->{sourcefile}: $!"; + open my $fh, '>:encoding(UTF-8)', $self->{sourcefile} or die "Couldn't write $self->{sourcefile}: $!"; print $fh $code; close $fh; system("astyle", "-A3", "-UHpnfq", $self->{sourcefile}); - open $fh, "<$self->{sourcefile}" or die "Couldn't read $self->{sourcefile}: $!"; + open $fh, '<:encoding(UTF-8)', $self->{sourcefile} or die "Couldn't read $self->{sourcefile}: $!"; $result = join '', <$fh>; close $fh; @@ -103,6 +103,7 @@ sub pretty_format { sub preprocess_code { my $self = shift; + $self->SUPER::preprocess_code(omit_prelude => 1); my $default_prelude = exists $self->{options}->{'-noheaders'} ? '' : $self->{prelude}; @@ -363,6 +364,7 @@ sub preprocess_code { sub postprocess_output { my $self = shift; + $self->SUPER::postprocess_output; my $output = $self->{output}; diff --git a/applets/pbot-vm/host/lib/Languages/_default.pm b/applets/pbot-vm/host/lib/Languages/_default.pm index 6de06281..b601334a 100755 --- a/applets/pbot-vm/host/lib/Languages/_default.pm +++ b/applets/pbot-vm/host/lib/Languages/_default.pm @@ -17,6 +17,7 @@ use Encode; use JSON::XS; use Getopt::Long qw(GetOptionsFromArray :config pass_through no_ignore_case no_auto_abbrev); use Time::HiRes qw(gettimeofday); +use POSIX; use FindBin qw($RealBin); @@ -77,6 +78,7 @@ sub process_standard_options($self) { $cmdline =~ s/\$execfile/$self->{execfile}/g; my $name = exists $self->{name} ? $self->{name} : $self->{lang}; print "$name cmdline: $cmdline\n"; + $self->done; exit; } @@ -128,14 +130,13 @@ sub pretty_format($self, $code) { sub preprocess_code($self, %opts) { if ($self->{only_show}) { print "$self->{code}\n"; + $self->done; exit; } unless($self->{got_run} and $self->{copy_code}) { - open LOG, ">> $RealBin/../log.txt"; - print LOG localtime() . "\n"; - print LOG "$self->{nick} $self->{channel}: [" . $self->{arguments} . "] " . $self->{cmdline_options} . "$self->{code}\n"; - close LOG; + $self->debug("---- preprocess\n"); + $self->debug("$self->{nick} $self->{channel}: [$self->{arguments}] $self->{cmdline_options} $self->{code}\n", 0); } # replace \n outside of quotes with literal newline @@ -251,10 +252,8 @@ sub execute { $cmdline =~ s/\$options\s+//; } - open LOG, ">> $RealBin/../log.txt"; - print LOG "---------------------executing---------------------------------------------------\n"; - print LOG localtime() . "\n"; - print LOG "$cmdline\n$stdin\n$pretty_code\n"; + $self->debug("---- executing\n"); + $self->debug("$cmdline\n$stdin\n$pretty_code\n", 0); my $compile_in = { lang => $self->{lang}, @@ -275,11 +274,11 @@ sub execute { my $length = length $compile_json; my $sent = 0; - my $chunk_max = 4096; + my $chunk_max = 16384; my $chunk_size = $length < $chunk_max ? $length : $chunk_max; my $chunks_sent = 0; - #print LOG "Sending $length bytes [$compile_json] to vm_server\n"; + # $self->debug("Sending $length bytes [$compile_json] to vm_server\n"); $chunk_size -= 1; # account for newline in syswrite @@ -291,14 +290,15 @@ sub execute { my $ret = syswrite($input, $chunk); if (not defined $ret) { - print STDERR "Error sending: $!\n"; - print LOG "Error sending: $!\n"; + my $error = $!; + print STDERR "Error sending: $error\n"; + $self->debug("Error sending: $error\n"); last; } if ($ret == 0) { print STDERR "Sent 0 bytes. Sleep 1 sec and try again\n"; - print LOG "Sent 0 bytes. Sleep 1 sec and try again\n"; + $self->debug("Sent 0 bytes. Sleep 1 sec and try again\n"); sleep 1; next; } @@ -306,8 +306,6 @@ sub execute { $sent += $ret; } - close LOG; - my $result = ""; my $got_result = 0; @@ -338,11 +336,8 @@ sub execute { sub postprocess_output($self) { unless($self->{got_run} and $self->{copy_code}) { - open LOG, ">> $RealBin/../log.txt"; - print LOG "--------------------------post processing----------------------------------------------\n"; - print LOG localtime() . "\n"; - print LOG "$self->{output}\n"; - close LOG; + $self->debug("---- post-processing\n"); + $self->debug("$self->{output}\n", 0); } # backspace @@ -370,12 +365,9 @@ sub show_output($self) { my $output = $self->{output}; unless ($self->{got_run} and $self->{copy_code}) { - open LOG, ">> $RealBin/../log.txt"; - print LOG "------------------------show output------------------------------------------------\n"; - print LOG localtime() . "\n"; - print LOG "$output\n"; - print LOG "========================================================================\n"; - close LOG; + $self->debug("---- show output\n"); + $self->debug("$output\n", 0); + $self->debug("=========================\n", 0); } if (exists $self->{options}->{'-paste'} or (defined $self->{got_run} and $self->{got_run} eq 'paste')) { @@ -429,37 +421,62 @@ sub show_output($self) { $pretty_code .= "$output\n"; $pretty_code .= $output_closing_comment; - my $uri = $self->paste_0x0($pretty_code); + my $uri = paste_0x0(encode('UTF-8', $pretty_code)); print "$uri\n"; + $self->done; exit 0; } - if ($self->{channel} =~ m/^#/ and length $output > 22 and open LOG, "< $RealBin/../history/$self->{channel}-$self->{lang}.last-output") { + if ($self->{channel} =~ m/^#/ and length $output > 22 and open my $fh, '<:encoding(UTF-8)', "$RealBin/../history/$self->{channel}-$self->{lang}.last-output") { my $last_output; - my $time = ; + my $time = <$fh>; if (gettimeofday - $time > 60 * 4) { - close LOG; + close $fh; } else { - while (my $line = ) { + while (my $line = <$fh>) { $last_output .= $line; } - close LOG; + close $fh; if ((not $self->{factoid}) and defined $last_output and $last_output eq $output) { print "Same output.\n"; + $self->done; exit 0; } } } - print "$output\n"; + print encode('UTF-8', "$output\n"); - open LOG, "> $RealBin/../history/$self->{channel}-$self->{lang}.last-output" or die "Couldn't open $self->{channel}-$self->{lang}.last-output: $!"; + my $file = "$RealBin/../history/$self->{channel}-$self->{lang}.last-output"; + open my $fh, '>:encoding(UTF-8)', $file or die "Couldn't open $file: $!"; my $now = gettimeofday; - print LOG "$now\n"; - print LOG "$output"; - close LOG; + print $fh "$now\n"; + print $fh "$output"; + close $fh; +} + +sub debug($self, $text, $timestamp = 1) { + if (not exists $self->{logh}) { + open $self->{logh}, '>>:encoding(UTF-8)', "$RealBin/../log.txt" or die "Could not open log file: $!"; + } + + if ($timestamp) { + my ($sec, $usec) = gettimeofday; + my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec; + $time .= sprintf ".%03d", $usec / 1000; + print { $self->{logh} } "$time :: $text"; + } else { + print { $self->{logh} } $text; + } +} + +sub done($self) { + if ($self->{logh}) { + close $self->{logh}; + delete $self->{logh}; + } } 1; diff --git a/applets/pbot-vm/host/lib/Paste.pm b/applets/pbot-vm/host/lib/Paste.pm index 9961a523..b333d04d 100644 --- a/applets/pbot-vm/host/lib/Paste.pm +++ b/applets/pbot-vm/host/lib/Paste.pm @@ -47,7 +47,7 @@ sub paste_0x0 { my $response = $ua->post( "https://0x0.st", - [ file => [ undef, "filename", Content => $text, 'Content-Type' => 'text/plain' ] ], + [ file => [ undef, "filename", Content => $text, 'Content-Type' => 'text/plain; charset=utf-8' ] ], Content_Type => 'form-data' ); diff --git a/lib/PBot/VERSION.pm b/lib/PBot/VERSION.pm index 109a7df4..cbc96dd6 100644 --- a/lib/PBot/VERSION.pm +++ b/lib/PBot/VERSION.pm @@ -25,8 +25,8 @@ use PBot::Imports; # These are set by the /misc/update_version script use constant { BUILD_NAME => "PBot", - BUILD_REVISION => 4500, - BUILD_DATE => "2022-02-15", + BUILD_REVISION => 4503, + BUILD_DATE => "2022-02-24", }; sub initialize {}