| 1 | #! perl |
1 | #! perl |
| 2 | |
2 | |
| 3 | # untested dm support extension |
3 | use IO::Socket; |
|
|
4 | use Storable qw/nfreeze thaw/; |
| 4 | |
5 | |
| 5 | use Storable qw/freeze thaw/; |
6 | my %global; # for use by eval'ed commands |
| 6 | |
7 | |
| 7 | #cf::register_extcmd perleval => sub { |
8 | sub tcp_serve($) { |
| 8 | # my ($pl, $indata) = @_; |
9 | my ($fh) = @_; |
| 9 | # |
10 | |
| 10 | # my ($token, $evaldata) = split / /, $indata, 2; |
11 | binmode $fh, ":raw:perlio:utf8"; |
| 11 | # my ($code, $storablein) = split /\0/, $evaldata, 2; |
12 | |
| 12 | # |
13 | my $buf; |
| 13 | # unless ($pl->flag (cf::FLAG_WIZ)) { |
14 | my ($a,$b,$c,$d,%l,@l); # for use by shell users |
| 14 | # $pl->send ("ext $token"); |
15 | |
| 15 | # return; |
16 | print $fh "Welcome\n> "; |
|
|
17 | |
|
|
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 ($cf::CFG{perl_shell}) { |
|
|
42 | if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1) { |
|
|
43 | Event->io (fd => $listen, poll => 'r', cb => sub { tcp_serve $listen->accept }); |
| 16 | # } |
44 | } |
| 17 | # |
45 | } |
| 18 | # my $data = thaw $storablein; |
|
|
| 19 | # |
|
|
| 20 | # $pl->send ("ext $token " . freeze eval $code); |
|
|
| 21 | #}; |
|
|
