1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut-pastebin synced 2025-06-07 14:17:26 -04:00

switch to new evalserver

This commit is contained in:
Ryan Voots 2017-07-16 02:07:01 -04:00
parent a587b9ee91
commit 949cb8e3fd
3 changed files with 54 additions and 14 deletions

View file

@ -19,7 +19,7 @@ url="http://test.blogspam.net/"
port=9999
[evalserver]
server="localhost:14400"
server="localhost:14401"
languages=[ "perl" ]

View file

@ -9,4 +9,4 @@ requires 'DBD::SQLite';
requires 'Mojolicious::Lite';
requires 'Mojolicious::Plugin::TtRenderer';
requires 'Mojolicious::Plugin::BlogSpam';
requires 'POE::Filter::Reference';
requires 'App::EvalServerAdvanced::Protocol';

View file

@ -6,8 +6,7 @@ use v5.22;
use Mojo::Base '-base';
use Encode qw/decode/;
use POE::Filter::Reference;
use App::EvalServerAdvanced::Protocol;
use App::Config;
use App::Memcached;
@ -20,25 +19,66 @@ sub get_eval {
if ($paste_id && (my $cached = $memd->get($paste_id))) {
return $cached;
} else {
my $filter = POE::Filter::Reference->new();
my $socket = IO::Socket::INET->new( PeerAddr => $self->cfg->{server} //'localhost', PeerPort => $self->cfg->{port} //14400 )
or die "error: cannot connect to eval server";
$lang //= "perl";
return undef if ($lang eq 'text');
my $refs = $filter->put( [ { code => $lang . " $code" } ] );
my $str = eval {$self->do_singleeval($lang, $code)};
return "ERROR: evalserver broken: $@" if $@;
print $socket $refs->[0];
my $output = do {local $/; <$socket>};
close $socket;
my $result = $filter->get( [ $output ] );
my $str = eval {decode("utf8", $result->[0]->[0])} // $result->[0]->[0];
$str = eval {decode("utf8", $str)} // $str; # I don't know why i need to decode this twice. shurg.
$memd->set($paste_id, $str) if ($paste_id);
return $str;
}
}
sub do_singleeval {
my ($self, $type, $code) = @_;
my $socket = IO::Socket::INET->new(PeerAddr => $self->cfg->{server} //'localhost', PeerPort => $self->cfg->{port} //14401)
or die "error: cannot connect to eval server";
my $eval_obj = {language => $type, files => [{filename => '__code', contents => $code, encoding => "utf8"}], prio => {pr_realtime=>{}}, sequence => 1, encoding => "utf8"};
$socket->autoflush(1);
print $socket encode_message(eval => $eval_obj);
my $buf = '';
my $data = '';
my $resultstr = "Failed to read a message";
my $message = $self->read_message($socket);
if (ref($message) =~ /Warning$/) {
return $message->message;
} else {
return $message->get_contents;
}
}
sub read_message {
my ($self, $socket) = @_;
my $header;
$socket->read($header, 8) or die "Couldn't read from socket";
my ($reserved, $length) = unpack "NN", $header;
die "Invalid packet" unless $reserved == 1;
my $buffer;
$socket->read($buffer, $length) or die "Couldn't read from socket2";
my ($res, $message, $nbuf) = decode_message($header . $buffer);
die "Data left over in buffer" unless $nbuf eq '';
die "Couldn't decode packet" unless $res;
return $message;
}
1;