mirror of
https://github.com/perlbot/perlbuut-pastebin
synced 2025-06-07 14:17:26 -04:00
Merge branch 'master' of github.com:perlbot/perlbuut-pastebin
This commit is contained in:
commit
4e3db57e3c
3 changed files with 54 additions and 14 deletions
2
app.cfg
2
app.cfg
|
@ -19,7 +19,7 @@ url="http://test.blogspam.net/"
|
|||
port=9999
|
||||
|
||||
[evalserver]
|
||||
server="localhost:14400"
|
||||
server="localhost:14401"
|
||||
languages=[ "perl" ]
|
||||
|
||||
|
||||
|
|
2
cpanfile
2
cpanfile
|
@ -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';
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Add table
Reference in a new issue