1 |
joko |
1.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 |
|
|
} |