--- deliantra/server/ext/dm-support.ext 2007/09/19 21:49:53 1.10 +++ deliantra/server/ext/dm-support.ext 2010/04/12 05:27:10 1.26 @@ -2,22 +2,19 @@ use Coro::Debug; use IO::Socket; -use Storable qw/nfreeze thaw/; my %global; # for use by eval'ed commands sub tcp_serve($) { my ($fh) = @_; - select $fh; - binmode $fh, ":raw:perlio:utf8"; my $buf; my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z); my (%l, @l); # for use by shell users - print < "; + print $fh "\n> "; - Event->io (fd => $fh, poll => 'r', data => 0, cb => sub { + my $iow; $iow = AE::io $fh, 0, sub { if (defined (my $cmd = <$fh>)) { $cmd =~ s/\s+$//; if ($cmd =~ /^\s*exit\b/i) { - print "will not exit() server.\n"; + print $fh "will not exit() server.\n"; } elsif ($cmd =~ s/^coro\s+// or $cmd =~ /^(?:ps|bt\s)/) { + select $fh; Coro::Debug::command $cmd; + select STDOUT; } else { my $sub = sub { package cf; select $fh; - # compile first, the execute, as Coro does not support switching in eval string - my $cb = eval "sub { $cmd }"; + # compile first, then execute, as Coro does not support switching in eval string + my $cb = eval "sub { $cmd \n}"; my $t1 = Time::HiRes::time; my @res = $@ ? () : eval { $cb->() }; @@ -64,26 +67,33 @@ print "evaluation error: $@\n" if $@; print "result:\n", cf::dumpval @res > 1 ? \@res : $res[0] if @res; print "\n> "; + + select STDOUT; }; if ($cmd =~ s/\s*&$//) { - Coro::async { $sub->() }; + cf::async { + $Coro::current->desc ($cmd); + $sub->() + }; } else { $sub->(); } } - print "\n> "; + print $fh "\n> "; } else { - $_[0]->w->cancel; + undef $iow; } - }); + }; } +our $LISTENER; + # now a shell listening on a tcp-port - let the firewall decide access rights if ($cf::CFG{perl_shell}) { - if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1) { - Event->io (fd => $listen, poll => 'r', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept }); + if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1, Blocking => 0) { + $LISTENER = AE::io $listen, 0, sub { tcp_serve $listen->accept }; } }