File Coverage

blib/lib/POE/Component/Server/IRC/Backend.pm
Criterion Covered Total %
statement 359 472 76.0
branch 99 216 45.8
condition 40 104 38.4
subroutine 46 58 79.3
pod 18 22 81.8
total 562 872 64.4


line stmt bran cond sub pod time code
1             package POE::Component::Server::IRC::Backend;
2             our $AUTHORITY = 'cpan:BINGOS';
3             $POE::Component::Server::IRC::Backend::VERSION = '1.60'; # TRIAL
4 183     183   89457 use strict;
  183         440  
  183         6013  
5 183     183   1048 use warnings;
  183         423  
  183         5610  
6 183     183   1092 use Carp qw(carp croak);
  183         426  
  183         9893  
7 183     183   1119 use List::Util qw(first);
  183         489  
  183         11734  
8 183         1497 use POE qw(Wheel::SocketFactory Wheel::ReadWrite Filter::Stackable
9 183     183   1705 Filter::Line Filter::IRCD Filter::ThruPut);
  183         31970  
10 183     183   3122099 use Net::Netmask;
  183         36987003  
  183         30448  
11 183     183   3274 use Net::CIDR ();
  183         5547  
  183         5566  
12 183     183   125128 use Net::IP::Minimal qw[ip_is_ipv6];
  183         163969  
  183         13931  
13 183     183   1588 use Socket qw(getnameinfo NI_NUMERICHOST NI_NUMERICSERV AF_INET6);
  183         906  
  183         13576  
14 183     183   1440 use base qw(POE::Component::Syndicator);
  183         479  
  183         114235  
15              
16             use constant {
17 183         1216406 OBJECT_STATES_HASHREF => {
18             syndicator_started => '_start',
19             add_connector => '_add_connector',
20             add_listener => '_add_listener',
21             del_listener => '_del_listener',
22             send_output => '_send_output',
23             shutdown => '_shutdown',
24             },
25             OBJECT_STATES_ARRAYREF => [qw(
26             _accept_connection
27             _accept_failed
28             _conn_alarm
29             _conn_input
30             _conn_error
31             _conn_flushed
32             _event_dispatcher
33             _sock_failed
34             _sock_up
35             _sock_ssl
36             )],
37 183     183   1911227 };
  183         597  
