mirror of
https://github.com/perlbot/perlbuut-pastebin
synced 2025-06-07 22:26:01 -04:00
Merge branch 'master' of github.com:perlbot/perlbuut-pastebin
This commit is contained in:
commit
9c26fa34bb
10 changed files with 214 additions and 69 deletions
1
cpanfile
1
cpanfile
|
@ -10,3 +10,4 @@ requires 'Mojolicious::Lite';
|
||||||
requires 'Mojolicious::Plugin::TtRenderer';
|
requires 'Mojolicious::Plugin::TtRenderer';
|
||||||
requires 'Mojolicious::Plugin::BlogSpam';
|
requires 'Mojolicious::Plugin::BlogSpam';
|
||||||
requires 'App::EvalServerAdvanced::Protocol';
|
requires 'App::EvalServerAdvanced::Protocol';
|
||||||
|
requires 'Future::Mojo';
|
||||||
|
|
|
@ -28,16 +28,27 @@ sub api_get_paste {
|
||||||
my $row = $c->paste->get_paste($pasteid);
|
my $row = $c->paste->get_paste($pasteid);
|
||||||
|
|
||||||
if ($row) {
|
if ($row) {
|
||||||
|
$c->delay(sub {
|
||||||
|
my ($delay) = @_;
|
||||||
|
$c->eval->get_eval($pasteid, $row->{paste}, [$row->{language}], $delay->begin(0, 1))
|
||||||
|
},
|
||||||
|
sub {
|
||||||
|
my ($delay, $output_hr) = @_;
|
||||||
|
|
||||||
|
my ($output_lang) = keys %$output_hr; # grab a random output value, should be the first one since multilang support isn't working yet
|
||||||
|
my ($output) = $output_hr->{$output_lang};
|
||||||
my $data = {
|
my $data = {
|
||||||
paste => $row->{paste},
|
paste => $row->{paste},
|
||||||
when => $row->{when},
|
when => $row->{when},
|
||||||
username => $row->{who},
|
username => $row->{who},
|
||||||
description => $row->{desc},
|
description => $row->{desc},
|
||||||
language => $row->{language},
|
language => $output_lang,
|
||||||
output => $c->eval->get_eval($pasteid, $row->{paste}, $row->{language})
|
output => $output,
|
||||||
|
warning => "If this was multi-language paste, you just got a random language",
|
||||||
};
|
};
|
||||||
|
|
||||||
$c->render(json => $data);
|
$c->render(json => $data);
|
||||||
|
});
|
||||||
} else {
|
} else {
|
||||||
# 404
|
# 404
|
||||||
return $c->reply->not_found;
|
return $c->reply->not_found;
|
||||||
|
|
|
@ -20,12 +20,25 @@ sub run_eval {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
my $data = $self->req->body_params;
|
my $data = $self->req->body_params;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
$self = $self->inactivity_timeout(3600);
|
||||||
|
|
||||||
my $code = $data->param('code') // '';
|
my $code = $data->param('code') // '';
|
||||||
my $language = $data->param('language') // 'perl';
|
my $language = $data->param('language') // 'perl';
|
||||||
|
|
||||||
my $output = $self->eval->get_eval(undef, $code, $language);
|
$self->delay(sub {
|
||||||
|
my $delay = shift;
|
||||||
|
$self->eval->get_eval(undef, $code, [$language], $delay->begin(0,1));
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
},
|
||||||
|
sub {
|
||||||
|
my $delay = shift;
|
||||||
|
my ($output) = @_;
|
||||||
|
|
||||||
$self->render(json => {evalout => $output});
|
$self->render(json => {evalout => $output});
|
||||||
};
|
})
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -80,13 +80,20 @@ sub get_paste {
|
||||||
my $row = $c->paste->get_paste($pasteid);
|
my $row = $c->paste->get_paste($pasteid);
|
||||||
|
|
||||||
if ($row) {
|
if ($row) {
|
||||||
|
$c->delay(sub {
|
||||||
|
my $delay = shift;
|
||||||
|
|
||||||
|
$c->eval->get_eval($pasteid, $row->{paste}, [$row->{language}], $delay->begin(0,1));
|
||||||
|
}, sub {
|
||||||
|
my ($delay, $evalout) = @_;
|
||||||
$c->stash($row);
|
$c->stash($row);
|
||||||
$c->stash({language => $c->languages->get_language_hash->{$row->{language}}});
|
$c->stash({language => $c->languages->get_language_hash->{$row->{language}}});
|
||||||
$c->stash({page_tmpl => 'viewer.html'});
|
$c->stash({page_tmpl => 'viewer.html'});
|
||||||
$c->stash({eval => $c->eval->get_eval($pasteid, $row->{paste}, $row->{language})});
|
|
||||||
$c->stash({paste_id => $pasteid});
|
$c->stash({paste_id => $pasteid});
|
||||||
|
$c->stash({eval => $evalout});
|
||||||
|
|
||||||
$c->render('page');
|
$c->render('page');
|
||||||
|
});
|
||||||
} else {
|
} else {
|
||||||
return $c->reply->not_found;
|
return $c->reply->not_found;
|
||||||
}
|
}
|
||||||
|
|
|
@ -10,75 +10,170 @@ use App::EvalServerAdvanced::Protocol;
|
||||||
|
|
||||||
use App::Config;
|
use App::Config;
|
||||||
use App::Memcached;
|
use App::Memcached;
|
||||||
|
use Future::Mojo;
|
||||||
|
use Mojo::IOLoop;
|
||||||
|
|
||||||
has cfg => sub {App::Config::get_config('evalserver')};
|
has cfg => sub {App::Config::get_config('evalserver')};
|
||||||
|
|
||||||
|
our $id = 0; # global id count for evals
|
||||||
|
my %_futures;
|
||||||
|
|
||||||
|
sub _adopt_future {
|
||||||
|
my ($self, $id, $future) = @_;
|
||||||
|
|
||||||
|
$_futures{$id} = $future;
|
||||||
|
|
||||||
|
$future->on_ready(sub {
|
||||||
|
print "Cleaning up $id\n";
|
||||||
|
delete $_futures{$id};
|
||||||
|
})
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
sub get_eval {
|
sub get_eval {
|
||||||
my ($self, $paste_id, $code, $lang) = @_;
|
my ($self, $paste_id, $code, $langs, $callback) = @_;
|
||||||
|
print "Entering\n";
|
||||||
|
|
||||||
|
if (@$langs == 1 && $langs->[0] eq "evalall") {
|
||||||
|
$langs = [qw/perl perl5.26 perl5.24 perl5.22 perl5.20 perl5.18 perl5.16 perl5.14 perl5.12 perl5.10 perl5.8 perl5.6/];
|
||||||
|
}
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
print "Languages! ", Dumper($langs);
|
||||||
if ($paste_id && (my $cached = $memd->get($paste_id))) {
|
if ($paste_id && (my $cached = $memd->get($paste_id))) {
|
||||||
return $cached;
|
$callback->($cached);
|
||||||
} else {
|
} else {
|
||||||
|
# connect to server
|
||||||
|
my %futures;
|
||||||
|
|
||||||
$lang //= "perl";
|
my $server = $self->eval_connect(sub {
|
||||||
return undef if ($lang eq 'text');
|
my ($loop, $err, $stream) = @_;
|
||||||
|
|
||||||
my $str = eval {$self->do_singleeval($lang, $code)};
|
my $reader = $self->get_eval_reader($stream);
|
||||||
|
my %output;
|
||||||
|
|
||||||
return "ERROR: evalserver broken: $@" if $@;
|
for my $lang (@$langs) {
|
||||||
|
if ($lang eq 'text') {
|
||||||
|
$callback->("");
|
||||||
|
return;
|
||||||
|
} else {
|
||||||
|
my $future = $self->async_eval($stream, $reader, $lang, $code);
|
||||||
|
$futures{$lang} = $future;
|
||||||
|
|
||||||
$memd->set($paste_id, $str) if ($paste_id);
|
$future->on_done(sub {
|
||||||
|
my ($out) = @_;
|
||||||
|
|
||||||
return $str;
|
print "Future is done for $lang\n";
|
||||||
|
|
||||||
|
$output{$lang} = $out;
|
||||||
|
delete $futures{$lang};
|
||||||
|
|
||||||
|
print "remaining, ", Dumper(keys %futures);
|
||||||
|
|
||||||
|
if (!keys %futures) { # I'm the last one
|
||||||
|
print "Calling memset\n";
|
||||||
|
$memd->set($paste_id, \%output) if ($paste_id);
|
||||||
|
print "Returning output to delay\n";
|
||||||
|
use Data::Dumper;
|
||||||
|
print Dumper(\%output);
|
||||||
|
$callback->(\%output);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
}
|
||||||
|
}
|
||||||
|
});
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub do_singleeval {
|
sub eval_connect {
|
||||||
my ($self, $type, $code) = @_;
|
my ($self, $cb) = @_;
|
||||||
|
|
||||||
my $socket = IO::Socket::INET->new(PeerAddr => $self->cfg->{server} //'localhost', PeerPort => $self->cfg->{port} //14401)
|
my $loop = Mojo::IOLoop->singleton;
|
||||||
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"};
|
my $socket = $loop->client({address => $self->cfg->{server} // 'localhost', port => $self->cfg->{port} // 14401}, $cb);
|
||||||
|
|
||||||
$socket->autoflush(1);
|
return $socket;
|
||||||
print $socket encode_message(eval => $eval_obj);
|
}
|
||||||
|
|
||||||
my $buf = '';
|
sub async_eval {
|
||||||
my $data = '';
|
my ($self, $stream, $reader, $lang, $code) = @_;
|
||||||
my $resultstr = "Failed to read a message";
|
|
||||||
|
|
||||||
my $message = $self->read_message($socket);
|
my $loop = Mojo::IOLoop->singleton;
|
||||||
|
my $future = Future::Mojo->new($loop);
|
||||||
|
|
||||||
if (ref($message) =~ /Warning$/) {
|
my $seq = $id++;
|
||||||
return $message->message;
|
|
||||||
} else {
|
$self->_adopt_future($seq, $future);
|
||||||
return $message->get_contents;
|
my $eval_obj = {language => $lang,
|
||||||
|
files => [
|
||||||
|
{filename => '__code', contents => $code, encoding => "utf8"}
|
||||||
|
],
|
||||||
|
prio => {pr_realtime => {}},
|
||||||
|
sequence => $seq,
|
||||||
|
encoding => "utf8"};
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
print Dumper($eval_obj);
|
||||||
|
|
||||||
|
my $message = encode_message(eval => $eval_obj);
|
||||||
|
|
||||||
|
$reader->($seq, $future);
|
||||||
|
$stream->write($message);
|
||||||
|
|
||||||
|
return ($seq => $future);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_eval_reader {
|
||||||
|
my ($self, $stream) = @_;
|
||||||
|
|
||||||
|
my %futures;
|
||||||
|
my %warnings;
|
||||||
|
|
||||||
|
my $buf;
|
||||||
|
my $out;
|
||||||
|
|
||||||
|
$stream->on(read => sub {
|
||||||
|
my ($stream, $bytes) = @_;
|
||||||
|
|
||||||
|
print "Reading bytes\n";
|
||||||
|
|
||||||
|
$buf = $buf . $bytes;
|
||||||
|
my ($res, $message, $nbuf);
|
||||||
|
do {
|
||||||
|
($res, $message, $nbuf) = decode_message($buf);
|
||||||
|
$buf = $nbuf;
|
||||||
|
print Dumper($message);
|
||||||
|
|
||||||
|
if ($message) {
|
||||||
|
|
||||||
|
my $type = ref ($message);
|
||||||
|
$type =~ s/^App::EvalServerAdvanced::Protocol:://;
|
||||||
|
|
||||||
|
my $seq = $message->sequence;
|
||||||
|
|
||||||
|
if ($type eq 'Warning') {
|
||||||
|
push @{$warnings{$seq}}, $message->message;
|
||||||
|
} elsif ($type eq 'EvalResponse') {
|
||||||
|
print "Got eval response for $seq\n";
|
||||||
|
my $output = $message->get_contents;
|
||||||
|
|
||||||
|
my $warnings = join ' ', @{$warnings{$seq} || []};
|
||||||
|
|
||||||
|
$futures{$seq}->done($output);
|
||||||
|
print "Future is done: $output\n";
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
} while ($res);
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
});
|
||||||
|
|
||||||
|
return sub {
|
||||||
|
my ($seq, $future) = @_;
|
||||||
|
print "Registering $seq\n";
|
||||||
|
$futures{$seq} = $future;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
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;
|
1;
|
||||||
|
|
|
@ -22,6 +22,7 @@ my @langs = (
|
||||||
{name => "perl5.10", mode => "perl", description => "Perl 5.10"},
|
{name => "perl5.10", mode => "perl", description => "Perl 5.10"},
|
||||||
{name => "perl5.8", mode => "perl", description => "Perl 5.8"},
|
{name => "perl5.8", mode => "perl", description => "Perl 5.8"},
|
||||||
{name => "perl5.6", mode => "perl", description => "Perl 5.6"},
|
{name => "perl5.6", mode => "perl", description => "Perl 5.6"},
|
||||||
|
{name => "evalall", mode => "perl", description => "Perl (EvalAll)"},
|
||||||
{name => "perl5.5", mode => "perl", description => "Perl 5.5"},
|
{name => "perl5.5", mode => "perl", description => "Perl 5.5"},
|
||||||
{name => "perl4", mode => "perl", description => "Perl 4.0.36"},
|
{name => "perl4", mode => "perl", description => "Perl 4.0.36"},
|
||||||
{name => "perl3", mode => "perl", description => "Perl 3.0.1.10_44"},
|
{name => "perl3", mode => "perl", description => "Perl 3.0.1.10_44"},
|
||||||
|
|
1
public/extern
Symbolic link
1
public/extern
Symbolic link
|
@ -0,0 +1 @@
|
||||||
|
../extern
|
1
public/static
Symbolic link
1
public/static
Symbolic link
|
@ -0,0 +1 @@
|
||||||
|
../static
|
|
@ -270,7 +270,20 @@
|
||||||
data: {code: code, language: language},
|
data: {code: code, language: language},
|
||||||
dataType: "json",
|
dataType: "json",
|
||||||
success: function(data, status) {
|
success: function(data, status) {
|
||||||
$('#eval').text(data.evalout);
|
console.log("data out", data);
|
||||||
|
var keys = Object.keys(data.evalout);
|
||||||
|
var outputarr = [];
|
||||||
|
|
||||||
|
if (keys.length > 1) {
|
||||||
|
outputarr = $.map(data.evalout, function(output, lang) {
|
||||||
|
return "[[ "+lang+" ]]\n"+output+"\n\n";
|
||||||
|
});
|
||||||
|
} else {
|
||||||
|
outputarr = [data.evalout[keys[0]]];
|
||||||
|
}
|
||||||
|
console.log("outputarr", outputarr);
|
||||||
|
|
||||||
|
$('#eval').text(Array.join(outputarr, "\n"));
|
||||||
}
|
}
|
||||||
});
|
});
|
||||||
});
|
});
|
||||||
|
|
|
@ -69,12 +69,14 @@
|
||||||
<pre id="editor"></pre>
|
<pre id="editor"></pre>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
|
[% FOR lang IN eval.keys %]
|
||||||
<div class="row">
|
<div class="row">
|
||||||
<div id="eval" class="col-md-12">
|
<div id="eval" class="col-md-12">
|
||||||
<h3>Program Output:</h3>
|
<h3>Program Output as [% lang %]:</h3>
|
||||||
<pre>[% eval | html %]</pre>
|
<pre>[% eval.$lang | html %]</pre>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
|
[% END %]
|
||||||
<div class="panel-footer">
|
<div class="panel-footer">
|
||||||
<input value="Fork and Edit" type="submit" id="submit" />
|
<input value="Fork and Edit" type="submit" id="submit" />
|
||||||
</div>
|
</div>
|
||||||
|
|
Loading…
Add table
Reference in a new issue