GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-25 13:29:29 +01:00
Code Issues Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Pragmatic Software 2022-02-24 10:39:15 -08:00
parent 55b203126c
commit 76fd5f5fd7
11 changed files with 115 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
applets/pbot-vm/guest/bin/guest-gdb
View File

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

2
applets/pbot-vm/guest/bin/guest-server
View File

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

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

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

9
applets/pbot-vm/guest/lib/Languages/_c_base.pm
View File

@ -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

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

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

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

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

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

@ -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 = <LOG>;
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 = <LOG>) {
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;

6
applets/pbot-vm/host/lib/Languages/_c_base.pm
View File

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

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

@ -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 = <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 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;

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

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

4
lib/PBot/VERSION.pm
View File

@ -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 {}