#!/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 TOML; plugin 'tt_renderer' => { template_options => { PRE_CHOMP => 1, POST_CHOMP => 1, TRIM => 1, }, }; app->renderer->default_handler( 'tt' ); my $cfg = do { my $toml = do {open(my $fh, "<", "$Bin/app.cfg"); local $/; <$fh>}; # With error checking my ($data, $err) = from_toml($toml); unless ($data) { die "Error parsing toml: $err"; } $data; }; my $memd; if ($cfg->{features}{memcached}) { my $namespace = delete $cfg->{memcached}{namespace}; $namespace .= "_".time() if (delete $cfg->{memcached}{unique_namespace}); # Only load these if we're using them require Cache::Memcached::Fast; require IO::Compress::Gzip; require IO::Uncompress::Gunzip; $memd = Cache::Memcached::Fast->new({ namespace => $namespace // 'pastebin', connect_timeout => 0.2, io_timeout => 0.5, close_on_error => 1, compress_threshold => 1_000, compress_ratio => 0.9, compress_methods => [ \&IO::Compress::Gzip::gzip, \&IO::Uncompress::Gunzip::gunzip ], max_failures => 3, failure_timeout => 2, ketama_points => 150, nowait => 1, hash_namespace => 1, serialize_methods => [ \&Storable::freeze, \&Storable::thaw ], utf8 => 1, max_size => 512 * 1024, $cfg->{memcached}->%*, # let the config overwrite anything set here if they want }); }; 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) = @_; $dbh->do("INSERT INTO posts (paste, who, 'where', what, 'when') VALUES (?, ?, ?, ?, ?)", {}, $paste, $who, $where, $what, time()); my $id = $dbh->last_insert_id('', '', 'posts', 'id'); return $id; } sub get_eval { my ($paste_id, $code) = @_; if ($cfg->{features}{memcached} && (my $cached = $memd->get($paste_id))) { return $cached; } else { my $filter = POE::Filter::Reference->new(); my $socket = IO::Socket::INET->new( PeerAddr => 'localhost', PeerPort => '14400' ) or die "error: cannot connect to eval server"; my $refs = $filter->put( [ { code => "perl $code" } ] ); 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 $cfg->{features}{memcached}; return $str; } } 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/; my $id = insert_pastebin(@args); $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 } }; get '/pastebin/: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($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 } }; get '/eval/:pasteid' => sub { my ($c) = @_; my $pasteid = $c->param('pasteid'); my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid); my $code = $row->{paste} // ''; my $output = get_eval($pasteid, $code); $c->render(json => {evalout => $output}); }; app->start;