38              
39             sub create {
40 182     182 1 804 my $package = shift;
41 182 50       1053 croak("$package requires an even number of parameters") if @_ & 1;
42 182         1014 my %args = @_;
43 182         1610 $args{ lc $_ } = delete $args{$_} for keys %args;
44 182         776 my $self = bless { }, $package;
45              
46 182 50       895 $self->{raw_events} = $args{raw_events} if defined $args{raw_events};
47             $self->{prefix} = defined $args{prefix}
48             ? $args{prefix}
49 182 50       2756 : 'ircd_';
50             $self->{antiflood} = defined $args{antiflood}
51             ? $args{antiflood}
52 182 50       996 : 1;
53              
54             $self->{auth} = defined $args{auth}
55             ? $args{auth}
56 182 50       771 : 1;
57              
58 182 100 66     951 if ($args{sslify_options} && ref $args{sslify_options} eq 'ARRAY') {
59 12         31 eval {
60 12         88 require POE::Component::SSLify;
61 12         656 POE::Component::SSLify->import(
62             qw(SSLify_GetCTX SSLify_Options Server_SSLify Client_SSLify SSLify_ContextCreate)
63             );
64             };
65 12         50 chomp $@;
66 12 50       45 croak("Can't use ssl: $@") if $@;
67              
68 12         34 eval {
69 12         31 SSLify_Options(@{ $args{sslify_options} });
  12         85  
70 12         11239 my $ctx = SSLify_GetCTX();
71 12         184 require Net::SSLeay;
72 12     22   183 Net::SSLeay::CTX_set_verify( $ctx, 0x01, sub { return 1; } );
  22         99785  
73             };
74 12         39 chomp $@;
75 12 50       49 croak("Can't use ssl: $@") if $@;
76 12         45 $self->{got_ssl} = 1;
77             }
78              
79 182 100       746 if ($args{states}) {
80 181         1407 my $error = $self->_validate_states($args{states});
81 181 50       767 croak($error) if defined $error;
82             }
83              
84             $self->_syndicator_init(
85             prefix => $self->{prefix},
86             reg_prefix => 'PCSI_',
87             types => [ SERVER => 'IRCD', USER => 'U' ],
88             object_states => [
89             $self => OBJECT_STATES_HASHREF,
90             $self => OBJECT_STATES_ARRAYREF,
91             ($args{states}
92 362         3533 ? map { $self => $_ } @{ $args{states} }
  181         673  
93             : ()
94             ),
95             ],
96             ($args{plugin_debug} ? (debug => 1) : () ),
97 182 100       1298 (ref $args{options} eq 'HASH' ? (options => $args{options}) : ()),
    50          
    50          
98             );
99              
100 182 100       41936 if ($self->{auth}) {
101 1         634 require POE::Component::Server::IRC::Plugin::Auth;
102             $self->plugin_add(
103             'Auth_'.$self->session_id(),
104             POE::Component::Server::IRC::Plugin::Auth->new(
105             identport => $args{identport},
106 1         65 ),
107             );
108             }
109              
110 182         1345 return $self;
111             }
112              
113             sub _validate_states {
114 181     181   751 my ($self, $states) = @_;
115              
116 181         674 for my $events (@$states) {
117 362 100       1869 if (ref $events eq 'HASH') {
    50          
118 181         1360 for my $event (keys %$events) {
119 3982 50 33     12072 if (OBJECT_STATES_HASHREF->{$event}
120 39820     39820   59809 || first { $event eq $_ } @{ +OBJECT_STATES_ARRAYREF }) {
  3982         8145  
121 0         0 return "Event $event is reserved by ". __PACKAGE__;
122             }
123             }
124             }
125             elsif (ref $events eq 'ARRAY') {
126 181         688 for my $event (@$events) {
127 724 50 33     4202 if (OBJECT_STATES_HASHREF->{$event}
128 7240     7240   15876 || first { $event eq $_ } @{ +OBJECT_STATES_ARRAYREF }) {
  724         2591  
129 0         0 return "Event $event is reserved by ". __PACKAGE__;
130             }
131             }
132             }
133             }
134              
135 181         673 return;
136             }
137              
138             sub _start {
139 182     182   266790 my ($kernel, $self, $sender) = @_[KERNEL, OBJECT, SENDER];
140              
141 182         2131 $self->{ircd_filter} = POE::Filter::IRCD->new(
142             colonify => 1,
143             );
144 182         6192 $self->{line_filter} = POE::Filter::Line->new(
145             InputRegexp => '\015?\012',
146             OutputLiteral => "\015\012",
147             );
148             $self->{filter} = POE::Filter::Stackable->new(
149 182         14049 Filters => [$self->{line_filter}, $self->{ircd_filter}],
150             );
151              
152 182         4249 return;
153             }
154              
155             sub raw_events {
156 0     0 1 0 my ($self, $value) = @_;
157 0 0       0 $self->{raw_events} = 1 if $value;
158 0         0 return;
159             }
160              
161             sub shutdown {
162 1     1 1 4 my ($self) = shift;
163 1         5 $self->yield('shutdown', @_);
164 1         105 return;
165             }
166              
167             sub _shutdown {
168 195     195   423487 my ($kernel, $self) = @_[KERNEL, OBJECT];
169              
170 195         793 $self->{terminating} = 1;
171 195         1763 delete $self->{listeners};
172 195         46901 delete $self->{connectors};
173 195         1141 delete $self->{wheels};
174 195         16772 $self->_syndicator_destroy();
175 195         76100 return;
176             }
177              
178             sub _accept_failed {
179 0     0   0 my ($kernel, $self, $operation, $errnum, $errstr, $listener_id)
180             = @_[KERNEL, OBJECT, ARG0..ARG3];
181              
182 0         0 my $port = $self->{listeners}{$listener_id}{port};
183 0         0 my $addr = $self->{listeners}{$listener_id}{addr};
184 0         0 delete $self->{listeners}{$listener_id};
185 0         0 $self->send_event(
186             "$self->{prefix}listener_failure",
187             $listener_id,
188             $operation,
189             $errnum,
190             $errstr,
191             $port,
192             $addr,
193             );
194 0         0 return;
195             }
196              
197             sub _accept_connection {
198 525     525   40961640 my ($kernel, $self, $socket, $listener_id)
199             = @_[KERNEL, OBJECT, ARG0, ARG3];
200              
201 525         10749 my (undef,$peeraddr,$peerport) = getnameinfo( CORE::getpeername( $socket ), NI_NUMERICHOST | NI_NUMERICSERV );
202 525         7349 my (undef,$sockaddr,$sockport) = getnameinfo( CORE::getsockname( $socket ), NI_NUMERICHOST | NI_NUMERICSERV );
203              
204 525         3425 s!^::ffff:!! for ( $sockaddr, $peeraddr );
205              
206 525         2697 my $listener = $self->{listeners}{$listener_id};
207              
208 525         1178 my $secured = 0;
209 525         1349 my $context = { };
210              
211 525 100 100     2645 if ($self->{got_ssl} && $listener->{usessl}) {
212 15         110 my $cb = $_[SESSION]->callback('_sock_ssl',$context);
213 15         1595 eval {
214 15         105 $socket = POE::Component::SSLify::Server_SSLify($socket,undef,$cb);
215 15         3561 $secured = 1;
216             };
217 15         50 chomp $@;
218 15 50       62 die "Failed to SSLify server socket: $@" if $@;
219             }
220              
221 525         5593 my $stats_filter = POE::Filter::ThruPut->new();
222              
223             my $wheel = POE::Wheel::ReadWrite->new(
224             Handle => $socket,
225             InputEvent => '_conn_input',
226             ErrorEvent => '_conn_error',
227             FlushedEvent => '_conn_flushed',
228             Filter => POE::Filter::Stackable->new(
229 525         9577 Filters => [$stats_filter, $self->{filter}],
230             ),
231             );
232              
233 525 50       225430 if ($wheel) {
234 525         2559 my $wheel_id = $wheel->ID();
235 525         3289 $context->{wheel_id} = $wheel_id;
236             my $ref = {
237             wheel => $wheel,
238             peeraddr => $peeraddr,
239             peerport => $peerport,
240             flooded => 0,
241             sockaddr => $sockaddr,
242             sockport => $sockport,
243             idle => $listener->{idle},
244             antiflood => $listener->{antiflood},
245 525         7171 compress => 0,
246             secured => $secured,
247             stats => $stats_filter,
248             _sent => 0,
249             };
250              
251 525 100 66     5165 my $needs_auth = $listener->{auth} && $self->{auth} ? 1 : 0;
252 525         4279 $self->send_event(
253             "$self->{prefix}connection",
254             $wheel_id,
255             $peeraddr,
256             $peerport,
257             $sockaddr,
258             $sockport,
259             $needs_auth,
260             $secured,
261             $stats_filter,
262             );
263              
264             $ref->{alarm} = $kernel->delay_set(
265             '_conn_alarm',
266             $listener->{idle},
267 525         68299 $wheel_id,
268             );
269 525         39165 $self->{wheels}{$wheel_id} = $ref;
270              
271 525 100       3599 if ( my $reason = $self->denied( $peeraddr ) ) {
272 6         21 $ref->{disconnecting} = $reason;
273 6         31 my $out = { command => 'ERROR', params => [ $reason ] };
274 6         34 $self->send_output( $out, $wheel_id );
275             }
276             }
277 525         2792 return;
278             }
279              
280             sub _sock_ssl {
281 15     15   28138 my ($kernel,$self,$first,$second) = @_[KERNEL,OBJECT,ARG0,ARG1];
282 15         54 my ($cont) = @$first;
283 15 50       90 return if !$cont->{wheel_id};
284 15         53 my $wheel_id = delete $cont->{wheel_id};
285 15 50       115 return if !$self->{wheels}{$wheel_id};
286 15         55 my ($sock,$stat,$err) = @$second;
287 15 50       56 return if !$stat;
288 15         63 my $sslinf = _get_ssl_info($sock);
289 15         44 my $ref = $self->{wheels}{$wheel_id};
290 15 50       72 $ref->{sslinf} = $sslinf if $sslinf;
291 15         180 return;
292             }
293              
294             sub _get_ssl_info {
295 29   50 29   112 my $sock = shift || return;
296 29         82 my $sslinf = eval {
297 29         230 require Net::SSLeay;
298 29         142 my $ssl = POE::Component::SSLify::SSLify_GetSSL($sock);
299 29         331 my $cipher = Net::SSLeay::get_cipher($ssl);
300 29         124 my $bits = Net::SSLeay::get_cipher_bits($ssl);
301 29         111 my $version = Net::SSLeay::version($ssl);
302 29 0       131 my $ver =
    0          
    0          
    0          
    0          
    50          
303             $version == 0x0303 ? 'TLSv1_2' :
304             $version == 0x0302 ? 'TLSv1_1' :
305             $version == 0x0301 ? 'TLSv1' :
306             $version == 0x0300 ? 'SSLv3' :
307             $version == 0x0002 ? 'SSLv2' :
308             $version == 0xfeff ? 'DTLS1' :
309             undef;
310 29         161 return "$ver-$cipher-$bits";
311             };
312 29         82 return $sslinf;
313             }
314              
315             sub add_listener {
316 174     174 1 190109 my ($self) = shift;
317 174 50       1138 croak('add_listener requires an even number of parameters') if @_ & 1;
318 174         1088 $self->yield('add_listener', @_);
319 174         15300 return;
320             }
321              
322             sub _add_listener {
323 178     178   179128 my ($kernel, $self) = @_[KERNEL, OBJECT];
324 178         956 my %args = @_[ARG0..$#_];
325              
326 178         1013 $args{ lc($_) } = delete $args{$_} for keys %args;
327              
328 178   50     1659 my $bindaddr = $args{bindaddr} || '0.0.0.0';
329 178   50     1429 my $bindport = $args{port} || 0;
330 178   50     1212 my $idle = $args{idle} || 180;
331 178         529 my $auth = 1;
332 178         424 my $antiflood = 1;
333 178         447 my $usessl = 0;
334 178 100       875 $usessl = 1 if $args{usessl};
335 178 50 33     1071 $auth = 0 if defined $args{auth} && $args{auth} eq '0';
336 178 50 33     970 $antiflood = 0 if defined $args{antiflood} && $args{antiflood} eq '0';
337              
338             my $listener = POE::Wheel::SocketFactory->new(
339             BindAddress => $bindaddr,
340             BindPort => $bindport,
341             SuccessEvent => '_accept_connection',
342             FailureEvent => '_accept_failed',
343             Reuse => 'on',
344             ( ip_is_ipv6( $bindaddr ) ? ( SocketDomain => AF_INET6 ) : () ),
345 178 50       1673 ($args{listenqueue} ? (ListenQueue => $args{listenqueue}) : ()),
    50          
346             );
347              
348 178         118829 my $id = $listener->ID();
349 178         1822 $self->{listeners}{$id}{wheel} = $listener;
350 178         626 $self->{listeners}{$id}{port} = $bindport;
351 178         695 $self->{listeners}{$id}{addr} = $bindaddr;
352 178         604 $self->{listeners}{$id}{idle} = $idle;
353 178         568 $self->{listeners}{$id}{auth} = $auth;
354 178         590 $self->{listeners}{$id}{antiflood} = $antiflood;
355 178         575 $self->{listeners}{$id}{usessl} = $usessl;
356              
357 178         983 my (undef,$addr,$port) = getnameinfo( $listener->getsockname, NI_NUMERICHOST | NI_NUMERICSERV );
358 178         6534 $addr =~ s!^::ffff:!!;
359 178 50       830 if ($port) {
360 178         728 $self->{listeners}{$id}{port} = $port;
361             $self->send_event(
362 178         3063 $self->{prefix} . 'listener_add',
363             $port,
364             $id,
365             $bindaddr,
366             $usessl,
367             );
368             }
369 178         25785 return;
370             }
371              
372             sub del_listener {
373 10     10 1 10000 my ($self) = shift;
374 10 50       65 croak("add_listener requires an even number of parameters") if @_ & 1;
375 10         58 $self->yield('del_listener', @_);
376 10         1235 return;
377             }
378              
379             sub _del_listener {
380 10     10   8501 my ($kernel, $self) = @_[KERNEL, OBJECT];
381 10         62 my %args = @_[ARG0..$#_];
382              
383 10         82 $args{lc $_} = delete $args{$_} for keys %args;
384 10         45 my $listener_id = delete $args{listener};
385 10         33 my $port = delete $args{port};
386              
387 10 50       152 if ($self->_listener_exists($listener_id)) {
    50          
388 0         0 my $port = $self->{listeners}{$listener_id}{port};
389 0         0 my $addr = $self->{listeners}{$listener_id}{addr};
390 0         0 delete $self->{listeners}{$listener_id};
391             $self->send_event(
392 0         0 $self->{prefix} . 'listener_del',
393             $port,
394             $listener_id,
395             $addr,
396             );
397             }
398             elsif (defined $port) {
399 10         35 while (my ($id, $listener) = each %{ $self->{listeners } }) {
  20         4096  
400 10 50       60 if ($listener->{port} == $port) {
401 10         27 my $addr = $listener->{addr};
402 10         27 delete $self->{listeners}{$id};
403             $self->send_event(
404 10         66 $self->{prefix} . 'listener_del',
405             $port,
406             $listener_id,
407             $addr,
408             );
409             }
410             }
411             }
412              
413 10         61 return;
414             }
415              
416             sub _listener_exists {
417 10     10   35 my $self = shift;
418 10   50     82 my $listener_id = shift || return;
419 0 0       0 return 1 if defined $self->{listeners}{$listener_id};
420 0         0 return;
421             }
422              
423             sub add_connector {
424 3     3 1 8 my $self = shift;
425 3 50       15 croak("add_connector requires an even number of parameters") if @_ & 1;
426 3         17 $self->yield('add_connector', @_);
427 3         385 return;
428             }
429              
430             sub _add_connector {
431 3     3   614 my ($kernel, $self, $sender) = @_[KERNEL, OBJECT, SENDER];
432 3         21 my %args = @_[ARG0..$#_];
433              
434 3         32 $args{lc $_} = delete $args{$_} for keys %args;
435              
436 3         12 my $remoteaddress = $args{remoteaddress};
437 3         9 my $remoteport = $args{remoteport};
438              
439 3 50 33     47 return if !$remoteaddress || !$remoteport;
440              
441 3   50     21 $args{idle} = $args{idle} || 180;
442              
443             my $wheel = POE::Wheel::SocketFactory->new(
444             SocketProtocol => 'tcp',
445             RemoteAddress => $remoteaddress,
446             RemotePort => $remoteport,
447             SuccessEvent => '_sock_up',
448             FailureEvent => '_sock_failed',
449 3 50       23 ($args{bindaddress} ? (BindAddress => $args{bindaddress}) : ()),
    50          
450             (ip_is_ipv6($remoteaddress) ? (SocketDomain => AF_INET6) : () ),
451             );
452              
453 3 50       1891 if ($wheel) {
454 3         10 $args{wheel} = $wheel;
455 3         16 $self->{connectors}{$wheel->ID()} = \%args;
456             }
457 3         21 return;
458             }
459              
460             sub _sock_failed {
461 0     0   0 my ($kernel, $self, $op, $errno, $errstr, $connector_id)
462             = @_[KERNEL, OBJECT, ARG0..ARG3];
463              
464 0         0 my $ref = delete $self->{connectors}{$connector_id};
465 0         0 delete $ref->{wheel};
466 0         0 $self->send_event("$self->{prefix}socketerr", $ref, $op, $errno, $errstr);
467 0         0 return;
468             }
469              
470             sub _sock_up {
471 3     3   1267 my ($kernel, $self, $socket, $connector_id)
472             = @_[KERNEL, OBJECT, ARG0, ARG3];
473              
474 3         48 my (undef,$peeraddr,$peerport) = getnameinfo( CORE::getpeername( $socket ), NI_NUMERICHOST | NI_NUMERICSERV );
475 3         48 my (undef,$sockaddr,$sockport) = getnameinfo( CORE::getsockname( $socket ), NI_NUMERICHOST | NI_NUMERICSERV );
476              
477 3         18 s!^::ffff:!! for ( $sockaddr, $peeraddr );
478              
479 3         13 my $cntr = delete $self->{connectors}{$connector_id};
480 3 50 66     19 if ($self->{got_ssl} && $cntr->{usessl}) {
481 1         3 eval {
482 1         2 my $ctx = SSLify_ContextCreate( @{ $self->{sslify_options} } );
  1         7  
483 1         130 $socket = POE::Component::SSLify::Client_SSLify($socket,undef,undef,$ctx);
484             };
485 1         239 chomp $@;
486 1 50       5 die "Failed to SSLify client socket: $@" if $@;
487             }
488              
489 3         16 my $stats_filter = POE::Filter::ThruPut->new();
490              
491             my $wheel = POE::Wheel::ReadWrite->new(
492             Handle => $socket,
493             InputEvent => '_conn_input',
494             ErrorEvent => '_conn_error',
495             FlushedEvent => '_conn_flushed',
496             Filter => POE::Filter::Stackable->new(
497 3         57 Filters => [$stats_filter, $self->{filter}],
498             ),
499             );
500              
501 3 50       1126 return if !$wheel;
502 3         14 my $wheel_id = $wheel->ID();
503             my $ref = {
504             wheel => $wheel,
505             peeraddr => $peeraddr,
506             peerport => $peerport,
507             sockaddr => $sockaddr,
508             sockport => $sockport,
509             idle => $cntr->{idle},
510 3         48 antiflood => 0,
511             compress => 0,
512             stats => $stats_filter,
513             _sent => 0,
514             };
515              
516 3         21 $self->{wheels}{$wheel_id} = $ref;
517             $self->send_event(
518             "$self->{prefix}connected",
519             $wheel_id,
520             $peeraddr,
521             $peerport,
522             $sockaddr,
523             $sockport,
524             $cntr->{name},
525 3         37 $stats_filter,
526             );
527 3         450 return;
528             }
529              
530             sub _anti_flood {
531 0     0   0 my ($self, $wheel_id, $input) = @_;
532 0         0 my $current_time = time();
533              
534 0 0 0     0 return if !$wheel_id || !$self->connection_exists($wheel_id) || !$input;
      0        
535              
536             SWITCH: {
537 0 0       0 if ($self->{wheels}->{ $wheel_id }->{flooded}) {
  0         0  
538 0         0 last SWITCH;
539             }
540 0 0 0     0 if (!$self->{wheels}{$wheel_id}{timer}
541             || $self->{wheels}{$wheel_id}{timer} < $current_time) {
542              
543 0         0 $self->{wheels}{$wheel_id}{timer} = $current_time;
544 0         0 my $event = "$self->{prefix}cmd_" . lc $input->{command};
545 0         0 $self->send_event($event, $wheel_id, $input);
546 0         0 last SWITCH;
547             }
548 0 0       0 if ($self->{wheels}{$wheel_id}{timer} <= $current_time + 10) {
549 0         0 $self->{wheels}{$wheel_id}{timer} += 1;
550 0         0 push @{ $self->{wheels}{$wheel_id}{msq} }, $input;
  0         0  
551 0         0 push @{ $self->{wheels}{$wheel_id}{alarm_ids} },
552             $poe_kernel->alarm_set(
553             '_event_dispatcher',
554             $self->{wheels}{$wheel_id}{timer},
555 0         0 $wheel_id
556             );
557 0         0 last SWITCH;
558             }
559              
560 0         0 $self->{wheels}{$wheel_id}{flooded} = 1;
561 0         0 $self->send_event("$self->{prefix}connection_flood", $wheel_id);
562             }
563              
564 0         0 return 1;
565             }
566              
567             sub _conn_error {
568 241     241   27086051 my ($self, $errstr, $wheel_id) = @_[OBJECT, ARG2, ARG3];
569 241 50       1373 return if !$self->connection_exists($wheel_id);
570             $self->_disconnected(
571             $wheel_id,
572             $errstr || $self->{wheels}{$wheel_id}{disconnecting}
573 241   66     2272 );
574 241         72819 return;
575             }
576              
577             sub _conn_alarm {
578 0     0   0 my ($kernel, $self, $wheel_id) = @_[KERNEL, OBJECT, ARG0];
579 0 0       0 return if !$self->connection_exists($wheel_id);
580 0         0 my $conn = $self->{wheels}{$wheel_id};
581              
582             $self->send_event(
583             "$self->{prefix}connection_idle",
584             $wheel_id,
585             $conn->{idle},
586 0         0 );
587             $conn->{alarm} = $kernel->delay_set(
588             '_conn_alarm',
589             $conn->{idle},
590 0         0 $wheel_id,
591             );
592              
593 0         0 return;
594             }
595              
596             sub _conn_flushed {
597 2798     2798   2466048 my ($kernel, $self, $wheel_id) = @_[KERNEL, OBJECT, ARG0];
598 2798 50       9019 return if !$self->connection_exists($wheel_id);
599              
600             {
601 2798         5307 my $sent = $self->{wheels}{$wheel_id}{stats}->send();
  2798         11974  
602 2798         15846 my $tally = $sent - $self->{wheels}{$wheel_id}{_sent};
603 2798         5938 $self->{wheels}{$wheel_id}{_sent} = $sent;
604 2798         6310 $self->{_globalstats}{sent} += $tally;
605             }
606              
607 2798 100       8240 if ($self->{wheels}{$wheel_id}{disconnecting}) {
608             $self->_disconnected(
609             $wheel_id,
610             $self->{wheels}{$wheel_id}{disconnecting},
611 246         2492 );
612 246         86926 return;
613             }
614              
615 2552 100       6792 if ($self->{wheels}{$wheel_id}{compress_pending}) {
616 1         3 delete $self->{wheels}{$wheel_id}{compress_pending};
617 1         6 $self->{wheels}{$wheel_id}{wheel}->get_input_filter()->unshift(
618             POE::Filter::Zlib::Stream->new(),
619             );
620 1         1247 $self->send_event("$self->{prefix}compressed_conn", $wheel_id);
621 1         128 return;
622             }
623 2551         6813 return;
624             }
625              
626             sub _conn_input {
627 3941     3941   101284231 my ($kernel, $self, $input, $wheel_id) = @_[KERNEL, OBJECT, ARG0, ARG1];
628 3941         10091 my $conn = $self->{wheels}{$wheel_id};
629              
630             # We aren't interested if they are disconnecting
631 3941 100       11822 return if $conn->{disconnecting};
632              
633             {
634 3940         6604 require bytes;
  3940         24019  
635 3940         14205 $self->{_globalstats}{recv} += bytes::length($input->{raw_line}) + 2;
636             }
637              
638 3940 50       18651 if ($self->{raw_events}) {
639             $self->send_event(
640             "$self->{prefix}raw_input",
641             $wheel_id,
642             $input->{raw_line},
643 0         0 );
644             }
645 3940         8369 $conn->{msgs}{recv}++;
646 3940         8255 $conn->{seen} = time();
647 3940         15317 $kernel->delay_adjust($conn->{alarm}, $conn->{idle});
648              
649             # TODO: Antiflood code
650 3940 50       1009912 if ($self->antiflood($wheel_id)) {
651 0         0 $self->_anti_flood($wheel_id, $input);
652             }
653             else {
654 3940         14400 my $event = "$self->{prefix}cmd_" . lc $input->{command};
655 3940         14169 $self->send_event($event, $wheel_id, $input);
656             }
657 3940         476498 return;
658             }
659              
660             sub _event_dispatcher {
661 0     0   0 my ($kernel, $self, $wheel_id) = @_[KERNEL, OBJECT, ARG0];
662              
663 0 0 0     0 if (!$self->connection_exists($wheel_id)
664             || $self->{wheels}{$wheel_id}{flooded}) {
665 0         0 return;
666             }
667              
668 0         0 shift @{ $self->{wheels}{$wheel_id}{alarm_ids} };
  0         0  
669 0         0 my $input = shift @{ $self->{wheels}{$wheel_id}{msq} };
  0         0  
670              
671 0 0       0 if ($input) {
672 0         0 my $event = "$self->{prefix}cmd_" . lc $input->{command};
673 0         0 $self->send_event($event, $wheel_id, $input);
674             }
675 0         0 return;
676             }
677              
678             sub send_output {
679 12677     12677 1 33583 my ($self, $output) = splice @_, 0, 2;
680              
681 12677 100 66     54369 if ($output && ref $output eq 'HASH') {
682 12447         27001 for my $id (grep { $self->connection_exists($_) } @_) {
  9219         21483  
683 9140 50       90248 if ($self->{raw_events}) {
684 0         0 my $out = $self->{filter}->put([$output])->[0];
685 0         0 $out =~ s/\015\012$//;
686 0         0 $self->send_event("$self->{prefix}raw_output", $id, $out);
687             }
688 9140         19550 $self->{wheels}{$id}{msgs}{sent}++;
689 9140         30036 $self->{wheels}{$id}{wheel}->put($output);
690             }
691             }
692              
693 12677         1068400 return;
694             }
695              
696             sub _send_output {
697 0     0   0 $_[OBJECT]->send_output(@_[ARG0..$#_]);
698 0         0 return;
699             }
700              
701             sub antiflood {
702 4482     4482 1 11193 my ($self, $wheel_id, $value) = @_;
703              
704 4482 50       12440 return if !$self->connection_exists($wheel_id);
705 4482 50       16170 return 0 if !$self->{antiflood};
706 0 0       0 return $self->{wheels}{$wheel_id}{antiflood} if !defined $value;
707              
708 0 0       0 if (!$value) {
709             # Flush pending messages from that wheel
710 0         0 while (my $alarm_id = shift @{ $self->{wheels}{$wheel_id}{alarm_ids} }) {
  0         0  
711 0         0 $poe_kernel->alarm_remove($alarm_id);
712 0         0 my $input = shift @{ $self->{wheels}{$wheel_id}{msq} };
  0         0  
713              
714 0 0       0 if ($input) {
715 0         0 my $event = "$self->{prefix}cmd_" . lc $input->{command};
716 0         0 $self->send_event($event, $wheel_id, $input);
717             }
718             }
719             }
720              
721 0         0 $self->{wheels}{$wheel_id}{antiflood} = $value;
722 0         0 return;
723             }
724              
725             sub compressed_link {
726 2     2 1 10 my ($self, $wheel_id, $value, $cntr) = @_;
727 2 50       5 return if !$self->connection_exists($wheel_id);
728 2 50       6 return $self->{wheels}{$wheel_id}{compress} if !defined $value;
729              
730 2 50       16 if ($value) {
731 2 50       6 if (!$self->{got_zlib}) {
732 2         5 eval {
733 2         14 require POE::Filter::Zlib::Stream;
734 2         6 $self->{got_zlib} = 1;
735             };
736 2         5 chomp $@;
737 2 50       5 croak($@) if !$self->{got_zlib};
738             }
739 2 100       6 if ($cntr) {
740 1         5 $self->{wheels}{$wheel_id}{wheel}->get_input_filter()->unshift(
741             POE::Filter::Zlib::Stream->new()
742             );
743 1         1019 $self->send_event(
744             "$self->{prefix}compressed_conn",
745             $wheel_id,
746             );
747             }
748             else {
749 1         6 $self->{wheels}{$wheel_id}{compress_pending} = 1;
750             }
751             }
752             else {
753 0         0 $self->{wheels}{$wheel_id}{wheel}->get_input_filter()->shift();
754             }
755              
756 2         125 $self->{wheels}{$wheel_id}{compress} = $value;
757 2         6 return;
758             }
759              
760             sub disconnect {
761 240     240 1 944 my ($self, $wheel_id, $string) = @_;
762 240 50 33     1765 return if !$wheel_id || !$self->connection_exists($wheel_id);
763 240   50     2037 $self->{wheels}{$wheel_id}{disconnecting} = $string || 'Client Quit';
764 240         817 return;
765             }
766              
767             sub _disconnected {
768 487     487   1611 my ($self, $wheel_id, $errstr) = @_;
769 487 50 33     2739 return if !$wheel_id || !$self->connection_exists($wheel_id);
770              
771 487         1777 my $conn = delete $self->{wheels}{$wheel_id};
772 487         1249 for my $alarm_id ($conn->{alarm}, @{ $conn->{alarm_ids} }) {
  487         2686  
773 487         2533 $poe_kernel->alarm_remove($_);
774             }
775             $self->send_event(
776 487   100     14452 "$self->{prefix}disconnected",
777             $wheel_id,
778             $errstr || 'Remote host closed the connection',
779             );
780              
781 487 50       65884 if ( $^O =~ /(cygwin|MSWin)/ ) {
782 0         0 $conn->{wheel}->shutdown_input();
783 0         0 $conn->{wheel}->shutdown_output();
784             }
785              
786 487         4090 return 1;
787             }
788              
789             sub connection_info {
790 0     0 1 0 my ($self, $wheel_id) = @_;
791 0 0       0 return if !$self->connection_exists($wheel_id);
792             return map {
793 0         0 $self->{wheels}{$wheel_id}{$_}
  0         0  
794             } qw(peeraddr peerport sockaddr sockport);
795             }
796              
797             sub connection_exists {
798 17471     17471 1 35275 my ($self, $wheel_id) = @_;
799 17471 100 66     74605 return if !$wheel_id || !defined $self->{wheels}{$wheel_id};
800 17392         49123 return 1;
801             }
802              
803             sub connection_secured {
804 484     484 0 1650 my ($self, $wheel_id) = @_;
805 484 50 33     3319 return if !$wheel_id || !defined $self->{wheels}{$wheel_id};
806 484 100       3158 return if !$self->{wheels}{$wheel_id}{secured};
807 14         44 my $sslinfo = $self->{wheels}{$wheel_id}{sslinfo};
808 14 50       74 if (!$sslinfo) {
809 14         91 my $sock = $self->{wheels}{$wheel_id}{wheel}->get_input_handle();
810 14         119 $sslinfo = _get_ssl_info($sock);
811 14 50       108 $self->{wheels}{$wheel_id}{sslinfo} = $sslinfo
812             if $sslinfo;
813             }
814 14         98 return $sslinfo;
815             }
816              
817             sub connection_certfp {
818 12     12 0 57 my ($self, $wheel_id) = @_;
819 12 50 33     128 return if !$wheel_id || !defined $self->{wheels}{$wheel_id};
820 12 50       56 return if !$self->{wheels}{$wheel_id}{secured};
821 12         104 my $sock = $self->{wheels}{$wheel_id}{wheel}->get_input_handle();
822 12         178 my $fp = eval {
823 12         78 my $ssl = POE::Component::SSLify::SSLify_GetSSL($sock);
824 12         148 my $x509 = Net::SSLeay::get_peer_certificate($ssl);
825 12         487 return Net::SSLeay::X509_get_fingerprint($x509,'sha256');
826             };
827 12 100       143 $fp =~ s!:!!g if $fp;
828 12         77 return $fp;
829             }
830              
831             sub connection_stats {
832 0     0 0 0 my ($self, $wheel_id) = @_;
833 0 0 0     0 return if !$wheel_id || !defined $self->{wheels}{$wheel_id};
834 0         0 return $self->{wheels}{$wheel_id}{stats}->stats();
835             }
836              
837             sub connection_msgs {
838 2     2 0 5 my ($self, $wheel_id) = @_;
839 2 50 33     10 return if !$wheel_id || !defined $self->{wheels}{$wheel_id};
840 2         6 return [ map { $self->{wheels}{$wheel_id}{msgs}{$_} } qw[sent recv] ];
  4         12  
841             }
842              
843             sub _conn_flooded {
844 0     0   0 my $self = shift;
845 0   0     0 my $conn_id = shift || return;
846 0 0       0 return if !$self->connection_exists($conn_id);
847 0         0 return $self->{wheels}{$conn_id}{flooded};
848             }
849              
850             sub add_denial {
851 6     6 1 21 my $self = shift;
852 6   50     49 my $netmask = shift || return;
853 6   50     31 my $reason = shift || 'Denied';
854              
855 6 50       13 if ( ! eval { $netmask->isa('Net::Netmask') } ) {
  6         90  
856 6         27 $netmask = Net::CIDR::cidrvalidate( $netmask );
857             }
858              
859 6 50       3434 if ( !$netmask ) {
860 0         0 carp("Failed to validate netmask");
861 0         0 return;
862             }
863              
864 6         36 $self->{denials}{$netmask} = {
865             blk => $netmask,
866             reason => $reason,
867             };
868 6         19 return 1;
869             }
870              
871             sub del_denial {
872 5     5 1 22 my $self = shift;
873 5   50     23 my $netmask = shift || return;
874 5 50       27 return if !$self->{denials}{$netmask};
875 5         25 delete $self->{denials}{$netmask};
876 5         15 return 1;
877             }
878              
879             sub add_exemption {
880 0     0 1 0 my $self = shift;
881 0   0     0 my $netmask = shift || return;
882              
883 0 0       0 if ( !$netmask->isa('Net::Netmask') ) {
884 0         0 $netmask = Net::CIDR::cidrvalidate( $netmask );
885             }
886              
887 0 0       0 if ( !$netmask ) {
888 0         0 carp("Failed to validate netmask");
889 0         0 return;
890             }
891              
892 0 0       0 if (!$self->{exemptions}{$netmask}) {
893 0         0 $self->{exemptions}{$netmask} = $netmask;
894             }
895 0         0 return 1;
896             }
897              
898             sub del_exemption {
899 0     0 1 0 my $self = shift;
900 0   0     0 my $netmask = shift || return;
901 0 0       0 return if !$self->{exemptions}{$netmask};
902 0         0 delete $self->{exemptions}{$netmask};
903 0         0 return 1;
904             }
905              
906             sub denied {
907 537     537 1 25084 my $self = shift;
908 537   50     2557 my $ipaddr = shift || return;
909 537 50       2687 return if $self->exempted($ipaddr);
910              
911 537         1265 for my $mask (keys %{ $self->{denials} }) {
  537         2232  
912 11 50 33     21 if ( eval { $self->{denials}{$mask}{blk}->isa('Net::Netmask') } && $self->{denials}{$mask}{blk}->match($ipaddr)) {
  11 50       183  
913 0         0 return $self->{denials}{$mask}{reason};
914             }
915             elsif ( Net::CIDR::cidrlookup( $ipaddr, $self->{denials}{$mask}{blk} ) ) {
916 11         3644 return $self->{denials}{$mask}{reason};
917             }
918             }
919              
920 526         2169 return;
921             }
922              
923             sub exempted {
924 537     537 1 1331 my $self = shift;
925 537   50     1859 my $ipaddr = shift || return;
926 537         1253 for my $mask (keys %{ $self->{exemptions} }) {
  537         2673  
927 0 0 0     0 return 1 if $self->{exemptions}{$mask}->isa('Net::Netmask') && $self->{exemptions}{$mask}->match($ipaddr);
928 0 0       0 return 1 if Net::CIDR::cidrlookup( $ipaddr, $self->{exemptions}{$mask} );
929             }
930 537         2124 return;
931             }
932              
933             1;
934              
935             =encoding utf8
936              
937             =head1 NAME
938              
939             POE::Component::Server::IRC::Backend - A POE component class that provides network connection abstraction for POE::Component::Server::IRC
940              
941             =head1 SYNOPSIS
942              
943             package MyIRCD;
944              
945             use strict;
946             use warnings;
947             use base 'POE::Component::Server::IRC::Backend';
948              
949             sub spawn {
950             my ($package, %args) = @_;
951              
952             my $self = $package->create(prefix => 'ircd_', @_);
953              
954             # process %args ...
955              
956             return $self;
957             }
958              
959             =head1 DESCRIPTION
960              
961             POE::Component::Server::IRC::Backend - A POE component class that provides
962             network connection abstraction for
963             L. It uses a
964             plugin system. See
965             L
966             for details.
967              
968             =head1 CONSTRUCTOR
969              
970             =head2 C
971              
972             Returns an object. Accepts the following parameters, all are optional:
973              
974             =over 4
975              
976             =item * B<'alias'>, a POE::Kernel alias to set;
977              
978             =item * B<'auth'>, set to a false value to globally disable IRC
979             authentication, default is auth is enabled;
980              
981             =item * B<'antiflood'>, set to a false value to globally disable flood
982             protection, default is true;
983              
984             =item * B<'prefix'>, this is the prefix that is used to generate event
985             names that the component produces. The default is 'ircd_'.
986              
987             =item * B<'states'>, an array reference of extra objects states for the IRC
988             daemon's POE sessions. The elements can be array references of states
989             as well as hash references of state => handler pairs.
990              
991             =item * B<'plugin_debug'>, set to a true value to print plugin debug info.
992             Default is false.
993              
994             =item * B<'options'>, a hashref of options to L
995              
996             =item * B<'raw_events'>, whether to send L events.
997             False by default. Can be enabled later with L|/raw_events>;
998              
999             =item * B<'sslify_options'>, an array reference of items that are passed
1000             to L C. Used to supply x509 certificate
1001             and key;
1002              
1003             =back
1004              
1005             If the component is created from within another session, that session will
1006             be automagcially registered with the component to receive events and get
1007             an 'ircd_backend_registered' event.
1008              
1009             =head1 METHODS
1010              
1011             =head2 General
1012              
1013             =head3 C
1014              
1015             Takes no arguments. Terminates the component. Removes all listeners and
1016             connectors. Disconnects all current client and server connections. This
1017             is a shorthand for C<< $ircd->yield('shutdown') >>.
1018              
1019             =head3 C
1020              
1021             I>
1022              
1023             Takes no arguments. Returns the ID of the component's session. Ideal for
1024             posting events to the component.
1025              
1026             =head3 C
1027              
1028             I>
1029              
1030             Takes no arguments. Returns the session alias that has been set through
1031             L|/create>'s B<'alias'> argument.
1032              
1033             =head3 C
1034              
1035             I>
1036              
1037             This method provides an alternative object based means of posting events
1038             to the component. First argument is the event to post, following arguments
1039             are sent as arguments to the resultant post.
1040              
1041             =head3 C
1042              
1043             I>
1044              
1045             This method provides an alternative object based means of calling events
1046             to the component. First argument is the event to call, following arguments
1047             are sent as arguments to the resultant call.
1048              
1049             =head3 C
1050              
1051             I>
1052              
1053             This method provides a way of posting delayed events to the component. The
1054             first argument is an arrayref consisting of the delayed command to post and
1055             any command arguments. The second argument is the time in seconds that one
1056             wishes to delay the command being posted.
1057              
1058             Returns an alarm ID that can be used with L|/delay_remove>
1059             to cancel the delayed event. This will be undefined if something went
1060             wrong.
1061              
1062             =head3 C
1063              
1064             I>
1065              
1066             This method removes a previously scheduled delayed event from the
1067             component. Takes one argument, the C that was returned by a
1068             L|/delay> method call.
1069              
1070             Returns an arrayref that was originally requested to be delayed.
1071              
1072             =head3 C
1073              
1074             I>
1075              
1076             Sends an event through the component's event handling system. These will
1077             get processed by plugins then by registered sessions. First argument is
1078             the event name, followed by any parameters for that event.
1079              
1080             =head3 C
1081              
1082             I>
1083              
1084             This sends an event right after the one that's currently being processed.
1085             Useful if you want to generate some event which is directly related to
1086             another event so you want them to appear together. This method can only be
1087             called when POE::Component::IRC is processing an event, e.g. from one of
1088             your event handlers. Takes the same arguments as
1089             L|/send_event>.
1090              
1091             =head3 C
1092              
1093             I>
1094              
1095             This will send an event to be processed immediately. This means that if an
1096             event is currently being processed and there are plugins or sessions which
1097             will receive it after you do, then an event sent with C
1098             will be received by those plugins/sessions I the current event.
1099             Takes the same arguments as L|/send_event>.
1100              
1101             =head3 C
1102              
1103             If called with a true value, raw events (L|/ircd_raw_input>
1104             and L|/ircd_raw_output>) will be enabled.
1105              
1106             =head2 Connections
1107              
1108             =head3 C
1109              
1110             Takes two arguments, a connection id and true/false value. If value is
1111             specified antiflood protection is enabled or disabled accordingly for the
1112             specified connection. If a value is not specified the current status of
1113             antiflood protection is returned. Returns undef on error.
1114              
1115             =head3 C
1116              
1117             Takes two arguments, a connection id and true/false value. If a value is
1118             specified, compression will be enabled or disabled accordingly for the
1119             specified connection. If a value is not specified the current status of
1120             compression is returned. Returns undef on error.
1121              
1122             =head3 C
1123              
1124             Requires on argument, the connection id you wish to disconnect. The
1125             component will terminate the connection the next time that the wheel input
1126             is flushed, so you may send some sort of error message to the client on
1127             that connection. Returns true on success, undef on error.
1128              
1129             =head3 C
1130              
1131             Requires one argument, a connection id. Returns true value if the connection
1132             exists, false otherwise.
1133              
1134             =head3 C
1135              
1136             Takes one argument, a connection_id. Returns a list consisting of: the IP
1137             address of the peer; the port on the peer; our socket address; our socket
1138             port. Returns undef on error.
1139              
1140             my ($peeraddr, $peerport, $sockaddr, $sockport) = $ircd->connection_info($conn_id);
1141              
1142             =head3 C
1143              
1144             Takes one mandatory argument and one optional. The first mandatory
1145             argument is an address or CIDR as understood by L::cidrvalidate that will be used to
1146             check connecting IP addresses against. The second optional argument is a
1147             reason string for the denial.
1148              
1149             =head3 C
1150              
1151             Takes one mandatory argument, an address or CIDR as understood by L::cidrvalidate to
1152             remove from the current denial list.
1153              
1154             =head3 C
1155              
1156             Takes one argument, an IP address. Returns true or false depending on
1157             whether that IP is denied or not.
1158              
1159             =head3 C
1160              
1161             Takes one mandatory argument, an address or CIDR as understood by L::cidrvalidate that
1162             will be checked against connecting IP addresses for exemption from denials.
1163              
1164             =head3 C
1165              
1166             Takes one mandatory argument, an address or CIDR as understood by L::cidrvalidate to
1167             remove from the current exemption list.
1168              
1169             =head3 C
1170              
1171             Takes one argument, an IP address. Returns true or false depending on
1172             whether that IP is exempt from denial or not.
1173              
1174             =head2 Plugins
1175              
1176             =head3 C
1177              
1178             I>
1179              
1180             Returns the L
1181             object.
1182              
1183             =head3 C
1184              
1185             I>
1186              
1187             Accepts two arguments:
1188              
1189             The alias for the plugin
1190             The actual plugin object
1191             Any number of extra arguments
1192              
1193             The alias is there for the user to refer to it, as it is possible to have
1194             multiple plugins of the same kind active in one Object::Pluggable object.
1195              
1196             This method goes through the pipeline's C method, which will call
1197             C<< $plugin->plugin_register($pluggable, @args) >>.
1198              
1199             Returns the number of plugins now in the pipeline if plugin was
1200             initialized, C/an empty list if not.
1201              
1202             =head3 C
1203              
1204             I>
1205              
1206             Accepts the following arguments:
1207              
1208             The alias for the plugin or the plugin object itself
1209             Any number of extra arguments
1210              
1211             This method goes through the pipeline's C method, which will call
1212             C<< $plugin->plugin_unregister($pluggable, @args) >>.
1213              
1214             Returns the plugin object if the plugin was removed, C/an empty list
1215             if not.
1216              
1217             =head3 C
1218              
1219             I>
1220              
1221             Accepts the following arguments:
1222              
1223             The alias for the plugin
1224              
1225             This method goes through the pipeline's C method.
1226              
1227             Returns the plugin object if it was found, C/an empty list if not.
1228              
1229             =head3 C
1230              
1231             I>
1232              
1233             Takes no arguments.
1234              
1235             Returns a hashref of plugin objects, keyed on alias, or an empty list if
1236             there are no plugins loaded.
1237              
1238             =head3 C
1239              
1240             I>
1241              
1242             Takes no arguments.
1243              
1244             Returns an arrayref of plugin objects, in the order which they are
1245             encountered in the pipeline.
1246              
1247             =head3 C
1248              
1249             I>
1250              
1251             Accepts the following arguments:
1252              
1253             The plugin object
1254             The type of the hook (the hook types are specified with _pluggable_init()'s 'types')
1255             The event name[s] to watch
1256              
1257             The event names can be as many as possible, or an arrayref. They correspond
1258             to the prefixed events and naturally, arbitrary events too.
1259              
1260             You do not need to supply events with the prefix in front of them, just the
1261             names.
1262              
1263             It is possible to register for all events by specifying 'all' as an event.
1264              
1265             Returns 1 if everything checked out fine, C/an empty list if
1266             something is seriously wrong.
1267              
1268             =head3 C
1269              
1270             I>
1271              
1272             Accepts the following arguments:
1273              
1274             The plugin object
1275             The type of the hook (the hook types are specified with _pluggable_init()'s 'types')
1276             The event name[s] to unwatch
1277              
1278             The event names can be as many as possible, or an arrayref. They correspond
1279             to the prefixed events and naturally, arbitrary events too.
1280              
1281             You do not need to supply events with the prefix in front of them, just the
1282             names.
1283              
1284             It is possible to register for all events by specifying 'all' as an event.
1285              
1286             Returns 1 if all the event name[s] was unregistered, undef if some was not
1287             found.
1288              
1289             =head1 INPUT EVENTS
1290              
1291             These are POE events that the component will accept:
1292              
1293             =head2 C
1294              
1295             I>
1296              
1297             Takes N arguments: a list of event names that your session wants to listen
1298             for, minus the C prefix.
1299              
1300             $ircd->yield('register', qw(connected disconnected));
1301              
1302             The special argument 'all' will register your session for all events.
1303             Registering will generate an L|/ircd_registered>
1304             event that your session can trap.
1305              
1306             =head2 C
1307              
1308             I>
1309              
1310             Takes N arguments: a list of event names which you I want to
1311             receive. If you've previously done a L|/register>
1312             for a particular event which you no longer care about, this event will
1313             tell the component to stop sending them to you. (If you haven't, it just
1314             ignores you. No big deal.)
1315              
1316             If you have registered with 'all', attempting to unregister individual
1317             events such as 'connected', etc. will not work. This is a 'feature'.
1318              
1319             =head2 C
1320              
1321             Takes a number of arguments. Adds a new listener.
1322              
1323             =over 4
1324              
1325             =item * B<'port'>, the TCP port to listen on. Default is a random port;
1326              
1327             =item * B<'auth'>, enable or disable auth sub-system for this listener.
1328             Enabled by default;
1329              
1330             =item * B<'bindaddr'>, specify a local address to bind the listener to;
1331              
1332             =item * B<'listenqueue'>, change the SocketFactory's ListenQueue;
1333              
1334             =item * B<'usessl'>, whether the listener should use SSL. Default is
1335             false;
1336              
1337             =item * B<'antiflood'>, whether the listener should use flood protection.
1338             Defaults is true;
1339              
1340             =item * B<'idle'>, the time, in seconds, after which a connection will be
1341             considered idle. Defaults is 180.
1342              
1343             =back
1344              
1345             =head2 C
1346              
1347             Takes one of the following arguments:
1348              
1349             =over 4
1350              
1351             =item * B<'listener'>, a previously returned listener ID;
1352              
1353             =item * B<'port'>, a listening port;
1354              
1355             =back
1356              
1357             The listener will be deleted. Note: any connected clients on that port
1358             will not be disconnected.
1359              
1360             =head2 C
1361              
1362             Takes two mandatory arguments, B<'remoteaddress'> and B<'remoteport'>.
1363             Opens a TCP connection to specified address and port.
1364              
1365             =over 4
1366              
1367             =item * B<'remoteaddress'>, hostname or IP address to connect to;
1368              
1369             =item * B<'remoteport'>, the TCP port on the remote host;
1370              
1371             =item * B<'bindaddress'>, a local address to bind from (optional);
1372              
1373             =item * B<'idle'>, the time, in seconds, after which a connection will be
1374             considered idle. Defaults is 180;
1375              
1376             =item * B<'usessl'>, whether the connection should use SSL. Default is
1377             false;
1378              
1379             =back
1380              
1381             =head2 C
1382              
1383             Takes a hashref and one or more connection IDs.
1384              
1385             $ircd->yield(
1386             'send_output',
1387             {
1388             prefix => 'blah!~blah@blah.blah.blah',
1389             command => 'PRIVMSG',
1390             params => ['#moo', 'cows go moo, not fish :D']
1391             },
1392             @list_of_connection_ids,
1393             );
1394              
1395             =head2 C
1396              
1397             I>
1398              
1399             Takes no arguments. Terminates the component. Removes all listeners and
1400             connectors. Disconnects all current client and server connections.
1401              
1402             =head1 OUTPUT EVENTS
1403              
1404             These following events are sent to interested sessions.
1405              
1406             =head2 C
1407              
1408             I>
1409              
1410             =over
1411              
1412             =item Emitted: when a session registers with the component;
1413              
1414             =item Target: the registering session;
1415              
1416             =item Args:
1417              
1418             =over 4
1419              
1420             =item * C: the component's object;
1421              
1422             =back
1423              
1424             =back
1425              
1426             =head2 C
1427              
1428             =over
1429              
1430             =item Emitted: when a client connects to one of the component's listeners;
1431              
1432             =item Target: all plugins and registered sessions
1433              
1434             =item Args:
1435              
1436             =over 4
1437              
1438             =item * C: the conn id;
1439              
1440             =item * C: their ip address;
1441              
1442             =item * C: their tcp port;
1443              
1444             =item * C: our ip address;
1445              
1446             =item * C: our socket port;
1447              
1448             =item * C: a boolean indicating whether the client needs to be authed
1449              
1450             =item * C: a boolean indicating whether the client is securely connected
1451              
1452             =back
1453              
1454             =back
1455              
1456             =head2 C
1457              
1458             =over
1459              
1460             =item Emitted: after a client has connected and the component has validated
1461             hostname and ident;
1462              
1463             =item Target: Target: all plugins and registered sessions;
1464              
1465             =item Args:
1466              
1467             =over 4
1468              
1469             =item * C, the connection id;
1470              
1471             =item * C, a HASHREF with the following keys: 'ident' and 'hostname';
1472              
1473             =back
1474              
1475             =back
1476              
1477             =head2 C
1478              
1479             =over
1480              
1481             =item Emitted: on a successful L|/add_listener> call;
1482              
1483             =item Target: all plugins and registered sessions;
1484              
1485             =item Args:
1486              
1487             =over 4
1488              
1489             =item * C, the listening port;
1490              
1491             =item * C, the listener id;
1492              
1493             =item * C, the listening address;
1494              
1495             =item * C, whether SSL is in use;
1496              
1497             =back
1498              
1499             =back
1500              
1501             =head2 C
1502              
1503             =over
1504              
1505             =item Emitted: on a successful L|/del_listener> call;
1506              
1507             =item Target: all plugins and registered sessions;
1508              
1509             =item Args:
1510              
1511             =over 4
1512              
1513             =item * C, the listening port;
1514              
1515             =item * C, the listener id;
1516              
1517             =item * C, the listener address;
1518              
1519             =back
1520              
1521             =back
1522              
1523             =head2 C
1524              
1525             =over
1526              
1527             =item Emitted: when a listener wheel fails;
1528              
1529             =item Target: all plugins and registered sessions;
1530              
1531             =item Args:
1532              
1533             =over 4
1534              
1535             =item * C, the listener id;
1536              
1537             =item * C, the name of the operation that failed;
1538              
1539             =item * C, numeric value for $!;
1540              
1541             =item * C, string value for $!;
1542              
1543             =item * C, the port it tried to listen on;
1544              
1545             =item * C, the address it tried to listen on;
1546              
1547             =back
1548              
1549             =back
1550              
1551             =head2 C
1552              
1553             =over
1554              
1555             =item Emitted: on the failure of an L|/add_connector> call
1556              
1557             =item Target: all plugins and registered sessions;
1558              
1559             =item Args:
1560              
1561             =over 4
1562              
1563             =item * C, a HASHREF containing the params that add_connector() was
1564             called with;
1565              
1566             =item * C, the name of the operation that failed;
1567              
1568             =item * C, numeric value for $!;
1569              
1570             =item * C, string value for $!;
1571              
1572             =back
1573              
1574             =back
1575              
1576             =head2 C
1577              
1578             =over
1579              
1580             =item Emitted: when the component establishes a connection with a peer;
1581              
1582             =item Target: all plugins and registered sessions;
1583              
1584             =item Args:
1585              
1586             =over 4
1587              
1588             =item * C, the connection id;
1589              
1590             =item * C, their ip address;
1591              
1592             =item * C, their tcp port;
1593              
1594             =item * C, our ip address;
1595              
1596             =item * C, our socket port;
1597              
1598             =item * C, the peer's name;
1599              
1600             =back
1601              
1602             =back
1603              
1604             =head2 C
1605              
1606             =over
1607              
1608             =item Emitted: when a client connection is flooded;
1609              
1610             =item Target: all plugins and registered sessions;
1611              
1612             =item Args:
1613              
1614             =over 4
1615              
1616             =item * C, the connection id;
1617              
1618             =back
1619              
1620             =back
1621              
1622             =head2 C
1623              
1624             =over
1625              
1626             =item Emitted: when a client connection has not sent any data for a set
1627             period;
1628              
1629             =item Target: all plugins and registered sessions;
1630              
1631             =item Args:
1632              
1633             =over 4
1634              
1635             =item * C, the connection id;
1636              
1637             =item * C, the number of seconds period we consider as idle;
1638              
1639             =back
1640              
1641             =back
1642              
1643             =head2 C
1644              
1645             =over
1646              
1647             =item Emitted: when compression has been enabled for a connection
1648              
1649             =item Target: all plugins and registered sessions;
1650              
1651             =item Args:
1652              
1653             =over 4
1654              
1655             =item * C, the connection id;
1656              
1657             =back
1658              
1659             =back
1660              
1661             =head2 C
1662              
1663             =over
1664              
1665             =item Emitted: when a client or peer sends a valid IRC line to us;
1666              
1667             =item Target: all plugins and registered sessions;
1668              
1669             =item Args:
1670              
1671             =over 4
1672              
1673             =item * C, the connection id;
1674              
1675             =item * C, a HASHREF containing the output record from
1676             POE::Filter::IRCD:
1677              
1678             {
1679             prefix => 'blah!~blah@blah.blah.blah',
1680             command => 'PRIVMSG',
1681             params => [ '#moo', 'cows go moo, not fish :D' ],
1682             raw_line => ':blah!~blah@blah.blah.blah.blah PRIVMSG #moo :cows go moo, not fish :D'
1683             }
1684              
1685             =back
1686              
1687             =back
1688              
1689             =head2 C
1690              
1691             =over
1692              
1693             =item Emitted: when a line of input is received from a connection
1694              
1695             =item Target: all plugins and registered sessions;
1696              
1697             =item Args:
1698              
1699             =over 4
1700              
1701             =item * C, the connection id;
1702              
1703             =item * C, the raw line of input
1704              
1705             =back
1706              
1707             =back
1708              
1709             =head2 C
1710              
1711             =over
1712              
1713             =item Emitted: when a line of output is sent over a connection
1714              
1715             =item Target: all plugins and registered sessions;
1716              
1717             =item Args:
1718              
1719             =over 4
1720              
1721             =item * C, the connection id;
1722              
1723             =item * C, the raw line of output
1724              
1725             =back
1726              
1727             =back
1728              
1729             =head2 C
1730              
1731             =over
1732              
1733             =item Emitted: when a client disconnects;
1734              
1735             =item Target: all plugins and registered sessions;
1736              
1737             =item Args:
1738              
1739             =over 4
1740              
1741             =item * C, the connection id;
1742              
1743             =item * C, the error or reason for disconnection;
1744              
1745             =back
1746              
1747             =back
1748              
1749             =head2 C
1750              
1751             I>
1752              
1753             =over
1754              
1755             =item Emitted: when the component has been asked to L|/shutdown>
1756              
1757             =item Target: all registered sessions;
1758              
1759             =item Args:
1760              
1761             =over 4
1762              
1763             =item * C: the session ID of the requesting component
1764              
1765             =back
1766              
1767             =back
1768              
1769             =head2 C
1770              
1771             I>
1772              
1773             =over
1774              
1775             =item Emitted: on a successful addition of a delayed event using the
1776             L|/delay> method
1777              
1778             =item Target: all plugins and registered sessions;
1779              
1780             =item Args:
1781              
1782             =over 4
1783              
1784             =item * C: the alarm id which can be used later with
1785             L|/delay_remove>
1786              
1787             =item * C: subsequent arguments are those which were passed to
1788             L|/delay>
1789              
1790             =back
1791              
1792             =back
1793              
1794             =head2 C
1795              
1796             I>
1797              
1798             =over
1799              
1800             =item Emitted: when a delayed command is successfully removed
1801              
1802             =item Target: all plugins and registered sessions;
1803              
1804             =item Args:
1805              
1806             =over 4
1807              
1808             =item * C: the alarm id which was removed
1809              
1810             =item * C: subsequent arguments are those which were passed to
1811             L|/delay>
1812              
1813             =back
1814              
1815             =back
1816              
1817             =head2 C
1818              
1819             I>
1820              
1821             =over
1822              
1823             =item Emitted: when a new plugin is added to the pipeline
1824              
1825             =item Target: all plugins and registered sessions;
1826              
1827             =item Args:
1828              
1829             =over 4
1830              
1831             =item * C: the plugin alias
1832              
1833             =item * C: the plugin object
1834              
1835             =back
1836              
1837             =back
1838              
1839             =head2 C
1840              
1841             I>
1842              
1843             =over
1844              
1845             =item Emitted: when a plugin is removed from the pipeline
1846              
1847             =item Target: all plugins and registered sessions;
1848              
1849             =item Args:
1850              
1851             =over 4
1852              
1853             =item * C: the plugin alias
1854              
1855             =item * C: the plugin object
1856              
1857             =back
1858              
1859             =back
1860              
1861             =head2 C
1862              
1863             I>
1864              
1865             =over
1866              
1867             =item Emitted: when an error occurs while executing a plugin handler
1868              
1869             =item Target: all plugins and registered sessions;
1870              
1871             =item Args:
1872              
1873             =over 4
1874              
1875             =item * C: the error message
1876              
1877             =item * C: the plugin alias
1878              
1879             =item * C: the plugin object
1880              
1881             =back
1882              
1883             =back
1884              
1885             =head1 AUTHOR
1886              
1887             Chris 'BinGOs' Williams
1888              
1889             =head1 LICENSE
1890              
1891             Copyright E Chris Williams
1892              
1893             This module may be used, modified, and distributed under the same terms as
1894             Perl itself. Please see the license that came with your Perl distribution
1895             for details.
1896              
1897             =head1 SEE ALSO
1898              
1899             L
1900              
1901             L
1902              
1903             L
1904              
1905             =cut