ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/dm-support.ext
Revision: 1.9
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.8: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# Content
1 #! perl
2
3 use IO::Socket;
4 use Storable qw/nfreeze thaw/;
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,%l,@l); # for use by shell users
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
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', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept });
44 }
45 }