ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/dm-support.ext
Revision: 1.27
Committed: Mon Apr 12 17:13:36 2010 UTC (14 years, 1 month ago) by root
Branch: MAIN
Changes since 1.26: +2 -2 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #! perl
2
3 use Coro::Debug;
4 use IO::Socket;
5
6 my %global; # for use by eval'ed commands
7
8 sub tcp_serve($) {
9 my ($fh) = @_;
10
11 binmode $fh, ":raw:perlio:utf8";
12
13 my $buf;
14 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);
15 my (%l, @l); # for use by shell users
16
17 print $fh <<EOF;
18 Welcome!
19 Remember that everything entered here will be in the main coro context within cf::!
20 You can freely use \$a .. \$z and \@l and \%l
21
22 Useful commands (note the '&'):
23
24 reload_perl &
25 reload_config &
26 reload_regions &
27 reload_facedata &
28 reload_treasures &
29 reload_archetypes &
30 ext::help::reload &
31 ext::books::reload &
32 ext::map_tags::reload &
33 ext::map_world::reload &
34 # ext::map_scheduler::loadall & # debugging only!
35 while (EV::TIMEOUT & Coro::EV::timed_io_once \$fh, EV::READ, 1) { Coro::Debug::command "ps" } &
36 ({mallinfo})
37 ({objinfo})
38 EOF
39 print $fh "\n> ";
40
41 my $iow; $iow = AE::io $fh, 0, sub {
42 if (defined (my $cmd = <$fh>)) {
43 $cmd =~ s/\s+$//;
44
45 if ($cmd =~ /^\s*exit\b/i) {
46 print $fh "will not exit() server.\n";
47 } elsif ($cmd =~ s/^coro\s+// or $cmd =~ /^(?:ps|bt\s)/) {
48 select $fh;
49 Coro::Debug::command $cmd;
50 select STDOUT;
51 } else {
52 my $sub = sub {
53 package cf;
54 select $fh;
55
56 # compile first, then execute, as Coro does not support switching in eval string
57 my $cb = eval "sub { $cmd \n}";
58
59 my $t1 = Time::HiRes::time;
60 my @res = $@ ? () : eval { $cb->() };
61 my $t2 = Time::HiRes::time;
62
63 print "\n",
64 "command: '$cmd'\n",
65 "execution time: ", $t2 - $t1, "\n";
66 warn "evaluation error: $@" if $@;
67 print "evaluation error: $@\n" if $@;
68 print "result:\n", cf::dumpval @res > 1 ? \@res : $res[0] if @res;
69 print "\n> ";
70
71 select STDOUT;
72 };
73
74 if ($cmd =~ s/\s*&$//) {
75 cf::async {
76 $Coro::current->desc ($cmd);
77 $sub->()
78 };
79 } else {
80 $sub->();
81 }
82 }
83
84 print $fh "\n> ";
85 } else {
86 undef $iow;
87 }
88 };
89 }
90
91 our $LISTENER;
92
93 # now a shell listening on a tcp-port - let the firewall decide access rights
94 if ($cf::CFG{perl_shell}) {
95 if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1, Blocking => 0) {
96 $LISTENER = AE::io $listen, 0, sub { tcp_serve $listen->accept };
97 }
98 }
99
100