| 1 | #! perl |
1 | #! perl |
| 2 | |
2 | |
| 3 | # untested dm support extension |
3 | use IO::Socket; |
| 4 | |
|
|
| 5 | use Storable qw/nfreeze thaw/; |
4 | use Storable qw/nfreeze thaw/; |
| 6 | |
5 | |
| 7 | my %global; # for use by eval'ed commands |
6 | my %global; # for use by eval'ed commands |
| 8 | |
7 | |
| 9 | cf::register_extcmd perl_eval => sub { |
8 | sub tcp_serve($) { |
| 10 | my ($pl, $data) = @_; |
9 | my ($fh) = @_; |
| 11 | |
10 | |
| 12 | my ($token, $data) = split / /, $data, 2; |
11 | binmode $fh, ":raw:perlio:utf8"; |
| 13 | |
12 | |
| 14 | unless ($pl->flag (cf::FLAG_WIZ)) { |
13 | my $buf; |
| 15 | $pl->send ("ext $token error permission denied"); |
14 | my ($a,$b,$c,$d,%l,@l); # for use by shell users |
| 16 | return; |
|
|
| 17 | } |
|
|
| 18 | |
15 | |
| 19 | my ($code, $arg) = split /\0/, $data, 2; |
16 | print $fh "Welcome\n> "; |
| 20 | |
17 | |
| 21 | $arg = eval { thaw $arg }; |
18 | Event->io (fd => $fh, poll => 'r', cb => sub { |
| 22 | my @res = eval $code; |
19 | if (defined (my $cmd = <$fh>)) { |
|
|
20 | my $old_fh = select $fh; |
| 23 | |
21 | |
| 24 | $@ ? $pl->send ("ext $token error " . nfreeze $@) |
22 | if ($cmd =~ /^\s*exit\b/i) { |
| 25 | : $pl->send ("ext $token ok " . nfreeze \@res); |
23 | print "will not exit() server.\n"; |
| 26 | }; |
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 | } |
