| 1 | #! perl |
1 | #! perl |
| 2 | |
2 | |
|
|
3 | use IO::Socket; |
| 3 | use Storable qw/nfreeze thaw/; |
4 | use Storable qw/nfreeze thaw/; |
| 4 | |
5 | |
| 5 | my %global; # for use by eval'ed commands |
6 | my %global; # for use by eval'ed commands |
| 6 | |
7 | |
| 7 | cf::register_extcmd perl_eval => sub { |
8 | sub tcp_serve($) { |
| 8 | my ($pl, $msg) = @_; |
9 | my ($fh) = @_; |
| 9 | |
10 | |
| 10 | return (error => "error permission denied") |
11 | binmode $fh, ":raw:perlio:utf8"; |
| 11 | unless $pl->ob->flag (cf::FLAG_WIZ); |
|
|
| 12 | |
12 | |
| 13 | my $arg = eval { thaw $msg->{arg} }; |
13 | my $buf; |
| 14 | my @res = eval $msg->{code}; |
14 | my ($a,$b,$c,$d,%l,@l); # for use by shell users |
| 15 | |
15 | |
| 16 | $@ ? (error => $@) |
16 | print $fh "Welcome\n> "; |
| 17 | : (result => nfreeze \@res) |
17 | |
| 18 | }; |
18 | Event->io (fd => $fh, poll => 'r', cb => sub { |
|
|
19 | if (defined (my $cmd = <$fh>)) { |
|
|
20 | my $old_fh = select $fh; |
|
|
21 | |
|
|
22 | if ($cmd =~ /^\s*exit\b/i) { |
|
|
23 | print "will not exit() server.\n"; |
|
|
24 | } else { |
|
|
25 | { |
|
|
26 | package cf; |
|
|
27 | eval $cmd; |
|
|
28 | } |
|
|
29 | print $@ if $@; |
|
|
30 | } |
|
|
31 | |
|
|
32 | print "> "; |
|
|
33 | select $old_fh; |
|
|
34 | } else { |
|
|
35 | $_[0]->w->cancel; |
|
|
36 | } |
|
|
37 | }); |
|
|
38 | } |
|
|
39 | |
|
|
40 | # now a shell listening on a tcp-port - let the firewall decide access rights |
|
|
41 | if (my $listen = new IO::Socket::INET LocalAddr => "127.0.0.1:13322", Listen => 1, ReuseAddr => 1) { |
|
|
42 | Event->io (fd => $listen, poll => 'r', cb => sub { tcp_serve $listen->accept }); |
|
|
43 | } |
