mirror of
https://github.com/perlbot/perlbuut-pastebin
synced 2025-06-07 22:26:01 -04:00
Broken, but code is largely in place.
This commit is contained in:
Ryan Voots
parent
32a5d5115a
commit
6f9ed4a6ab
9 changed files with 649 additions and 270 deletions
272
app-old.pl
Executable file
272
app-old.pl
Executable file
|
|
@ -0,0 +1,272 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use v5.22;
|
||||
no warnings "experimental::postderef";
|
||||
use feature "postderef", "postderef_qq";
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/lib";
|
||||
use Data::Dumper;
|
||||
use DBI;
|
||||
use Encode qw/decode/;
|
||||
|
||||
use Mojolicious::Lite;
|
||||
use Mojolicious::Plugin::TtRenderer;
|
||||
use POE::Filter::Reference;
|
||||
use App::Config;
|
||||
use App::Memcached;
|
||||
use Eval::Perlbot;
|
||||
use IRC::Perlbot;
|
||||
use DateTime;
|
||||
use App::Spamfilter;
|
||||
|
||||
plugin 'tt_renderer' => {
|
||||
template_options => {
|
||||
PRE_CHOMP => 1,
|
||||
POST_CHOMP => 1,
|
||||
TRIM => 1,
|
||||
},
|
||||
};
|
||||
|
||||
app->renderer->default_handler( 'tt' );
|
||||
|
||||
if ($cfg->{features}{blogspam}) {
|
||||
plugin 'BlogSpam' => ($cfg->{blogspam}->%*);
|
||||
}
|
||||
|
||||
my $dbh = DBI->connect("dbi:SQLite:dbname=pastes.db", "", "", {RaiseError => 1});
|
||||
$dbh->{sqlite_unicode} = 1;
|
||||
# hardcode some channels first
|
||||
|
||||
sub insert_pastebin {
|
||||
my ($paste, $who, $what, $where, $expire, $lang) = @_;
|
||||
|
||||
$expire = undef if !$expire; # make sure it's null if it's empty
|
||||
|
||||
$dbh->do("INSERT INTO posts (paste, who, 'where', what, 'when', 'expiration', 'language') VALUES (?, ?, ?, ?, ?, ?, ?)", {}, $paste, $who, $where, $what, time(), $expire, $lang);
|
||||
my $id = $dbh->last_insert_id('', '', 'posts', 'id');
|
||||
|
||||
# TODO this needs to retry when it fails.
|
||||
my @chars = ('a'..'z', 1..9);
|
||||
my $slug = join '', map {$chars[rand() *@chars]} 1..6;
|
||||
$dbh->do("INSERT INTO slugs (post_id, slug) VAlUES (?, ?)", {}, $id, $slug);
|
||||
|
||||
return $slug;
|
||||
}
|
||||
|
||||
get '/' => sub {
|
||||
my $c = shift;
|
||||
$c->stash({pastedata => q{}, channels => $cfg->{announce}{channels}, page_tmpl => 'editor.html'});
|
||||
$c->render("page");
|
||||
};
|
||||
get '/pastebin' => sub {$_[0]->redirect_to('/')};
|
||||
get '/paste' => sub {$_[0]->redirect_to('/')};
|
||||
|
||||
|
||||
post '/paste' => sub {
|
||||
my $c = shift;
|
||||
|
||||
my @args = map {($c->param($_))} qw/paste name desc chan expire language/;
|
||||
|
||||
my $id = insert_pastebin(@args);
|
||||
my ($code, $who, $desc, $channel) = @args;
|
||||
|
||||
# TODO select which one based on config
|
||||
# TODO make this use the config, or http params for the url
|
||||
|
||||
if (my $type = App::Spamfilter::is_spam($c, $who, $desc, $code)) {
|
||||
warn "I thought this was spam! $type";
|
||||
} else {
|
||||
IRC::Perlbot::announce($c->param('chan'), $c->param('name'), substr($c->param('desc'), 0, 40), "https://perlbot.pl/pastebin/$id");
|
||||
}
|
||||
|
||||
$c->redirect_to('/pastebin/'.$id);
|
||||
#$c->render(text => "post accepted! $id");
|
||||
};
|
||||
|
||||
get '/edit/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid);
|
||||
|
||||
if ($row->{when}) {
|
||||
$c->stash({pastedata => $row->{paste}, channels =>$cfg->{announce}{channels}});
|
||||
$c->stash({page_tmpl => 'editor.html'});
|
||||
|
||||
$c->render('page');
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
};
|
||||
|
||||
sub get_paste {
|
||||
my $pasteid = shift;
|
||||
my $row = $dbh->selectrow_hashref(q{
|
||||
SELECT p.*
|
||||
FROM posts p
|
||||
LEFT JOIN slugs s ON p.id = s.post_id
|
||||
WHERE p.id = ? OR s.slug = ?
|
||||
ORDER BY s.slug DESC
|
||||
LIMIT 1
|
||||
}, {}, $pasteid, $pasteid);
|
||||
|
||||
my $when = delete $row->{when};
|
||||
|
||||
if ($when) {
|
||||
my $whendt = DateTime->from_epoch(epoch => $when);
|
||||
|
||||
if (!$row->{expiration} || $whendt->clone()->add(hours => $row->{expiration}) >= DateTime->now()) {
|
||||
$row->{when} = $whendt->iso8601;
|
||||
return $row;
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
get '/raw/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
|
||||
if ($row) {
|
||||
$c->render(text => $row->{paste}, format => "txt");
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
|
||||
};
|
||||
get '/pastebin/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
if ($row) {
|
||||
$c->stash($row);
|
||||
$c->stash({page_tmpl => 'viewer.html'});
|
||||
$c->stash({eval => get_eval($pasteid, $row->{paste}, $row->{lang})});
|
||||
$c->stash({paste_id => $pasteid});
|
||||
|
||||
$c->render('page');
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
post '/eval' => sub {
|
||||
my ($c) = @_;
|
||||
my $data = $c->req->body_params;
|
||||
|
||||
my $code = $data->param('code') // '';
|
||||
|
||||
my $output = get_eval(undef, $code);
|
||||
|
||||
$c->render(json => {evalout => $output});
|
||||
};
|
||||
|
||||
get '/robots.txt' => sub {
|
||||
my ($c) = @_;
|
||||
|
||||
$c->render(text => qq{User-agent: *
|
||||
Disallow: /});
|
||||
};
|
||||
|
||||
get '/api/v1/paste/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
if ($row) {
|
||||
my $data = {
|
||||
paste => $row->{paste},
|
||||
when => $row->{when},
|
||||
username => $row->{who},
|
||||
description => $row->{desc},
|
||||
language => $row->{language},
|
||||
output => get_eval($pasteid, $row->{paste})
|
||||
};
|
||||
|
||||
$c->render(json => $data);
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
};
|
||||
|
||||
post '/api/v1/paste' => sub {
|
||||
my $c = shift;
|
||||
|
||||
# TODO rate limiting
|
||||
|
||||
my @args = map {($c->param($_))} qw/paste username description channel expire language/;
|
||||
|
||||
my $id = insert_pastebin(@args);
|
||||
my ($code, $who, $desc, $channel) = @args;
|
||||
|
||||
# TODO select which one based on config
|
||||
# TODO make this use the config, or http params for the url
|
||||
|
||||
if (my $type = App::Spamfilter::is_spam($c, $who, $desc, $code)) {
|
||||
warn "I thought this was spam! $type";
|
||||
} else {
|
||||
if ($channel) { # TODO config for allowing announcements
|
||||
IRC::Perlbot::announce($channel, $who, substr($desc, 0, 40), "https://perlbot.pl/pastebin/$id");
|
||||
}
|
||||
}
|
||||
|
||||
$c->render(json => {
|
||||
url => "https://perlbot.pl/pastebin/$id", # TODO base url in config
|
||||
id => $id,
|
||||
});
|
||||
#$c->render(text => "post accepted! $id");
|
||||
};
|
||||
|
||||
get '/api/v1/languages' => sub {
|
||||
my $c=shift;
|
||||
|
||||
$c->render(json => {languages => [
|
||||
{name => "perl", description => "Perl (blead/git)"},
|
||||
{name => "perl4", description => "Perl 4.0.36"},
|
||||
{name => "perl5.5", description => "Perl 5.5"},
|
||||
{name => "perl5.6", description => "Perl 5.6"},
|
||||
{name => "perl5.8", description => "Perl 5.8"},
|
||||
{name => "perl5.10", description => "Perl 5.10"},
|
||||
{name => "perl5.12", description => "Perl 5.12"},
|
||||
{name => "perl5.14", description => "Perl 5.14"},
|
||||
{name => "perl5.16", description => "Perl 5.16"},
|
||||
{name => "perl5.18", description => "Perl 5.18"},
|
||||
{name => "perl5.20", description => "Perl 5.20"},
|
||||
{name => "perl5.22", description => "Perl 5.22"},
|
||||
{name => "perl5.24", description => "Perl 5.24"},
|
||||
{name => "text", description => "Plain text"},
|
||||
]});
|
||||
};
|
||||
|
||||
get '/api/v1/channels' => sub {
|
||||
my $c=shift;
|
||||
|
||||
$c->render(json => {channels => [
|
||||
{name => "localhost:perlbot:#perl", description => "Freenode #perl"},
|
||||
{name => "localhost:perlbot:#perlbot", description => "Freenode #perlbot"},
|
||||
{name => "localhost:perlbot:#perlcafe", description => "Freenode #perlcafe"},
|
||||
{name => "localhost:perlbot:#buutbot", description => "Freenode #buubot"},
|
||||
{name => "localhost:perlbot:##botparadise", description => "Freenode ##botparadise"},
|
||||
{name => "localhost:perlbot-magnet:#perl", description => "irc.perl.net #perl"},
|
||||
]});
|
||||
};
|
||||
|
||||
app->start;
|
||||
|
||||
270
app.pl
270
app.pl
|
|
@ -2,271 +2,9 @@
|
|||
|
||||
use strict;
|
||||
use warnings;
|
||||
use v5.22;
|
||||
no warnings "experimental::postderef";
|
||||
use feature "postderef", "postderef_qq";
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/lib";
|
||||
use Data::Dumper;
|
||||
use DBI;
|
||||
use Encode qw/decode/;
|
||||
|
||||
use Mojolicious::Lite;
|
||||
use Mojolicious::Plugin::TtRenderer;
|
||||
use POE::Filter::Reference;
|
||||
use App::Config;
|
||||
use App::Memcached;
|
||||
use Eval::Perlbot;
|
||||
use IRC::Perlbot;
|
||||
use DateTime;
|
||||
use App::Spamfilter;
|
||||
|
||||
plugin 'tt_renderer' => {
|
||||
template_options => {
|
||||
PRE_CHOMP => 1,
|
||||
POST_CHOMP => 1,
|
||||
TRIM => 1,
|
||||
},
|
||||
};
|
||||
|
||||
app->renderer->default_handler( 'tt' );
|
||||
|
||||
if ($cfg->{features}{blogspam}) {
|
||||
plugin 'BlogSpam' => ($cfg->{blogspam}->%*);
|
||||
}
|
||||
|
||||
my $dbh = DBI->connect("dbi:SQLite:dbname=pastes.db", "", "", {RaiseError => 1});
|
||||
$dbh->{sqlite_unicode} = 1;
|
||||
# hardcode some channels first
|
||||
|
||||
sub insert_pastebin {
|
||||
my ($paste, $who, $what, $where, $expire, $lang) = @_;
|
||||
|
||||
$expire = undef if !$expire; # make sure it's null if it's empty
|
||||
|
||||
$dbh->do("INSERT INTO posts (paste, who, 'where', what, 'when', 'expiration', 'language') VALUES (?, ?, ?, ?, ?, ?, ?)", {}, $paste, $who, $where, $what, time(), $expire, $lang);
|
||||
my $id = $dbh->last_insert_id('', '', 'posts', 'id');
|
||||
|
||||
# TODO this needs to retry when it fails.
|
||||
my @chars = ('a'..'z', 1..9);
|
||||
my $slug = join '', map {$chars[rand() *@chars]} 1..6;
|
||||
$dbh->do("INSERT INTO slugs (post_id, slug) VAlUES (?, ?)", {}, $id, $slug);
|
||||
|
||||
return $slug;
|
||||
}
|
||||
|
||||
get '/' => sub {
|
||||
my $c = shift;
|
||||
$c->stash({pastedata => q{}, channels => $cfg->{announce}{channels}, page_tmpl => 'editor.html'});
|
||||
$c->render("page");
|
||||
};
|
||||
get '/pastebin' => sub {$_[0]->redirect_to('/')};
|
||||
get '/paste' => sub {$_[0]->redirect_to('/')};
|
||||
|
||||
|
||||
post '/paste' => sub {
|
||||
my $c = shift;
|
||||
|
||||
my @args = map {($c->param($_))} qw/paste name desc chan expire language/;
|
||||
|
||||
my $id = insert_pastebin(@args);
|
||||
my ($code, $who, $desc, $channel) = @args;
|
||||
|
||||
# TODO select which one based on config
|
||||
# TODO make this use the config, or http params for the url
|
||||
|
||||
if (my $type = App::Spamfilter::is_spam($c, $who, $desc, $code)) {
|
||||
warn "I thought this was spam! $type";
|
||||
} else {
|
||||
IRC::Perlbot::announce($c->param('chan'), $c->param('name'), substr($c->param('desc'), 0, 40), "https://perlbot.pl/pastebin/$id");
|
||||
}
|
||||
|
||||
$c->redirect_to('/pastebin/'.$id);
|
||||
#$c->render(text => "post accepted! $id");
|
||||
};
|
||||
|
||||
get '/edit/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid);
|
||||
|
||||
if ($row->{when}) {
|
||||
$c->stash({pastedata => $row->{paste}, channels =>$cfg->{announce}{channels}});
|
||||
$c->stash({page_tmpl => 'editor.html'});
|
||||
|
||||
$c->render('page');
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
};
|
||||
|
||||
sub get_paste {
|
||||
my $pasteid = shift;
|
||||
my $row = $dbh->selectrow_hashref(q{
|
||||
SELECT p.*
|
||||
FROM posts p
|
||||
LEFT JOIN slugs s ON p.id = s.post_id
|
||||
WHERE p.id = ? OR s.slug = ?
|
||||
ORDER BY s.slug DESC
|
||||
LIMIT 1
|
||||
}, {}, $pasteid, $pasteid);
|
||||
|
||||
my $when = delete $row->{when};
|
||||
|
||||
if ($when) {
|
||||
my $whendt = DateTime->from_epoch(epoch => $when);
|
||||
|
||||
if (!$row->{expiration} || $whendt->clone()->add(hours => $row->{expiration}) >= DateTime->now()) {
|
||||
$row->{when} = $whendt->iso8601;
|
||||
return $row;
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
get '/raw/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
|
||||
if ($row) {
|
||||
$c->render(text => $row->{paste}, format => "txt");
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
|
||||
};
|
||||
get '/pastebin/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
if ($row) {
|
||||
$c->stash($row);
|
||||
$c->stash({page_tmpl => 'viewer.html'});
|
||||
$c->stash({eval => get_eval($pasteid, $row->{paste})});
|
||||
$c->stash({paste_id => $pasteid});
|
||||
|
||||
$c->render('page');
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
post '/eval' => sub {
|
||||
my ($c) = @_;
|
||||
my $data = $c->req->body_params;
|
||||
|
||||
my $code = $data->param('code') // '';
|
||||
|
||||
my $output = get_eval(undef, $code);
|
||||
|
||||
$c->render(json => {evalout => $output});
|
||||
};
|
||||
|
||||
get '/robots.txt' => sub {
|
||||
my ($c) = @_;
|
||||
|
||||
$c->render(text => qq{User-agent: *
|
||||
Disallow: /});
|
||||
};
|
||||
|
||||
get '/api/v1/paste/:pasteid' => sub {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
if ($row) {
|
||||
my $data = {
|
||||
paste => $row->{paste},
|
||||
when => $row->{when},
|
||||
username => $row->{who},
|
||||
description => $row->{desc},
|
||||
language => $row->{language},
|
||||
output => get_eval($pasteid, $row->{paste})
|
||||
};
|
||||
|
||||
$c->render(json => $data);
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
};
|
||||
|
||||
post '/api/v1/paste' => sub {
|
||||
my $c = shift;
|
||||
|
||||
# TODO rate limiting
|
||||
|
||||
my @args = map {($c->param($_))} qw/paste username description channel expire language/;
|
||||
|
||||
my $id = insert_pastebin(@args);
|
||||
my ($code, $who, $desc, $channel) = @args;
|
||||
|
||||
# TODO select which one based on config
|
||||
# TODO make this use the config, or http params for the url
|
||||
|
||||
if (my $type = App::Spamfilter::is_spam($c, $who, $desc, $code)) {
|
||||
warn "I thought this was spam! $type";
|
||||
} else {
|
||||
if ($channel) { # TODO config for allowing announcements
|
||||
IRC::Perlbot::announce($channel, $who, substr($desc, 0, 40), "https://perlbot.pl/pastebin/$id");
|
||||
}
|
||||
}
|
||||
|
||||
$c->render(json => {
|
||||
url => "https://perlbot.pl/pastebin/$id", # TODO base url in config
|
||||
id => $id,
|
||||
});
|
||||
#$c->render(text => "post accepted! $id");
|
||||
};
|
||||
|
||||
get '/api/v1/languages' => sub {
|
||||
my $c=shift;
|
||||
|
||||
$c->render(json => {languages => [
|
||||
{name => "perl", description => "Perl (blead/git)"},
|
||||
{name => "perl4", description => "Perl 4.0.36"},
|
||||
{name => "perl5.5", description => "Perl 5.5"},
|
||||
{name => "perl5.6", description => "Perl 5.6"},
|
||||
{name => "perl5.8", description => "Perl 5.8"},
|
||||
{name => "perl5.10", description => "Perl 5.10"},
|
||||
{name => "perl5.12", description => "Perl 5.12"},
|
||||
{name => "perl5.14", description => "Perl 5.14"},
|
||||
{name => "perl5.16", description => "Perl 5.16"},
|
||||
{name => "perl5.18", description => "Perl 5.18"},
|
||||
{name => "perl5.20", description => "Perl 5.20"},
|
||||
{name => "perl5.22", description => "Perl 5.22"},
|
||||
{name => "perl5.24", description => "Perl 5.24"},
|
||||
{name => "text", description => "Plain text"},
|
||||
]});
|
||||
};
|
||||
|
||||
get '/api/v1/channels' => sub {
|
||||
my $c=shift;
|
||||
|
||||
$c->render(json => {channels => [
|
||||
{name => "localhost:perlbot:#perl", description => "Freenode #perl"},
|
||||
{name => "localhost:perlbot:#perlbot", description => "Freenode #perlbot"},
|
||||
{name => "localhost:perlbot:#perlcafe", description => "Freenode #perlcafe"},
|
||||
{name => "localhost:perlbot:#buutbot", description => "Freenode #buubot"},
|
||||
{name => "localhost:perlbot:##botparadise", description => "Freenode ##botparadise"},
|
||||
{name => "localhost:perlbot-magnet:#perl", description => "irc.perl.net #perl"},
|
||||
]});
|
||||
};
|
||||
|
||||
app->start;
|
||||
use lib 'lib';
|
||||
use Mojolicious::Commands;
|
||||
|
||||
# Start command line interface for application
|
||||
Mojolicious::Commands->start_app('App');
|
||||
|
|
|
|||
41
lib/App.pm
Normal file
41
lib/App.pm
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
package App;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use v5.22;
|
||||
|
||||
use Mojo::Base 'Mojolicious';
|
||||
|
||||
use Mojolicious::Plugin::TtRenderer;
|
||||
use App::Config;
|
||||
use App::Controller::Paste;
|
||||
|
||||
sub startup {
|
||||
my $self = shift;
|
||||
|
||||
$self->plugin('tt_renderer' => {
|
||||
template_options => {
|
||||
PRE_CHOMP => 1,
|
||||
POST_CHOMP => 1,
|
||||
TRIM => 1,
|
||||
},
|
||||
});
|
||||
|
||||
$self->renderer->default_handler( 'tt' );
|
||||
|
||||
if ($cfg->{features}{blogspam}) {
|
||||
$self->plugin('BlogSpam' => ($cfg->{blogspam}->%*));
|
||||
}
|
||||
|
||||
$self->routes();
|
||||
}
|
||||
|
||||
sub routes {
|
||||
my $self = shift;
|
||||
|
||||
App::Controller::Paste->routes($self->routes);
|
||||
App::Controller::Eval->routes($self->routes);
|
||||
App::Controller::API::v1->routes($self->routes);
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -21,4 +21,10 @@ our $cfg = do {
|
|||
$data;
|
||||
};
|
||||
|
||||
sub get_config {
|
||||
my $key = shift;
|
||||
|
||||
return $cfg->{$key};
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
111
lib/App/Controller/Apiv1.pm
Normal file
111
lib/App/Controller/Apiv1.pm
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
package App::Controller::Apiv1;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Mojo::Base 'Mojolicious::Controller';
|
||||
|
||||
sub routes {
|
||||
my ($class, $_r) = @_;
|
||||
|
||||
my $route = sub {
|
||||
my ($method, $route, $action) = @_;
|
||||
$r->$method($route)->to(controller => 'apiv1', action => $action);
|
||||
};
|
||||
|
||||
# TODO make this use an automatic base for the version on the endpoints
|
||||
|
||||
$route->(get => '/api/v1/paste/:pasteid' => 'api_get_paste');
|
||||
$route->(post => '/api/v1/paste' => 'api_post_paste');
|
||||
$route->(get => '/api/v1/languages' => 'api_get_languages');
|
||||
$route->(get => '/api/v1/channels' => 'api_get_channels');
|
||||
}
|
||||
|
||||
sub api_get_paste {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
if ($row) {
|
||||
my $data = {
|
||||
paste => $row->{paste},
|
||||
when => $row->{when},
|
||||
username => $row->{who},
|
||||
description => $row->{desc},
|
||||
language => $row->{language},
|
||||
output => get_eval($pasteid, $row->{paste})
|
||||
};
|
||||
|
||||
$c->render(json => $data);
|
||||
} else {
|
||||
# 404
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
};
|
||||
|
||||
sub api_post_paste {
|
||||
my $c = shift;
|
||||
|
||||
# TODO rate limiting
|
||||
|
||||
my @args = map {($c->param($_))} qw/paste username description channel expire language/;
|
||||
|
||||
my $id = insert_pastebin(@args);
|
||||
my ($code, $who, $desc, $channel) = @args;
|
||||
|
||||
# TODO select which one based on config
|
||||
# TODO make this use the config, or http params for the url
|
||||
|
||||
|
||||
# if (my $type = App::Spamfilter::is_spam($c, $who, $desc, $code)) {
|
||||
# warn "I thought this was spam! $type";
|
||||
# } else {
|
||||
# if ($channel) { # TODO config for allowing announcements
|
||||
# IRC::Perlbot::announce($channel, $who, substr($desc, 0, 40), "https://perlbot.pl/pastebin/$id");
|
||||
## }
|
||||
# }
|
||||
|
||||
$c->render(json => {
|
||||
url => "https://perlbot.pl/pastebin/$id", # TODO base url in config
|
||||
id => $id,
|
||||
});
|
||||
#$c->render(text => "post accepted! $id");
|
||||
};
|
||||
|
||||
## TODO make this come from a perlbot model
|
||||
sub api_get_languages {
|
||||
my $c=shift;
|
||||
|
||||
$c->render(json => {languages => [
|
||||
{name => "perl", description => "Perl (blead/git)"},
|
||||
{name => "perl4", description => "Perl 4.0.36"},
|
||||
{name => "perl5.5", description => "Perl 5.5"},
|
||||
{name => "perl5.6", description => "Perl 5.6"},
|
||||
{name => "perl5.8", description => "Perl 5.8"},
|
||||
{name => "perl5.10", description => "Perl 5.10"},
|
||||
{name => "perl5.12", description => "Perl 5.12"},
|
||||
{name => "perl5.14", description => "Perl 5.14"},
|
||||
{name => "perl5.16", description => "Perl 5.16"},
|
||||
{name => "perl5.18", description => "Perl 5.18"},
|
||||
{name => "perl5.20", description => "Perl 5.20"},
|
||||
{name => "perl5.22", description => "Perl 5.22"},
|
||||
{name => "perl5.24", description => "Perl 5.24"},
|
||||
{name => "text", description => "Plain text"},
|
||||
]});
|
||||
};
|
||||
|
||||
sub api_get_channels {
|
||||
my $c=shift;
|
||||
|
||||
$c->render(json => {channels => [
|
||||
{name => "localhost:perlbot:#perl", description => "Freenode #perl"},
|
||||
{name => "localhost:perlbot:#perlbot", description => "Freenode #perlbot"},
|
||||
{name => "localhost:perlbot:#perlcafe", description => "Freenode #perlcafe"},
|
||||
{name => "localhost:perlbot:#buutbot", description => "Freenode #buubot"},
|
||||
{name => "localhost:perlbot:##botparadise", description => "Freenode ##botparadise"},
|
||||
{name => "localhost:perlbot-magnet:#perl", description => "irc.perl.net #perl"},
|
||||
]});
|
||||
};
|
||||
|
||||
1;
|
||||
31
lib/App/Controller/Eval.pm
Normal file
31
lib/App/Controller/Eval.pm
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
package App::Controller::Eval;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Mojo::Base 'Mojolicious::Controller';
|
||||
|
||||
sub routes {
|
||||
my ($class, $r) = @_;
|
||||
|
||||
my $route = sub {
|
||||
my ($method, $route, $action) = @_;
|
||||
$r->$method($route)->to(controller => 'eval', action => $action);
|
||||
};
|
||||
|
||||
$route->(post => '/eval' => 'run_eval');
|
||||
}
|
||||
|
||||
sub run_eval {
|
||||
my ($self) = @_;
|
||||
my $data = $self->req->body_params;
|
||||
|
||||
my $code = $data->param('code') // '';
|
||||
my $language = $data->param('language') // 'perl';
|
||||
|
||||
my $output = $self->eval->get_eval(undef, $code, $language);
|
||||
|
||||
$c->render(json => {evalout => $output});
|
||||
};
|
||||
|
||||
1;
|
||||
121
lib/App/Controller/Paste.pm
Normal file
121
lib/App/Controller/Paste.pm
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
package App::Controller::Paste;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use App::Config;
|
||||
use Mojo::Base 'Mojolicious::Controller';
|
||||
|
||||
sub routes {
|
||||
my ($class, $r) = @_;
|
||||
|
||||
my $route = sub {
|
||||
my ($method, $route, $action) = @_;
|
||||
$r->$method($route)->to(controller => 'paste', action => $action);
|
||||
};
|
||||
|
||||
|
||||
$route->(get => '/pastebin' => 'to_root');
|
||||
$route->(get => '/paste' => 'to_root');
|
||||
$route->(get => '/edit' => 'to_root');
|
||||
|
||||
$route->(get => '/' => 'root');
|
||||
$route->(post => '/paste' => 'post_paste');
|
||||
$route->(get => '/edit/:pasteid' => 'edit_paste');
|
||||
$route->(get => '/raw/:pasteid' => 'raw_paste');
|
||||
$route->(get => '/pastebin/:pasteid' => 'get_paste');
|
||||
}
|
||||
|
||||
sub to_root {
|
||||
my $self = shift;
|
||||
|
||||
$self->redirect_to('/');
|
||||
}
|
||||
|
||||
sub root {
|
||||
my $c = shift;
|
||||
$c->stash({pastedata => q{}, channels => $cfg->{announce}{channels}, page_tmpl => 'editor.html'});
|
||||
$c->render("page");
|
||||
};
|
||||
|
||||
sub post_paste {
|
||||
my $c = shift;
|
||||
|
||||
my @args = map {($c->param($_))} qw/paste name desc chan expire language/;
|
||||
|
||||
my $id = $c->paste->insert_pastebin(@args);
|
||||
my ($code, $who, $desc, $channel) = @args;
|
||||
|
||||
# TODO select which one based on config
|
||||
# TODO make this use the config, or http params for the url
|
||||
|
||||
# FIXME do this properly
|
||||
# if (my $type = App::Spamfilter::is_spam($c, $who, $desc, $code)) {
|
||||
# warn "I thought this was spam! $type";
|
||||
# } else {
|
||||
# IRC::Perlbot::announce($c->param('chan'), $c->param('name'), substr($c->param('desc'), 0, 40), "https://perlbot.pl/pastebin/$id");
|
||||
# }
|
||||
|
||||
$c->redirect_to('/pastebin/'.$id);
|
||||
#$c->render(text => "post accepted! $id");
|
||||
};
|
||||
|
||||
sub edit_paste {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid);
|
||||
|
||||
if ($row->{when}) {
|
||||
$c->stash({pastedata => $row->{paste}, channels =>$cfg->{announce}{channels}});
|
||||
$c->stash({page_tmpl => 'editor.html'});
|
||||
|
||||
$c->render('page');
|
||||
} else {
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
};
|
||||
|
||||
sub raw_paste {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
|
||||
if ($row) {
|
||||
$c->render(text => $row->{paste}, format => "txt");
|
||||
} else {
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
|
||||
};
|
||||
sub get_paste {
|
||||
my $c = shift;
|
||||
my $pasteid = $c->param('pasteid');
|
||||
|
||||
my $row = get_paste($pasteid);
|
||||
|
||||
if ($row) {
|
||||
$c->stash($row);
|
||||
$c->stash({page_tmpl => 'viewer.html'});
|
||||
$c->stash({eval => get_eval($pasteid, $row->{paste}, $row->{lang})});
|
||||
$c->stash({paste_id => $pasteid});
|
||||
|
||||
$c->render('page');
|
||||
} else {
|
||||
return $c->reply->not_found;
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
|
||||
sub robots {
|
||||
my ($c) = @_;
|
||||
|
||||
$c->render(text => qq{User-agent: *
|
||||
Disallow: /}, format => 'txt');
|
||||
};
|
||||
|
||||
|
||||
1;
|
||||
|
|
@ -4,8 +4,7 @@ use strict;
|
|||
use warnings;
|
||||
use v5.22;
|
||||
|
||||
use Exporter qw/import/;
|
||||
our @EXPORT=qw/get_eval/;
|
||||
use Mojo::Base '-base';
|
||||
|
||||
use Encode qw/decode/;
|
||||
use POE::Filter::Reference;
|
||||
|
|
@ -13,14 +12,16 @@ use POE::Filter::Reference;
|
|||
use App::Config;
|
||||
use App::Memcached;
|
||||
|
||||
has cfg => App::Config::get_config('evalserver');
|
||||
|
||||
sub get_eval {
|
||||
my ($paste_id, $code) = @_;
|
||||
my ($self, $paste_id, $code, $lang) = @_;
|
||||
|
||||
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 => $cfg->{evalserver}{server} //'localhost', PeerPort => $cfg->{evalserver}{port} //14400 )
|
||||
my $socket = IO::Socket::INET->new( PeerAddr => $self->cfg->{server} //'localhost', PeerPort => $self->cfg->{port} //14400 )
|
||||
or die "error: cannot connect to eval server";
|
||||
|
||||
my $refs = $filter->put( [ { code => "perl $code" } ] ); # TODO make this support other langs
|
||||
58
lib/App/Model/Paste.pm
Normal file
58
lib/App/Model/Paste.pm
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
package App::Model::Paste;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use DBI;
|
||||
use Mojo::Base '-base';
|
||||
|
||||
# TODO config for dbname
|
||||
has 'dbh' = DBI->connect("dbi:SQLite:dbname=pastes.db", "", "", {RaiseError => 1, sqlite_unicode => 1});
|
||||
|
||||
sub insert_pastebin {
|
||||
my $self = shift;
|
||||
my $dbh = $self->dbh;
|
||||
my ($paste, $who, $what, $where, $expire, $lang) = @_;
|
||||
|
||||
$expire = undef if !$expire; # make sure it's null if it's empty
|
||||
|
||||
$dbh->do("INSERT INTO posts (paste, who, 'where', what, 'when', 'expiration', 'language') VALUES (?, ?, ?, ?, ?, ?, ?)", {}, $paste, $who, $where, $what, time(), $expire, $lang);
|
||||
my $id = $dbh->last_insert_id('', '', 'posts', 'id');
|
||||
|
||||
# TODO this needs to retry when it fails.
|
||||
my @chars = ('a'..'z', 1..9);
|
||||
my $slug = join '', map {$chars[rand() *@chars]} 1..6;
|
||||
$dbh->do("INSERT INTO slugs (post_id, slug) VAlUES (?, ?)", {}, $id, $slug);
|
||||
|
||||
return $slug;
|
||||
}
|
||||
|
||||
sub get_paste {
|
||||
my ($self, $pasteid) = shift;
|
||||
my $dbh = $self->dbh;
|
||||
my $row = $dbh->selectrow_hashref(q{
|
||||
SELECT p.*
|
||||
FROM posts p
|
||||
LEFT JOIN slugs s ON p.id = s.post_id
|
||||
WHERE p.id = ? OR s.slug = ?
|
||||
ORDER BY s.slug DESC
|
||||
LIMIT 1
|
||||
}, {}, $pasteid, $pasteid);
|
||||
|
||||
my $when = delete $row->{when};
|
||||
|
||||
if ($when) {
|
||||
my $whendt = DateTime->from_epoch(epoch => $when);
|
||||
|
||||
if (!$row->{expiration} || $whendt->clone()->add(hours => $row->{expiration}) >= DateTime->now()) {
|
||||
$row->{when} = $whendt->iso8601;
|
||||
return $row;
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
Loading…
Add table
Reference in a new issue