pbot-vm: fix encoding issues; misc clean-ups

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);

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,
 };
 

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";
 

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

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 $!;
+    open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
-    binmode($fh, ':utf8');
     print $fh $self->{code} . "\n";
     close $fh;
 

applets/pbot-vm/host/bin/vm-exec

@@ -258,6 +258,7 @@ sub main() {
 
     $lang->postprocess_output;
     $lang->show_output;
+    $lang->done;
 }
 
 main();

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") {
+        my @code = load_history("$RealBin/../history/$copy-$self->{lang}.hist");
-            $copy_code = <LOG>;
-            close LOG;
-            goto COPY_ERROR if not $copy_code;;
-            chomp $copy_code;
-        } else {
-            goto COPY_ERROR;
-        }
 
-        goto COPY_SUCCESS;
+        $copy_code = $code[0];
 
-        COPY_ERROR:
+        if (not defined $copy_code) {
             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") {
+    my @last_code = load_history("$RealBin/../history/$self->{channel}-$self->{lang}.hist");
-        while (my $line = <LOG>) {
-            chomp $line;
-            push @last_code, $line;
-        }
-        close LOG;
-    }
 
     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";
+        save_history("$RealBin/../history/$self->{channel}-$self->{lang}.hist", \@last_code, $self->{max_history});
-
-        my $i = 0;
-        foreach my $line (@last_code) {
-            last if (++$i > $self->{max_history});
-            print LOG "$line\n";
-        }
-
-        close LOG;
     }
 
     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;

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};

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";
+        $self->debug("---- preprocess\n");
-        print LOG localtime() . "\n";
+        $self->debug("$self->{nick} $self->{channel}: [$self->{arguments}] $self->{cmdline_options} $self->{code}\n", 0);
-        print LOG "$self->{nick} $self->{channel}: [" . $self->{arguments} . "] " . $self->{cmdline_options} . "$self->{code}\n";
-        close LOG;
     }
 
     # replace \n outside of quotes with literal newline
@@ -251,10 +252,8 @@ sub execute {
         $cmdline =~ s/\$options\s+//;
     }
 
-    open LOG, ">> $RealBin/../log.txt";
+    $self->debug("---- executing\n");
-    print LOG "---------------------executing---------------------------------------------------\n";
+    $self->debug("$cmdline\n$stdin\n$pretty_code\n", 0);
-    print LOG localtime() . "\n";
-    print LOG "$cmdline\n$stdin\n$pretty_code\n";
 
     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";
+            my $error = $!;
-            print LOG "Error sending: $!\n";
+            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";
+        $self->debug("---- post-processing\n");
-        print LOG "--------------------------post processing----------------------------------------------\n";
+        $self->debug("$self->{output}\n", 0);
-        print LOG localtime() . "\n";
-        print LOG "$self->{output}\n";
-        close LOG;
     }
 
     # 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";
+        $self->debug("---- show output\n");
-        print LOG "------------------------show output------------------------------------------------\n";
+        $self->debug("$output\n", 0);
-        print LOG localtime() . "\n";
+        $self->debug("=========================\n", 0);
-        print LOG "$output\n";
-        print LOG "========================================================================\n";
-        close LOG;
     }
 
     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 = <LOG>;
+        my $time = <$fh>;
 
         if (gettimeofday - $time > 60 * 4) {
-            close LOG;
+            close $fh;
         } else {
-            while (my $line = <LOG>) {
+            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 $fh "$now\n";
-    print LOG "$output";
+    print $fh "$output";
-    close LOG;
+    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;

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'
     );
 

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_REVISION => 4503,
-    BUILD_DATE     => "2022-02-15",
+    BUILD_DATE     => "2022-02-24",
 };
 
 sub initialize {}