ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/dm-support.ext
(Generate patch)

Comparing deliantra/maps/perl/dm-support.ext (file contents):
Revision 1.2 by root, Wed Jul 19 08:52:57 2006 UTC vs.
Revision 1.8 by root, Fri Dec 15 19:06:29 2006 UTC

1#! perl 1#! perl
2 2
3# untested dm support extension 3use IO::Socket;
4
5use Storable qw/nfreeze thaw/; 4use Storable qw/nfreeze thaw/;
6 5
7my %global; # for use by eval'ed commands 6my %global; # for use by eval'ed commands
8 7
9cf::register_extcmd perl_eval => sub { 8sub 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; 15
16 print $fh "Welcome\n> ";
17
18 Event->io (fd => $fh, poll => 'r', data => cf::WF_AUTOCANCEL, 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
41if ($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', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept });
17 } 44 }
18 45}
19 my ($code, $arg) = split /\0/, $data, 2;
20
21 $arg = eval { thaw $arg };
22 my @res = eval $code;
23
24 $@ ? $pl->send ("ext $token error " . nfreeze $@)
25 : $pl->send ("ext $token ok " . nfreeze \@res);
26};

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines