| 1 |
#!/usr/bin/perl -w |
| 2 |
|
| 3 |
use strict; |
| 4 |
use Socket qw(inet_ntoa); |
| 5 |
use POE qw( Wheel::SocketFactory Wheel::ReadWrite |
| 6 |
Filter::Line Driver::SysRW ); |
| 7 |
use constant PORT => 31008; |
| 8 |
|
| 9 |
new POE::Session ( |
| 10 |
_start => \&server_start, |
| 11 |
_stop => \&server_stop, |
| 12 |
); |
| 13 |
|
| 14 |
$poe_kernel->run(); |
| 15 |
exit; |
| 16 |
|
| 17 |
|
| 18 |
sub server_start { |
| 19 |
$_[HEAP]->{listener} = new POE::Wheel::SocketFactory |
| 20 |
( BindPort => PORT, |
| 21 |
Reuse => 'yes', |
| 22 |
SuccessState => \&accept_new_client, |
| 23 |
FailureState => \&accept_failed |
| 24 |
); |
| 25 |
print "SERVER: Started listening on port ", PORT, ".\n"; |
| 26 |
} |
| 27 |
|
| 28 |
|
| 29 |
sub server_stop { |
| 30 |
print "SERVER: Stopped.\n"; |
| 31 |
} |
| 32 |
|
| 33 |
|
| 34 |
sub accept_new_client { |
| 35 |
my ($socket, $peeraddr, $peerport) = @_[ARG0 .. ARG2]; |
| 36 |
$peeraddr = inet_ntoa($peeraddr); |
| 37 |
|
| 38 |
new POE::Session ( |
| 39 |
_start => \&child_start, |
| 40 |
_stop => \&child_stop, |
| 41 |
main => [ 'child_input', 'child_done', 'child_error' ], |
| 42 |
[ $socket, $peeraddr, $peerport ], |
| 43 |
); |
| 44 |
print "SERVER: Got connection from $peeraddr:$peerport.\n"; |
| 45 |
} |
| 46 |
|
| 47 |
|
| 48 |
sub accept_failed { |
| 49 |
my ($function, $error) = @_[ARG0, ARG2]; |
| 50 |
|
| 51 |
delete $_[HEAP]->{listener}; |
| 52 |
print "SERVER: call to $function() failed: $error.\n"; |
| 53 |
} |
| 54 |
|
| 55 |
|
| 56 |
sub child_start { |
| 57 |
my ($heap, $socket) = @_[HEAP, ARG0]; |
| 58 |
|
| 59 |
$heap->{readwrite} = new POE::Wheel::ReadWrite |
| 60 |
( Handle => $socket, |
| 61 |
Driver => new POE::Driver::SysRW (), |
| 62 |
Filter => new POE::Filter::Line (), |
| 63 |
InputState => 'child_input', |
| 64 |
ErrorState => 'child_error', |
| 65 |
); |
| 66 |
$heap->{readwrite}->put( "Hello, client!" ); |
| 67 |
|
| 68 |
$heap->{peername} = join ':', @_[ARG1, ARG2]; |
| 69 |
print "CHILD: Connected to $heap->{peername}.\n"; |
| 70 |
} |
| 71 |
|
| 72 |
|
| 73 |
sub child_stop { |
| 74 |
print "CHILD: Stopped.\n"; |
| 75 |
} |
| 76 |
|
| 77 |
|
| 78 |
sub child_input { |
| 79 |
my $data = $_[ARG0]; |
| 80 |
|
| 81 |
$data =~ tr{0-9+*/()-}{}cd; |
| 82 |
return unless length $data; |
| 83 |
my $result = eval $data; |
| 84 |
chomp $@; |
| 85 |
$_[HEAP]->{readwrite}->put( $@ || $result ); |
| 86 |
print "CHILD: Got input from peer: \"$data\" = $result.\n"; |
| 87 |
} |
| 88 |
|
| 89 |
|
| 90 |
sub child_done { |
| 91 |
delete $_[HEAP]->{readwrite}; |
| 92 |
print "CHILD: disconnected from ", $_[HEAP]->{peername}, ".\n"; |
| 93 |
} |
| 94 |
|
| 95 |
|
| 96 |
sub child_error { |
| 97 |
my ($function, $error) = @_[ARG0, ARG2]; |
| 98 |
|
| 99 |
delete $_[HEAP]->{readwrite}; |
| 100 |
print "CHILD: call to $function() failed: $error.\n" if $error; |
| 101 |
} |
Parent Directory
| 
Revision Log
