File Coverage

blib/lib/POE/Component/Server/IRC.pm
Criterion Covered Total %
statement 5487 7730 70.9
branch 1959 3674 53.3
condition 1019 2415 42.1
subroutine 248 295 84.0
pod 46 67 68.6
total 8759 14181 61.7


line stmt bran cond sub pod time code
1             package POE::Component::Server::IRC;
2             our $AUTHORITY = 'cpan:BINGOS';
3             $POE::Component::Server::IRC::VERSION = '1.61'; # TRIAL
4 182     182   36268023 use strict;
  182         1953  
  182         7243  
5 182     182   1085 use warnings;
  182         414  
  182         6085  
6 182     182   1039 use Carp qw(carp croak);
  182         467  
  182         12546  
7 182         26429 use IRC::Utils qw(uc_irc parse_mode_line unparse_mode_line normalize_mask
8             matches_mask matches_mask_array gen_mode_change is_valid_nick_name
9 182     182   102344 is_valid_chan_name has_color has_formatting parse_user);
  182         3503177  
10 182     182   1903 use List::Util qw(sum);
  182         433  
  182         12090  
11 182     182   9185 use POE;
  182         493894  
  182         1429  
12 182     182   1006036 use POE::Component::Server::IRC::Common qw(chkpasswd);
  182         557  
  182         12278  
13 182     182   89475 use POE::Component::Server::IRC::Plugin qw(:ALL);
  182         511  
  182         25737  
14 182     182   1294 use POSIX 'strftime';
  182         474  
  182         2987  
15 182     182   114758 use Net::CIDR ();
  182         1054959  
  182         7036  
16 182     182   1665 use base qw(POE::Component::Server::IRC::Backend);
  182         465  
  182         131960  
17              
18             my $sid_re = qr/^[0-9][A-Z0-9][A-Z0-9]$/;
19             my $id_re = qr/^[A-Z][A-Z0-9][A-Z0-9][A-Z0-9][A-Z0-9][A-Z0-9]$/;
20             my $uid_re = qr/^[0-9][A-Z0-9][A-Z0-9][A-Z][A-Z0-9][A-Z0-9][A-Z0-9][A-Z0-9][A-Z0-9]$/;
21             my $host_re = qr/^[^.:][A-Za-z0-9.:-]+$/;
22             my $user_re = qr/^[^\x2D][\x24\x2D-\x39\x41-\x7E]+$/;
23              
24             sub spawn {
25 181     181 1 82938 my ($package, %args) = @_;
26 181         2037 $args{lc $_} = delete $args{$_} for keys %args;
27 181         691 my $config = delete $args{config};
28 181         576 my $debug = delete $args{debug};
29             my $self = $package->create(
30             ($debug ? (raw_events => 1) : ()),
31             %args,
32             states => [
33             [qw(add_spoofed_nick del_spoofed_nick _state_drkx_line_alarm _daemon_do_safelist)],
34             {
35 181 50       1854 map { +"daemon_cmd_$_" => '_spoofed_command' }
  3982         12796  
36             qw(join part mode kick topic nick privmsg notice xline unxline resv unresv
37             rkline unrkline kline unkline sjoin locops wallops globops dline undline)
38             },
39             ],
40             );
41              
42 181 100       2814 $self->configure($config ? $config : ());
43 181         518 $self->{debug} = $debug;
44 181         1282 $self->_state_create();
45 181         947 return $self;
46             }
47              
48             sub IRCD_connection {
49 524     524 0 1027954 my ($self, $ircd) = splice @_, 0, 2;
50 524         1476 pop @_;
51             my ($conn_id, $peeraddr, $peerport, $sockaddr, $sockport, $needs_auth, $secured, $filter)
52 524         1554 = map { ${ $_ } } @_;
  4192         5724  
  4192         8883  
53              
54 524 50       2700 if ($self->_connection_exists($conn_id)) {
55 0         0 delete $self->{state}{conns}{$conn_id};
56             }
57              
58 524         2235 $self->{state}{conns}{$conn_id}{registered} = 0;
59 524         1704 $self->{state}{conns}{$conn_id}{type} = 'u';
60 524         1763 $self->{state}{conns}{$conn_id}{seen} = time();
61 524         1620 $self->{state}{conns}{$conn_id}{conn_time} = time();
62 524         1488 $self->{state}{conns}{$conn_id}{secured} = $secured;
63 524         1931 $self->{state}{conns}{$conn_id}{stats} = $filter;
64             $self->{state}{conns}{$conn_id}{socket}
65 524         2102 = [$peeraddr, $peerport, $sockaddr, $sockport];
66              
67 524         2808 $self->_state_conn_stats();
68              
69 524 100       2212 if (!$needs_auth) {
70             $self->{state}{conns}{$conn_id}{auth} = {
71 523         3384 hostname => '',
72             ident => '',
73             };
74 523         2460 $self->_client_register($conn_id);
75             }
76              
77 524         2209 return PCSI_EAT_CLIENT;
78             }
79              
80             sub IRCD_connected {
81 3     3 0 651 my ($self, $ircd) = splice @_, 0, 2;
82 3         16 pop @_;
83             my ($conn_id, $peeraddr, $peerport, $sockaddr, $sockport, $name, $filter)
84 3         9 = map { ${ $_ } } @_;
  21         28  
  21         44  
85              
86 3 50       11 if ($self->_connection_exists($conn_id)) {
87 0         0 delete $self->{state}{conns}{$conn_id};
88             }
89              
90 3         14 $self->{state}{conns}{$conn_id}{peer} = $name;
91 3         9 $self->{state}{conns}{$conn_id}{registered} = 0;
92 3         18 $self->{state}{conns}{$conn_id}{cntr} = 1;
93 3         23 $self->{state}{conns}{$conn_id}{type} = 'u';
94 3         10 $self->{state}{conns}{$conn_id}{seen} = time();
95 3         7 $self->{state}{conns}{$conn_id}{conn_time} = time();
96 3         9 $self->{state}{conns}{$conn_id}{stats} = $filter;
97             $self->{state}{conns}{$conn_id}{socket}
98 3         16 = [$peeraddr, $peerport, $sockaddr, $sockport];
99              
100 3         13 $self->_state_conn_stats();
101 3         21 $self->_state_send_credentials($conn_id, $name);
102 3         13 return PCSI_EAT_CLIENT;
103             }
104              
105             sub IRCD_connection_flood {
106 0     0 0 0 my ($self, $ircd) = splice @_, 0, 2;
107 0         0 pop @_;
108 0         0 my ($conn_id) = map { ${ $_ } } @_;
  0         0  
  0         0  
109 0         0 $self->_terminate_conn_error($conn_id, 'Excess Flood');
110 0         0 return PCSI_EAT_CLIENT;
111             }
112              
113             sub IRCD_connection_idle {
114 0     0 0 0 my ($self, $ircd) = splice @_, 0, 2;
115 0         0 pop @_;
116 0         0 my ($conn_id, $interval) = map { ${ $_ } } @_;
  0         0  
  0         0  
117 0 0       0 return PCSI_EAT_NONE if !$self->_connection_exists($conn_id);
118              
119 0         0 my $conn = $self->{state}{conns}{$conn_id};
120 0 0       0 if ($conn->{type} eq 'u') {
121 0         0 $self->_terminate_conn_error($conn_id, 'Connection Timeout');
122 0         0 return PCSI_EAT_CLIENT;
123             }
124              
125 0 0       0 if ($conn->{pinged}) {
126 0         0 my $msg = 'Ping timeout: '.(time - $conn->{seen}).' seconds';
127 0         0 $self->_terminate_conn_error($conn_id, $msg);
128 0         0 return PCSI_EAT_CLIENT;
129             }
130              
131 0         0 $conn->{pinged} = 1;
132 0         0 $self->send_output(
133             {
134             command => 'PING',
135             params => [$self->server_name()],
136             },
137             $conn_id,
138             );
139 0         0 return PCSI_EAT_CLIENT;
140             }
141              
142             sub IRCD_auth_done {
143 1     1 0 248 my ($self, $ircd) = splice @_, 0, 2;
144 1         7 pop @_;
145 1         3 my ($conn_id, $ref) = map { ${ $_ } } @_;
  2         2  
  2         8  
146 1 50       5 return PCSI_EAT_CLIENT if !$self->_connection_exists($conn_id);
147              
148 1         5 $self->{state}{conns}{$conn_id}{auth} = $ref;
149 1         14 $self->_client_register($conn_id);
150 1         4 return PCSI_EAT_CLIENT;
151             }
152              
153             sub IRCD_disconnected {
154 487     487 0 394155 my ($self, $ircd) = splice @_, 0, 2;
155 487         1208 pop @_;
156 487         1322 my ($conn_id, $errstr) = map { ${ $_ } } @_;
  974         1626  
  974         3009  
157 487 50       2124 return PCSI_EAT_CLIENT if !$self->_connection_exists($conn_id);
158              
159 487 100       1945 if ($self->_connection_is_peer($conn_id)) {
    100          
160 227         852 my $peer = $self->{state}{conns}{$conn_id}{sid};
161             $self->send_output(
162 227         825 @{ $self->_daemon_peer_squit($conn_id, $peer, $errstr) }
  227         1358  
163             );
164             }
165             elsif ($self->_connection_is_client($conn_id)) {
166             $self->send_output(
167 217         651 @{ $self->_daemon_cmd_quit(
  217         1150  
168             $self->_client_nickname($conn_id,$errstr ),
169             $errstr,
170             )}
171             );
172             }
173              
174 487         6804 delete $self->{state}{conns}{$conn_id};
175 487         1979 return PCSI_EAT_CLIENT;
176             }
177              
178             sub IRCD_compressed_conn {
179 2     2 0 462 my ($self, $ircd) = splice @_, 0, 2;
180 2         5 pop @_;
181 2         5 my ($conn_id) = map { ${ $_ } } @_;
  2         2  
  2         8  
182 2         9 $self->_state_send_burst($conn_id);
183 2         6 return PCSI_EAT_CLIENT;
184             }
185              
186             sub IRCD_raw_input {
187 0     0 0 0 my ($self, $ircd) = splice @_, 0, 2;
188 0 0       0 return PCSI_EAT_CLIENT if !$self->{debug};
189 0         0 my $conn_id = ${ $_[0] };
  0         0  
190 0         0 my $input = ${ $_[1] };
  0         0  
191 0         0 warn "<<< $conn_id: $input\n";
192 0         0 return PCSI_EAT_CLIENT;
193             }
194              
195             sub IRCD_raw_output {
196 0     0 0 0 my ($self, $ircd) = splice @_, 0, 2;
197 0 0       0 return PCSI_EAT_CLIENT if !$self->{debug};
198 0         0 my $conn_id = ${ $_[0] };
  0         0  
199 0         0 my $output = ${ $_[1] };
  0         0  
200 0         0 warn ">>> $conn_id: $output\n";
201 0         0 return PCSI_EAT_CLIENT;
202             }
203              
204             sub _default {
205 13396     13396   4354487 my ($self, $ircd, $event) = splice @_, 0, 3;
206 13396 100       55335 return PCSI_EAT_NONE if $event !~ /^IRCD_cmd_/;
207 4159         8310 pop @_;
208 4159         9145 my ($conn_id, $input) = map { $$_ } @_;
  8318         21109  
209              
210 4159 50       12365 return PCSI_EAT_CLIENT if !$self->_connection_exists($conn_id);
211 4159 100       10719 return PCSI_EAT_CLIENT if $self->_connection_terminated($conn_id);
212 4138         10757 $self->{state}{conns}{$conn_id}{seen} = time;
213              
214 4138 100       11224 if (!$self->_connection_registered($conn_id)) {
    100          
    50          
215 1433         4556 $self->_cmd_from_unknown($conn_id, $input);
216             }
217             elsif ($self->_connection_is_peer($conn_id)) {
218 1904         5380 $self->_cmd_from_peer($conn_id, $input);
219             }
220             elsif ($self->_connection_is_client($conn_id)) {
221 801         1990 delete $input->{prefix};
222 801         3794 $self->_cmd_from_client($conn_id, $input);
223             }
224              
225 4138         14432 return PCSI_EAT_CLIENT;
226             }
227              
228             sub _auth_finished {
229 245     245   686 my $self = shift;
230 245   50     1105 my $conn_id = shift || return;
231 245 50       951 return if !$self->_connection_exists($conn_id);
232 245         898 return $self->{state}{conns}{$conn_id}{auth};
233             }
234              
235             sub _connection_exists {
236 23069     23069   36451 my $self = shift;
237 23069   50     47669 my $conn_id = shift || return;
238 23069 100       55007 return if !defined $self->{state}{conns}{$conn_id};
239 22541         54278 return 1;
240             }
241              
242             sub _connection_terminated {
243 4673     4673   8095 my $self = shift;
244 4673   50     11049 my $conn_id = shift || return;
245 4673 50       11653 return if !defined $self->{state}{conns}{$conn_id};
246 4673 100       18452 return 1 if defined $self->{state}{conns}{$conn_id}{terminated};
247             }
248              
249             sub _client_register {
250 1064     1064   2364 my $self = shift;
251 1064   50     3148 my $conn_id = shift || return;
252 1064 50       2764 return if !$self->_connection_exists($conn_id);
253 1064 100       4277 return if !$self->{state}{conns}{$conn_id}{nick};
254 501 100       1875 return if !$self->{state}{conns}{$conn_id}{user};
255 255 100       1435 return if $self->{state}{conns}{$conn_id}{capneg};
256 245         1305 my $server = $self->server_name();
257              
258 245         1329 my $auth = $self->_auth_finished($conn_id);
259 245 50       1048 return if !$auth;
260             # pass required for link
261 245 100       1562 if (!$self->_state_auth_client_conn($conn_id)) {
262 5         17 my $crec = $self->{state}{conns}{$conn_id};
263             $self->_send_to_realops(
264             sprintf(
265             'Unauthorized client connection from %s!%s@%s on [%s/%u].',
266             $crec->{nick}, $crec->{user}, $crec->{socket}[0],
267 5         64 $crec->{socket}[2], $crec->{socket}[3],
268             ),
269             'Notice', 'u',
270             );
271 5         24 $self->_terminate_conn_error(
272             $conn_id,
273             'You are not authorized to use this server',
274             );
275 5         13 return;
276             }
277 240 100       1126 if ($self->{auth}) {
278 1 50 33     14 if ( $self->{state}{conns}{$conn_id}{need_ident} &&
279             !$self->{state}{conns}{$conn_id}{auth}{ident} ) {
280 1         22 $self->_send_output_to_client(
281             $conn_id,
282             {
283             prefix => $server,
284             command => 'NOTICE',
285             params => [
286             '*',
287             '*** Notice -- You need to install identd to use this server',
288             ],
289             },
290             );
291 1         23 $self->_terminate_conn_error(
292             $conn_id,
293             'Install identd',
294             );
295 1         2 return;
296             }
297             }
298 239 100       1333 if (my $reason = $self->_state_user_matches_xline($conn_id)) {
299 5         20 my $crec = $self->{state}{conns}{$conn_id};
300             $self->_send_to_realops(
301             sprintf(
302             'X-line Rejecting [%s] [%s], user %s!%s@%s [%s]',
303             $crec->{ircname}, $reason,
304             $crec->{nick}, $crec->{user},
305             ( $crec->{auth}{hostname} || $crec->{socket}[0] ),
306 5   33     105 $crec->{socket}[0],
307             ),
308             'Notice',
309             'j',
310             );
311 5         28 $self->_send_output_to_client( $conn_id, '465' );
312 5         37 $self->_terminate_conn_error($conn_id, "X-Lined: [$reason]");
313 5         13 return;
314             }
315 234 100       1247 if (my $reason = $self->_state_user_matches_kline($conn_id)) {
316 5         43 $self->_send_output_to_client( $conn_id, '465' );
317 5         38 $self->_terminate_conn_error($conn_id, "K-Lined: [$reason]");
318 5         15 return;
319             }
320 229 100       1307 if (my $reason = $self->_state_user_matches_rkline($conn_id)) {
321 2         11 $self->_send_output_to_client( $conn_id, '465' );
322 2         12 $self->_terminate_conn_error($conn_id, "K-Lined: [$reason]");
323 2         58 return;
324             }
325              
326 227 50 66     4082 if ( !$self->{state}{conns}{$conn_id}{auth}{ident} &&
327             $self->{state}{conns}{$conn_id}{user} !~ $user_re ) {
328 0         0 my $crec = $self->{state}{conns}{$conn_id};
329             $self->_send_to_realops(
330             sprintf(
331             'Invalid username: %s (%s@%s)',
332             $crec->{nick}, $crec->{user},
333 0   0     0 ( $crec->{auth}{hostname} || $crec->{socket}[0] ),
334             ),
335             'Notice',
336             'j',
337             );
338             $self->_terminate_conn_error(
339             $conn_id,
340             sprintf(
341             'Invalid username [%s]', $crec->{user},
342 0         0 ),
343             );
344 0         0 return;
345             }
346              
347 227         653 my $clients = keys %{ $self->{state}{sids}{$self->server_sid()}{uids} };
  227         1389  
348 227 50       1491 if ( $self->{config}{MAXCLIENTS} < $clients + 1 ) {
349 0         0 my $crec = $self->{state}{conns}{$conn_id};
350 0 0       0 if (!$crec->{exceed_limit}) {
351 0         0 $self->_terminate_conn_error($conn_id,
352             'Sorry, server is full - try later');
353 0         0 return;
354             }
355             }
356              
357             # Add new nick
358 227         1453 my $uid = $self->_state_register_client($conn_id);
359 227         888 my $umode = $self->{state}{conns}{$conn_id}{umode};
360 227         1103 my $nick = $self->_client_nickname($conn_id);
361 227         867 my $port = $self->{state}{conns}{$conn_id}{socket}[3];
362 227         1027 my $version = $self->server_version();
363 227         965 my $network = $self->server_config('NETWORK');
364 227         1202 my $server_is = "$server\[$server/$port]";
365              
366 227 100       1647 if (my $sslinfo = $self->connection_secured($conn_id)) {
367 8         86 $self->_send_output_to_client(
368             $conn_id,
369             {
370             prefix => $server,
371             command => 'NOTICE',
372             params => [
373             $nick,
374             "*** Connected securely via $sslinfo",
375             ],
376             },
377             );
378             }
379              
380 227         1481 $self->_state_auth_flags_notices($conn_id);
381              
382 227         3161 $self->_send_output_to_client(
383             $conn_id,
384             {
385             prefix => $server,
386             command => '001',
387             params => [
388             $nick,
389             "Welcome to the $network Internet Relay Chat network $nick"
390             ],
391             }
392             );
393 227         2388 $self->_send_output_to_client(
394             $conn_id,
395             {
396             prefix => $server,
397             command => '002',
398             params => [
399             $nick,
400             "Your host is $server_is, running version $version",
401             ],
402             },
403             );
404 227         1466 $self->_send_output_to_client(
405             $conn_id,
406             {
407             prefix => $server,
408             command => '003',
409             params => [$nick, $self->server_created()],
410             },
411             );
412 227         2139 $self->_send_output_to_client(
413             $conn_id,
414             {
415             prefix => $server,
416             command => '004',
417             colonify => 0,
418             params => [
419             $nick,
420             $server,
421             $version,
422             'DFGHRSWXabcdefgijklnopqrsuwy',
423             'biklmnopstveIh',
424             'bkloveIh',
425             ],
426             }
427             );
428              
429 227         771 for my $output (@{ $self->_daemon_do_isupport($uid) }) {
  227         1685  
430 454         1216 $output->{prefix} = $server;
431 454         1059 $output->{params}[0] = $nick;
432 454         1589 $self->_send_output_to_client($conn_id, $output);
433             }
434              
435 227         1264 $self->{state}{conns}{$conn_id}{registered} = 1;
436 227         872 $self->{state}{conns}{$conn_id}{type} = 'c';
437              
438 227         571 $self->send_output( $_, $conn_id ) for
439 1352         2261 map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  1352         2214  
  1352         3426  
440 227         1383 @{ $self->_daemon_do_lusers($uid) };
441              
442              
443 227         1441 $self->send_output( $_, $conn_id ) for
444 227         788 map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  227         591  
  227         1465  
445 227         1249 @{ $self->_daemon_do_motd($uid) };
446              
447 227 100       1215 if ( $umode ) {
448             $self->send_output(
449             {
450 8         158 prefix => $self->{state}{uids}{$uid}{full}->(),
451             command => 'MODE',
452             params => [ $nick, "+$umode" ],
453             },
454             $conn_id,
455             );
456             }
457              
458             $self->send_event(
459 227         2094 'cmd_mode',
460             $conn_id,
461             {
462             command => 'MODE',
463             params => [$nick, "+i"],
464             },
465             );
466              
467 227         33517 return 1;
468             }
469              
470             sub _connection_registered {
471 4279     4279   7724 my $self = shift;
472 4279   50     10707 my $conn_id = shift || return;
473 4279 50       9516 return if !$self->_connection_exists($conn_id);
474 4279         16425 return $self->{state}{conns}{$conn_id}{registered};
475             }
476              
477             sub _connection_is_peer {
478 6606     6606   11743 my $self = shift;
479 6606   50     15550 my $conn_id = shift || return;
480              
481 6606 50       14527 return if !$self->_connection_exists($conn_id);
482 6606 100       18635 return if !$self->{state}{conns}{$conn_id}{registered};
483 5068 100       17173 return 1 if $self->{state}{conns}{$conn_id}{type} eq 'p';
484 1980         7231 return;
485             }
486              
487             sub _connection_is_client {
488 1096     1096   2379 my $self = shift;
489 1096   50     3379 my $conn_id = shift || return;
490              
491 1096 50       3801 return if !$self->_connection_exists($conn_id);
492 1096 100       3706 return if !$self->{state}{conns}{$conn_id}{registered};
493 1053 100       5061 return 1 if $self->{state}{conns}{$conn_id}{type} eq 'c';
494 6         19 return;
495             }
496              
497             sub _cmd_from_unknown {
498 1433     1433   3583 my ($self, $wheel_id, $input) = @_;
499              
500 1433         4403 my $cmd = uc $input->{command};
501 1433   100     4133 my $params = $input->{params} || [ ];
502 1433         2644 my $pcount = @$params;
503 1433         2443 my $invalid = 0;
504              
505             SWITCH: {
506 1433 50       3013 if ($cmd eq 'ERROR') {
  1433         3892  
507 0         0 my $peer = $self->{state}{conns}{$wheel_id}{peer};
508 0 0       0 if (defined $peer) {
509 0         0 $self->send_event_next(
510             'daemon_error',
511             $wheel_id,
512             $peer,
513             $params->[0],
514             );
515             }
516             }
517 1433 100       3618 if ($cmd eq 'QUIT') {
518 7         39 $self->_terminate_conn_error($wheel_id, 'Client Quit');
519 7         25 last SWITCH;
520             }
521              
522 1426 100       3499 if ($cmd eq 'CAP' ) {
523 141         666 $self->_daemon_cmd_cap($wheel_id, @$params);
524 141         265 last SWITCH;
525             }
526              
527             # PASS or NICK cmd but no parameters.
528 1285 50 66     9032 if ($cmd =~ /^(PASS|NICK|SERVER)$/ && !$pcount) {
529 0         0 $self->_send_output_to_client($wheel_id, '461', $cmd);
530 0         0 last SWITCH;
531             }
532              
533             # PASS or NICK cmd with one parameter, connection from client
534 1285 100 66     4873 if ($cmd eq 'PASS' && $pcount) {
535 264         1329 $self->{state}{conns}{$wheel_id}{lc $cmd} = $params->[0];
536              
537 264 100 66     2443 if ($params->[1] && $params->[1] =~ /TS$/) {
538 262         987 $self->{state}{conns}{$wheel_id}{ts_server} = 1;
539 262         1502 $self->antiflood($wheel_id, 0);
540              
541             # TS6 server
542             # PASS password TS 6 6FU
543 262 100 66     2219 if ($params->[2] && $params->[3]) {
544 261         2583 $self->{state}{conns}{$wheel_id}{ts_data} = [ @{$params}[2,3] ];
  261         1622  
545 261         805 my $ts = $params->[2];
546 261         1003 my $sid = $params->[3];
547 261         2019 my $errstr;
548 261 100 66     4386 if ($sid !~ $sid_re || $ts ne '6') {
    100          
549 1         7 my $crec = $self->{state}{conns}{$wheel_id};
550             $self->_send_to_realops(
551             sprintf(
552             'Link [unknown@%s] introduced server with bogus server ID %s',
553 1         12 $crec->{socket}[0], $sid,
554             ), qw[Notice s],
555             );
556 1         3 $errstr = 'Bogus server ID introduced';
557             }
558             elsif ($self->state_sid_exists( $sid )) {
559 1         3 my $crec = $self->{state}{conns}{$wheel_id};
560             $self->_send_to_realops(
561             sprintf(
562             'Attempt to re-introduce server %s SID %s from [unknown@%s]',
563 1         6 $self->_state_sid_name($sid), $sid, $crec->{socket}[0],
564             ), qw[Notice s],
565             );
566 1         3 $errstr = 'Server ID already exists';
567             }
568 261 100       996 if ($errstr) {
569 2         12 $self->_terminate_conn_error($wheel_id, $errstr);
570 2         6 last SWITCH;
571             }
572             }
573             else {
574 1         5 $self->_terminate_conn_error($wheel_id, 'Incompatible TS version' );
575 1         3 last SWITCH;
576             }
577             }
578 261         717 last SWITCH;
579             }
580              
581             # SERVER stuff.
582 1021 100 66     3865 if ($cmd eq 'CAPAB' && $pcount) {
583             $self->{state}{conns}{$wheel_id}{capab}
584 259         4582 = [split /\s+/, $params->[0]];
585 259         1060 last SWITCH;
586             }
587 762 50 66     3279 if ($cmd eq 'SERVER' && $pcount < 2) {
588 0         0 $self->_send_output_to_client($wheel_id, '461', $cmd);
589 0         0 last SWITCH;
590             }
591 762 100       2367 if ($cmd eq 'SERVER') {
592 259         740 my $conn = $self->{state}{conns}{$wheel_id};
593 259         832 $conn->{name} = $params->[0];
594 259   50     1256 $conn->{hops} = $params->[1] || 1;
595 259   50     1298 $conn->{desc} = $params->[2] || '(unknown location)';
596              
597 259 50 33     2075 if ( $conn->{desc} && $conn->{desc} =~ m!^\(H\) ! ) {
598 0         0 $conn->{hidden} = 1;
599 0         0 $conn->{desc} =~ s!^\(H\) !!;
600             }
601              
602 259 50       972 if (!$conn->{ts_server}) {
603 0         0 $self->_terminate_conn_error($wheel_id, 'Non-TS server.');
604 0         0 last SWITCH;
605             }
606             my $result = $self->_state_auth_peer_conn($wheel_id,
607 259         1648 $conn->{name}, $conn->{pass});
608 259 100 66     2287 if (!$result || $result <= 0) {
609 2         5 my $errstr; my $snotice;
610 2 50 33     16 if (!defined $result || $result == 0) {
    100          
    50          
611 0         0 $snotice = 'No entry for';
612 0         0 $errstr = 'No connect {} block.';
613             }
614             elsif ($result == -1) {
615 1         3 $snotice = 'Bad password';
616 1         2 $errstr = 'Invalid password.';
617             }
618             elsif ($result == -2) {
619 1         2 $snotice = 'Invalid certificate fingerprint';
620 1         4 $errstr = 'Invalid certificate fingerprint.';
621             }
622             else {
623 0         0 $snotice = 'Invalid host';
624 0         0 $errstr = 'Invalid host.';
625             }
626             $self->_send_to_realops(
627             sprintf(
628             'Unauthorized server connection attempt from [unknown@%s]: %s for server %s',
629             $conn->{socket}[0], $snotice, $conn->{name},
630 2         26 ),
631             'Notice', 's',
632             );
633 2         21 $self->_terminate_conn_error(
634             $wheel_id,
635             $errstr,
636             );
637 2         5 last SWITCH;
638             }
639 257 50       1414 if ($self->state_peer_exists($conn->{name})) {
640             $self->_send_to_realops(
641             sprintf(
642             'Attempt to re-introduce server %s from [unknown@%s]',
643 0         0 $conn->{name}, $conn->{socket}[0],
644             ), qw[Notice s],
645             );
646 0         0 $self->_terminate_conn_error($wheel_id, 'Server exists.');
647 0         0 last SWITCH;
648             }
649 257         1582 $self->_state_register_peer($wheel_id);
650              
651 257 100 100     1359 if ($conn->{zip} && grep { $_ eq 'ZIP' } @{ $conn->{capab} }) {
  4029         7582  
  253         869  
652 2         16 $self->compressed_link($wheel_id, 1, $conn->{cntr});
653             }
654             else {
655 255         1652 $self->_state_send_burst($wheel_id);
656             }
657              
658             $self->send_event(
659             "daemon_capab",
660             $conn->{name},
661 257         847 @{ $conn->{capab} },
  257         1467  
662             );
663 257         39094 last SWITCH;
664             }
665              
666 503 100 66     2713 if ($cmd eq 'NICK' && $pcount) {
667 252         1474 my $nicklen = $self->server_config('NICKLEN');
668 252 50       1420 if (length($params->[0]) > $nicklen) {
669 0         0 $params->[0] = substr($params->[0], 0, $nicklen);
670             }
671              
672 252 50       2563 if (!is_valid_nick_name($params->[0])) {
673 0         0 $self->_send_output_to_client(
674             $wheel_id,
675             '432',
676             $params->[0],
677             );
678 0         0 last SWITCH;
679             }
680              
681 252 100       5004 if ($self->state_nick_exists($params->[0])) {
682 1         15 $self->_send_output_to_client(
683             $wheel_id,
684             '433',
685             $params->[0],
686             );
687 1         3 last SWITCH;
688             }
689              
690 251 100       1601 if ( my $reason = $self->_state_is_resv( $params->[0], $wheel_id ) ) {
691 5         28 $self->_send_output_to_client(
692             $wheel_id, {
693             prefix => $self->server_name(),
694             command => '432',
695             params => [
696             '*',
697             $params->[0],
698             $reason,
699             ],
700             }
701             );
702 5         21 last SWITCH;
703             }
704              
705 246         1377 $self->{state}{conns}{$wheel_id}{lc $cmd} = $params->[0];
706 246         1215 $self->{state}{pending}{uc_irc($params->[0])} = $wheel_id;
707 246         4481 $self->_client_register($wheel_id);
708 246         696 last SWITCH;
709             }
710 251 50 33     2075 if ($cmd eq 'USER' && $pcount < 4) {
711 0         0 $self->_send_output_to_client($wheel_id, '461', $cmd);
712 0         0 last SWITCH;
713             }
714 251 50       1197 if ($cmd eq 'USER') {
715 251         1189 $self->{state}{conns}{$wheel_id}{user} = $params->[0];
716 251   50     1668 $self->{state}{conns}{$wheel_id}{ircname} = $params->[3] || '';
717 251         1189 $self->_client_register($wheel_id);
718 251         700 last SWITCH;
719             }
720              
721 0 0       0 last SWITCH if $self->{state}{conns}{$wheel_id}{cntr};
722 0         0 $invalid = 1;
723 0         0 $self->_send_output_to_client($wheel_id, '451');
724             }
725              
726 1433 50       4254 return 1 if $invalid;
727 1433         6236 $self->_state_cmd_stat($cmd, $input->{raw_line});
728 1433         3409 return 1;
729             }
730              
731             sub _cmd_from_peer {
732 1904     1904   4335 my ($self, $conn_id, $input) = @_;
733              
734 1904         4673 my $cmd = uc $input->{command};
735 1904         3480 my $params = $input->{params};
736 1904         3389 my $prefix = $input->{prefix};
737 1904         4472 my $sid = $self->server_sid();
738 1904         3460 my $invalid = 0;
739              
740             SWITCH: {
741 1904         3153 my $method = '_daemon_peer_' . lc $cmd;
  1904         4801  
742 1904 100 66     5396 if ($cmd eq 'SQUIT' && !$prefix ){
743 1         6 $self->_daemon_peer_squit($conn_id, @$params);
744             #$self->_send_output_to_client(
745             # $conn_id,
746             # $prefix,
747             # (ref $_ eq 'ARRAY' ? @{ $_ } : $_)
748             #) for $self->_daemon_cmd_squit($prefix, @$params);
749 1         2 last SWITCH;
750             }
751              
752 1903 50 66     6754 if ($cmd =~ /\d{3}/ && $params->[0] !~ m!^$sid!) {
753 0         0 $self->send_output(
754             $input,
755             $self->_state_uid_route($params->[0]),
756             );
757 0         0 last SWITCH;
758             }
759 1903 100 66     5321 if ($cmd =~ /\d{3}/ && $params->[0] =~ m!^$sid!) {
760 11         61 $input->{prefix} = $self->_state_sid_name($prefix);
761 11         67 my $uid = $params->[0];
762 11         41 $input->{params}[0] = $self->state_user_nick($uid);
763 11         41 $self->send_output(
764             $input,
765             $self->_state_uid_route($uid),
766             );
767 11         51 last SWITCH;
768             }
769 1892 100       4372 if ($cmd eq 'QUIT') {
770             $self->send_output(
771 4         9 @{ $self->_daemon_peer_quit(
  4         25  
772             $prefix, @$params, $conn_id
773             )}
774             );
775 4         14 last SWITCH;
776             }
777              
778 1888 100       4877 if ($cmd =~ /^(PRIVMSG|NOTICE)$/) {
779             $self->_send_output_to_client(
780             $conn_id,
781             $prefix,
782 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_)
783 7 0       57 ) for $self->_daemon_peer_message(
784             $conn_id,
785             $prefix,
786             $cmd,
787             @$params
788             );
789 7         20 last SWITCH;
790             }
791              
792 1881 100       5790 if ($cmd =~ /^(VERSION|TIME|LINKS|ADMIN|INFO|MOTD|STATS)$/i ) {
793 6         15 my $client_method = '_daemon_peer_miscell';
794 6 100       19 $client_method = '_daemon_peer_links' if $cmd eq 'LINKS';
795             $self->_send_output_to_client(
796             $conn_id,
797             $prefix,
798 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_ )
799 6 50       32 ) for $self->$client_method($cmd, $prefix, @$params);
800 6         33 last SWITCH;
801             }
802              
803 1875 100 66     6849 if ($cmd =~ /^(PING|PONG)$/i && $self->can($method)) {
804 255         698 $self->$method($conn_id, $prefix, @{ $params });
  255         1291  
805 255         649 last SWITCH;
806             }
807              
808 1620 100 66     5917 if ($cmd =~ /^SVINFO$/i && $self->can($method)) {
809 257         1551 $self->$method($conn_id, @$params);
810 257         712 my $conn = $self->{state}{conns}{$conn_id};
811             $self->send_event(
812             "daemon_svinfo",
813             $conn->{name},
814 257         1501 @$params,
815             );
816 257         34373 last SWITCH;
817             }
818              
819 1363 100       3494 if ( $cmd =~ m!^E?TRACE$!i ) {
820 4         29 $self->send_output( $_, $conn_id ) for
821             $self->_daemon_peer_tracing($cmd, $conn_id, $prefix, @$params);
822 4         27 last SWITCH;
823             }
824              
825             # Chanmode and umode have distinct commands now
826             # No need for check, MODE is always umode
827 1359 50       3355 if ($cmd eq 'MODE') {
828 0         0 $method = '_daemon_peer_umode';
829             }
830              
831 1359 100       3814 if ($cmd =~ m!^(UN)?([DKX]LINE|RESV)$!i ) {
832 12         87 $self->send_output( $_, $conn_id ) for
833             $self->$method($conn_id, $prefix, @$params);
834 12         55 last SWITCH;
835             }
836              
837 1347 100       3149 if ($cmd =~ m!^WHO(IS|WAS)$!i ) {
838 4         31 $self->send_output( $_, $conn_id ) for
839             $self->$method($conn_id, $prefix, @$params);
840 4         52 last SWITCH;
841             }
842              
843 1343 50       5668 if ($self->can($method)) {
844 1343         6065 $self->$method($conn_id, $prefix, @$params);
845 1343         3056 last SWITCH;
846             }
847 0         0 $invalid = 1;
848             }
849              
850 1904 50       4904 return 1 if $invalid;
851 1904         7376 $self->_state_cmd_stat($cmd, $input->{raw_line}, 1);
852 1904         4179 return 1;
853             }
854              
855             sub _cmd_from_client {
856 801     801   2410 my ($self, $wheel_id, $input) = @_;
857              
858 801         2505 my $cmd = uc $input->{command};
859 801   100     2970 my $params = $input->{params} || [ ];
860 801         1777 my $pcount = @$params;
861 801         2984 my $server = $self->server_name();
862 801         2938 my $nick = $self->_client_nickname($wheel_id);
863 801         3044 my $uid = $self->_client_uid($wheel_id);
864 801         2090 my $invalid = 0;
865 801         1988 my $pseudo = 0;
866              
867             SWITCH: {
868 801         1593 my $method = '_daemon_cmd_' . lc $cmd;
  801         2723  
869 801 100       2720 if ($cmd eq 'QUIT') {
870 200         586 my $qmsg = $params->[0];
871 200         642 delete $self->{state}{localops}{ $wheel_id };
872 200 100 100     1656 if ( $qmsg and my $msgtime = $self->{config}{anti_spam_exit_message_time} ) {
873             $qmsg = '' if
874 7 50       41 time - $self->{state}{conns}{$wheel_id}->{conn_time} < $msgtime;
875             }
876             $self->_terminate_conn_error(
877 200 100       1882 $wheel_id,
878             ($qmsg ? qq{Quit: "$qmsg"} : 'Client Quit'),
879             );
880 200         644 last SWITCH;
881             }
882              
883 601 50 66     5489 if ($cmd =~ /^(USERHOST|MODE)$/ && !$pcount) {
884 0         0 $self->_send_output_to_client($wheel_id, '461', $cmd);
885 0         0 last SWITCH;
886             }
887 601 100       2269 if ($cmd =~ /^(USERHOST)$/) {
888             $self->_send_output_to_client($wheel_id, $_)
889 1 50       12 for $self->$method(
890             $nick,
891             ($pcount <= 5
892             ? @$params
893 0         0 : @{ $params }[0..5]
894             )
895             );
896 1         5 last SWITCH;
897             }
898              
899 600 100       2161 if ($cmd =~ /^(PRIVMSG|NOTICE)$/) {
900 30         112 $self->{state}{conns}{$wheel_id}{idle_time} = time;
901             $self->_send_output_to_client(
902             $wheel_id,
903 7         40 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
904 30 100       170 ) for $self->_daemon_cmd_message($nick, $cmd, @$params);
905 30         96 last SWITCH;
906             }
907              
908 570 100 100     3282 if ($cmd eq 'MODE' && $self->state_nick_exists($params->[0])) {
909 231 50       842 if (uc_irc($nick) ne uc_irc($params->[0])) {
910 0         0 $self->_send_output_to_client($wheel_id => '502');
911 0         0 last SWITCH;
912             }
913              
914 1         4 $self->_send_output_to_client($wheel_id, (ref $_ eq 'ARRAY' ? @{ $_ } : $_) )
915 231 100       5304 for $self->_daemon_cmd_umode($nick, @{ $params }[1..$#{ $params }]);
  231         1541  
  231         744  
916 231         1082 last SWITCH;
917             }
918              
919 339 50       1329 if ($cmd eq 'CAP') {
920 0         0 $self->_daemon_cmd_cap($wheel_id, @$params);
921 0         0 last SWITCH;
922             }
923              
924 339 100       1660 if ( $cmd =~ m!^(ADMIN|INFO|VERSION|TIME|MOTD)$! ) {
925             $self->_send_output_to_client(
926             $wheel_id,
927 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
928 6 50       48 ) for $self->_daemon_client_miscell($cmd, $nick, @$params);
929 6         27 last SWITCH;
930             }
931              
932 333 100       1285 if ( $cmd =~ m!^E?TRACE$!i ) {
933             $self->_send_output_to_client(
934             $wheel_id,
935 1         4 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
936 6 100       40 ) for $self->_daemon_client_tracing($cmd, $nick, @$params);
937 6         29 last SWITCH;
938             }
939              
940 327 100       2225 if ($self->can($method)) {
941             $self->_send_output_to_client(
942             $wheel_id,
943 34         189 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
944 323 100       1781 ) for $self->$method($nick, @$params);
945 323         1205 last SWITCH;
946             }
947              
948 4 100       20 if (defined $self->{config}{pseudo}{$cmd}) {
949 3         6 $pseudo = 1;
950 3         8 my $pseudo = $self->{config}{pseudo}{$cmd};
951 3 100       10 if (!$params->[0]) {
952 1         4 $self->_send_output_to_client($wheel_id, '412');
953 1         3 last SWITCH;
954             }
955 2         12 my $targ = $self->state_user_nick($pseudo->{nick});
956 2         21 my $serv = $self->_state_peer_name($pseudo->{host});
957 2 100 66     25 if ( !$targ || !$serv ) {
958 1         8 $self->_send_output_to_client($wheel_id, '440', $pseudo->{name});
959 1         3 last SWITCH;
960             }
961 1         3 my $msg;
962 1 50       6 if ($pseudo->{prepend}) {
963 1 50       6 my $join = ($pseudo->{prepend} =~ m! $! ? '' : ' ');
964 1         5 $msg = join $join, $pseudo->{prepend}, $params->[0];
965             }
966             else {
967 0         0 $msg = $params->[0];
968             }
969             $self->_send_output_to_client(
970             $wheel_id,
971 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
972 1 0       23 ) for $self->_daemon_cmd_message($nick, 'PRIVMSG', $pseudo->{nick}, $msg);
973 1         3 last SWITCH;
974             }
975              
976 1         4 $invalid = 1;
977 1         7 $self->_send_output_to_client($wheel_id, '421', $cmd);
978             }
979              
980 801 100 100     4853 return 1 if $invalid || $pseudo;
981 797         4541 $self->_state_cmd_stat($cmd, $input->{raw_line});
982 797         2192 return 1;
983             }
984              
985             sub _daemon_cmd_help {
986 5     5   13 my $self = shift;
987 5   50     14 my $nick = shift || return;
988 5         14 my $server = $self->server_name();
989 5         12 my $ref = [ ];
990 5         14 my $args = [@_];
991 5         11 my $count = @$args;
992              
993             SWITCH: {
994 5 100       8 if (!$self->state_user_is_operator($nick)) {
  5         19  
995 2         32 my $lastuse = $self->{state}{lastuse}{help};
996 2         6 my $pacewait = $self->{config}{pace_wait};
997 2 50 66     15 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      66        
998 1         5 push @$ref, ['263', 'HELP'];
999 1         4 last SWITCH;
1000             }
1001 1         3 $self->{state}{lastuse}{help} = time();
1002             }
1003 4   100     21 my $item = shift @$args || 'index';
1004 4 100       16 if (!$self->{_help}) {
1005 2         1830 require POE::Component::Server::IRC::Help;
1006 2         23 $self->{_help} = POE::Component::Server::IRC::Help->new();
1007             }
1008 4         12 $item = lc $item;
1009 4         15 my @lines = $self->{_help}->topic($item);
1010 4 100       14 if (!scalar @lines) {
1011 1         4 push @$ref, [ '524', $item ];
1012 1         4 last SWITCH;
1013             }
1014 3         8 my $reply = '704';
1015 3         8 foreach my $line (@lines) {
1016 43         174 push @$ref, {
1017             prefix => $server,
1018             command => $reply,
1019             params => [
1020             $nick,
1021             $item,
1022             $line,
1023             ],
1024             };
1025 43         72 $reply = '705';
1026             }
1027 3         24 push @$ref, {
1028             prefix => $server,
1029             command => '706',
1030             params => [
1031             $nick,
1032             $item,
1033             'End of /HELP.',
1034             ],
1035             };
1036             }
1037              
1038 5 50       46 return @$ref if wantarray;
1039 0         0 return $ref;
1040             }
1041              
1042             sub _daemon_cmd_watch {
1043 4     4   12 my $self = shift;
1044 4   50     12 my $nick = shift || return;
1045 4         10 my $server = $self->server_name();
1046 4         9 my $ref = [ ];
1047 4         10 my $args = [@_];
1048 4         8 my $count = @$args;
1049              
1050             SWITCH: {
1051 4 50       7 if (!$count) {
  4         13  
1052 0         0 $args->[0] = 'l';
1053             }
1054 4         17 my $uid = $self->state_user_uid($nick);
1055 4   100     59 my $watches = $self->{state}{uids}{$uid}{watches} || { };
1056 4         10 my $list = 0;
1057 4         21 ITEM: foreach my $item ( split m!,!, $args->[0] ) {
1058 6 100       37 if ( $item =~ m!^\+! ) {
1059 4         16 $item =~ s!^\+!!;
1060 4 50       16 if ( keys %$watches >= $self->{config}{max_watch} ) {
1061 0         0 push @$ref, ['512', $self->{config}{max_watch}];
1062 0         0 next ITEM;
1063             }
1064 4 50 33     18 next ITEM if !$item || !is_valid_nick_name($item);
1065             # Add_to_watch_list
1066 4         48 $watches->{uc_irc $item} = $item;
1067 4         49 $self->{state}{watches}{uc_irc $item}{uids}{$uid} = 1;
1068             # Show_watch possible refactor here
1069 4 50       47 if ( my $tuid = $self->state_user_uid($item) ) {
1070 0         0 my $rec = $self->{state}{uids}{$tuid};
1071             push @$ref, {
1072             prefix => $server,
1073             command => '604',
1074             params => [
1075             $nick,
1076             $rec->{nick},
1077             $rec->{auth}{ident},
1078             $rec->{auth}{hostname},
1079             $rec->{ts},
1080 0         0 'is online',
1081             ],
1082             };
1083             }
1084             else {
1085 4   50     13 my $laston = $self->{state}{watches}{uc_irc $item}{laston} || 0;
1086 4         66 push @$ref, {
1087             prefix => $server,
1088             command => '605',
1089             params => [
1090             $nick, $item, '*', '*', $laston, 'is offline'
1091             ],
1092             };
1093             }
1094 4         21 next ITEM;
1095             }
1096 2 50       10 if ( $item =~ m!^\-! ) {
1097 0         0 $item =~ s!^\-!!;
1098 0 0       0 next ITEM if !$item;
1099 0         0 $item = uc_irc $item;
1100 0         0 my $pitem = delete $watches->{$item};
1101 0         0 delete $self->{state}{watches}{$item}{uids}{$uid};
1102 0 0       0 if ( my $tuid = $self->state_user_uid($item) ) {
1103 0         0 my $rec = $self->{state}{uids}{$tuid};
1104             push @$ref, {
1105             prefix => $server,
1106             command => '602',
1107             params => [
1108             $nick,
1109             $rec->{nick},
1110             $rec->{auth}{ident},
1111             $rec->{auth}{hostname},
1112             $rec->{ts},
1113 0         0 'stopped watching',
1114             ],
1115             };
1116             }
1117             else {
1118 0   0     0 my $laston = $self->{state}{watches}{$item}{laston} || 0;
1119 0         0 push @$ref, {
1120             prefix => $server,
1121             command => '602',
1122             params => [
1123             $nick, $pitem, '*', '*', $laston, 'stopped watching'
1124             ],
1125             };
1126             }
1127             delete $self->{state}{watches}{$item}
1128 0 0       0 if !keys %{ $self->{state}{watches}{$item}{uids} };
  0         0  
1129 0         0 next ITEM;
1130             }
1131 2 50       11 if ( $item =~ m!^C!i ) {
1132 0         0 foreach my $watched ( keys %$watches ) {
1133 0         0 delete $self->{state}{watches}{$watched}{uids}{$uid};
1134             delete $self->{state}{watches}{$watched}
1135 0 0       0 if !keys %{ $self->{state}{watches}{$watched}{uids} };
  0         0  
1136             }
1137 0         0 $watches = { };
1138 0         0 next ITEM;
1139             }
1140 2 50       11 if ( $item =~ m!^S!i ) {
1141 2 50       7 next ITEM if $list & 0x1;
1142 2         7 $item = substr $item, 0, 1;
1143 2         5 $list |= 0x1;
1144 2         15 my @watching = sort keys %$watches;
1145 2         4 my $wcount = 0;
1146 2         6 my $mcount = @watching;
1147 2 50       8 if ( defined $self->{state}{watches}{uc_irc $nick} ) {
1148 0         0 $wcount = keys %{ $self->{state}{watches}{uc_irc $nick}{uids} };
  0         0  
1149             }
1150 2         36 push @$ref, {
1151             prefix => $server,
1152             command => '603',
1153             params => [
1154             $nick,
1155             "You have $mcount and are on $wcount WATCH entries",
1156             ],
1157             };
1158 2         7 my $len = length($server) + length($nick) + 8;
1159 2         5 my $buf = '';
1160 2         6 WATCHED: foreach my $watched ( @watching ) {
1161 4         8 $watched = $watches->{$watched};
1162 4 50       16 if (length(join ' ', $buf, $watched)+$len+1 > 510) {
1163 0         0 push @$ref, {
1164             prefix => $server,
1165             command => '606',
1166             params => [ $nick, $buf ],
1167             };
1168 0         0 $buf = $watched;
1169 0         0 next WATCHED;
1170             }
1171 4         21 $buf = join ' ', $buf, $watched;
1172 4         17 $buf =~ s!^\s+!!;
1173             }
1174 2 50       8 if ($buf) {
1175 2         10 push @$ref, {
1176             prefix => $server,
1177             command => '606',
1178             params => [ $nick, $buf ],
1179             };
1180             }
1181 2         11 push @$ref, {
1182             prefix => $server,
1183             command => '607',
1184             params => [
1185             $nick,
1186             "End of WATCH $item",
1187             ],
1188             };
1189 2         8 next ITEM;
1190             }
1191 0 0       0 if ( $item =~ m!^L!i ) {
1192 0 0       0 next ITEM if $list & 0x2;
1193 0         0 $item = substr $item, 0, 1;
1194 0         0 $list |= 0x2;
1195 0         0 foreach my $watched ( keys %$watches ) {
1196 0 0       0 if ( my $tuid = $self->state_user_uid($watched) ) {
    0          
1197 0         0 my $rec = $self->{state}{uids}{$tuid};
1198             push @$ref, {
1199             prefix => $server,
1200             command => '604',
1201             params => [
1202             $nick,
1203             $rec->{nick},
1204             $rec->{auth}{ident},
1205             $rec->{auth}{hostname},
1206             $rec->{ts},
1207 0         0 'is online',
1208             ],
1209             };
1210             }
1211             elsif ( $item eq 'L' ) {
1212             push @$ref, {
1213             prefix => $server,
1214             command => '605',
1215             params => [
1216 0         0 $nick, $watches->{$watched}, '*', '*', 0, 'is offline'
1217             ],
1218             };
1219             }
1220             }
1221 0         0 push @$ref, {
1222             prefix => $server,
1223             command => '607',
1224             params => [
1225             $nick,
1226             "End of WATCH $item",
1227             ],
1228             };
1229 0         0 next ITEM;
1230             }
1231             }
1232 4         13 $self->{state}{uids}{$uid}{watches} = $watches;
1233             }
1234              
1235 4 50       40 return @$ref if wantarray;
1236 0         0 return $ref;
1237             }
1238              
1239             sub _daemon_cmd_cap {
1240 141     141   285 my $self = shift;
1241 141   50     372 my $wheel_id = shift || return;
1242 141         264 my $subcmd = shift;
1243 141         303 my $args = [@_];
1244 141         454 my $server = $self->server_name();
1245              
1246 141         399 my $registered = $self->_connection_registered($wheel_id);
1247              
1248             SWITCH: {
1249 141 50       265 if (!$subcmd) {
  141         390  
1250 0         0 $self->_send_output_to_client($wheel_id, '461', 'CAP');
1251 0         0 last SWITCH;
1252             }
1253 141         305 $subcmd = uc $subcmd;
1254 141 50       938 if( $subcmd !~ m!^(LS|LIST|REQ|ACK|NAK|CLEAR|END)$! ) {
1255 0         0 $self->_send_output_to_client($wheel_id, '410', $subcmd);
1256 0         0 last SWITCH;
1257             }
1258 141 50 66     759 if ( $subcmd eq 'END' && $registered ) { #NOOP
1259 0         0 last SWITCH;
1260             }
1261 141 100 66     524 if ( $subcmd eq 'END' && !$registered ) {
1262 43         149 my $capneg = delete $self->{state}{conns}{$wheel_id}{capneg};
1263 43 50       293 $self->_client_register($wheel_id) if $capneg;
1264 43         102 last SWITCH;
1265             }
1266 98 50 33     918 $self->{state}{conns}{$wheel_id}{capneg} = 1 if !$registered && $subcmd =~ m!^(LS|REQ)$!;
1267 98 100       341 if ( $subcmd eq 'LS' ) {
1268 32         170 my $output = {
1269             prefix => $server,
1270             command => 'CAP',
1271             params => [ $self->_client_nickname($wheel_id), $subcmd, ],
1272             };
1273 32         110 push @{ $output->{params} }, join ' ', sort keys %{ $self->{state}{caps} };
  32         119  
  32         391  
1274 32         191 $self->_send_output_to_client($wheel_id, $output);
1275 32         117 last SWITCH;
1276             }
1277 66 50       217 if ( $subcmd eq 'LIST' ) {
1278 0         0 my $output = {
1279             prefix => $server,
1280             command => 'CAP',
1281             params => [ $self->_client_nickname($wheel_id), $subcmd, ],
1282             };
1283 0         0 push @{ $output->{params} }, join ' ', sort keys %{ $self->{state}{conns}{$wheel_id}{caps} };
  0         0  
  0         0  
1284 0         0 $self->_send_output_to_client($wheel_id, $output);
1285 0         0 last SWITCH;
1286             }
1287 66 50       202 if ( $subcmd eq 'REQ' ) {
1288 66         307 foreach my $cap ( split ' ', $args->[0] ) {
1289 73         223 my $ocap = $cap;
1290 73         211 my $neg = $cap =~ s!^\-!!;
1291 73         556 $cap = lc $cap;
1292 73 100       345 if ( !$self->{state}{caps}{$cap} ) {
1293 23         174 my $output = {
1294             prefix => $server,
1295             command => 'CAP',
1296             params => [ $self->_client_nickname($wheel_id), 'NAK', $args->[0] ],
1297             };
1298 23         158 $self->_send_output_to_client($wheel_id, $output);
1299 23         122 last SWITCH;
1300             }
1301 50 50       228 if ( $neg ) {
1302 0         0 delete $self->{state}{conns}{$wheel_id}{caps}{$cap};
1303             }
1304             else {
1305 50         276 $self->{state}{conns}{$wheel_id}{caps}{$cap} = 1;
1306             }
1307             }
1308 43         226 my $output = {
1309             prefix => $server,
1310             command => 'CAP',
1311             params => [ $self->_client_nickname($wheel_id), 'ACK', $args->[0] ],
1312             };
1313 43         211 $self->_send_output_to_client($wheel_id, $output);
1314 43         137 last SWITCH;
1315             }
1316             }
1317              
1318 141         340 return 1;
1319             }
1320              
1321             sub _daemon_cmd_message {
1322 31     31   93 my $self = shift;
1323 31   50     119 my $nick = shift || return;
1324 31   50     116 my $type = shift || return;
1325 31         82 my $ref = [ ];
1326 31         101 my $args = [@_];
1327 31         79 my $count = @$args;
1328              
1329             SWITCH: {
1330 31 50       71 if (!$count) {
  31         132  
1331 0         0 push @$ref, ['461', $type];
1332 0         0 last SWITCH;
1333             }
1334 31 50 33     317 if ($count < 2 || !$args->[1]) {
1335 0         0 push @$ref, ['412'];
1336 0         0 last SWITCH;
1337             }
1338              
1339 31         81 my $targets = 0;
1340 31         129 my $max_targets = $self->server_config('MAXTARGETS');
1341 31         144 my $uid = $self->state_user_uid($nick);
1342 31         529 my $sid = $self->server_sid();
1343 31         151 my $full = $self->state_user_full($nick);
1344 31         162 my $targs = $self->_state_parse_msg_targets($args->[0]);
1345              
1346 31         169 LOOP: for my $target (keys %$targs) {
1347 31         76 my $targ_type = shift @{ $targs->{$target} };
  31         90  
1348              
1349 31 50 33     190 if ($targ_type =~ /(server|host)mask/
1350             && !$self->state_user_is_operator($nick)) {
1351 0         0 push @$ref, ['481'];
1352 0         0 next LOOP;
1353             }
1354              
1355 31 50 33     144 if ($targ_type =~ /(server|host)mask/
1356             && $targs->{$target}[0] !~ /\./) {
1357 0         0 push @$ref, ['413', $target];
1358 0         0 next LOOP;
1359             }
1360              
1361 31 50 33     136 if ($targ_type =~ /(server|host)mask/
1362             && $targs->{$target}[1] =~ /\x2E[^.]*[\x2A\x3F]+[^.]*$/) {
1363 0         0 push @$ref, ['414', $target];
1364 0         0 next LOOP;
1365             }
1366              
1367 31 50 33     148 if ($targ_type eq 'channel_ext'
1368             && !$self->state_chan_exists($targs->{$target}[1])) {
1369 0         0 push @$ref, ['401', $targs->{$target}[1]];
1370 0         0 next LOOP;
1371             }
1372              
1373 31 50 66     161 if ($targ_type eq 'channel'
1374             && !$self->state_chan_exists($target)) {
1375 0         0 push @$ref, ['401', $target];
1376 0         0 next LOOP;
1377             }
1378              
1379 31 50 66     170 if ($targ_type eq 'nick'
1380             && !$self->state_nick_exists($target)) {
1381 0         0 push @$ref, ['401', $target];
1382 0         0 next LOOP;
1383             }
1384              
1385 31 50 33     199 if ($targ_type eq 'nick_ext'
1386             && !$self->state_peer_exists($targs->{$target}[1])) {
1387 0         0 push @$ref, ['402', $targs->{$target}[1]];
1388 0         0 next LOOP;
1389             }
1390              
1391 31         68 $targets++;
1392 31 50       107 if ($targets > $max_targets) {
1393 0         0 push @$ref, ['407', $target];
1394 0         0 last SWITCH;
1395             }
1396              
1397             # $$whatever
1398 31 50       154 if ($targ_type eq 'servermask') {
1399 0         0 my $us = 0;
1400 0         0 my %targets;
1401 0         0 my $ucserver = uc $self->server_name();
1402              
1403 0         0 for my $peer (keys %{ $self->{state}{peers} }) {
  0         0  
1404 0 0       0 if (matches_mask( $targs->{$target}[0], $peer)) {
1405 0 0       0 if ($ucserver eq $peer) {
1406 0         0 $us = 1;
1407             }
1408             else {
1409 0         0 $targets{ $self->_state_peer_route($peer) }++;
1410             }
1411             }
1412             }
1413              
1414             $self->send_output(
1415             {
1416 0         0 prefix => $uid,
1417             command => $type,
1418             params => [$target, $args->[1]],
1419             },
1420             keys %targets,
1421             );
1422              
1423 0 0       0 if ($us) {
1424             my $local
1425 0         0 = $self->{state}{peers}{uc $self->server_name()}{users};
1426 0         0 my @local;
1427 0         0 my $spoofed = 0;
1428              
1429 0         0 for my $luser (values %$local) {
1430 0 0       0 if ($luser->{route_id} eq 'spoofed') {
1431 0         0 $spoofed = 1;
1432             }
1433             else {
1434 0         0 push @local, $luser->{route_id};
1435             }
1436             }
1437              
1438             $self->send_output(
1439             {
1440 0         0 prefix => $full,
1441             command => $type,
1442             params => [$target, $args->[1]],
1443             },
1444             @local,
1445             );
1446              
1447 0 0       0 $self->send_event(
1448             "daemon_" . lc $type,
1449             $full,
1450             $target,
1451             $args->[1],
1452             ) if $spoofed;
1453             }
1454 0         0 next LOOP;
1455             }
1456              
1457             # $#whatever
1458 31 50       139 if ($targ_type eq 'hostmask') {
1459 0         0 my $spoofed = 0;
1460 0         0 my %targets; my @local;
1461              
1462 0         0 HOST: for my $luser (values %{ $self->{state}{users} }) {
  0         0  
1463 0 0       0 if (!matches_mask($targs->{$target}[0],
1464             $luser->{auth}{hostname})) {;
1465 0         0 next HOST;
1466             }
1467              
1468 0 0       0 if ($luser->{route_id} eq 'spoofed') {
    0          
1469 0         0 $spoofed = 1;
1470             }
1471             elsif ($luser->{type} eq 'r') {
1472 0         0 $targets{ $luser->{route_id} }++;
1473             }
1474             else {
1475 0         0 push @local, $luser->{route_id};
1476             }
1477             }
1478              
1479             $self->send_output(
1480             {
1481 0         0 prefix => $uid,
1482             command => $type,
1483             params => [$target, $args->[1]],
1484             },
1485             keys %targets,
1486             );
1487              
1488 0         0 $self->send_output(
1489             {
1490             prefix => $full,
1491             command => $type,
1492             params => [$target, $args->[1]],
1493             },
1494             @local,
1495             );
1496              
1497 0 0       0 $self->send_event(
1498             "daemon_" . lc $type,
1499             $full,
1500             $target,
1501             $args->[1],
1502             ) if $spoofed;
1503              
1504 0         0 next LOOP;
1505             }
1506              
1507 31 50       141 if ($targ_type eq 'nick_ext') {
1508             $targs->{$target}[1] = $self->_state_peer_name(
1509 0         0 $targs->{$target}[1]);
1510              
1511 0 0 0     0 if ($targs->{$target}[2]
1512             && !$self->state_user_is_operator($nick)) {
1513 0         0 push @$ref, ['481'];
1514 0         0 next LOOP;
1515             }
1516              
1517 0 0       0 if ($targs->{$target}[1] ne $self->server_name()) {
1518             $self->send_output(
1519             {
1520             prefix => $uid,
1521             command => $type,
1522             params => [$target, $args->[1]],
1523             },
1524 0         0 $self->_state_peer_route($targs->{$target}[1]),
1525             );
1526 0         0 next LOOP;
1527             }
1528              
1529 0 0       0 if (uc $targs->{$target}[0] eq 'OPERS') {
1530 0 0       0 if (!$self->state_user_is_operator($nick)) {
1531 0         0 push @$ref, ['481'];
1532 0         0 next LOOP;
1533             }
1534              
1535             $self->send_output(
1536             {
1537             prefix => $full,
1538             command => $type,
1539             params => [$target, $args->[1]],
1540             },
1541 0         0 keys %{ $self->{state}{localops} },
  0         0  
1542             );
1543 0         0 next LOOP;
1544             }
1545              
1546             my @local = $self->_state_find_user_host(
1547             $targs->{$target}[0],
1548 0         0 $targs->{$target}[2],
1549             );
1550              
1551 0 0       0 if (@local == 1) {
1552 0         0 my $ref = shift @local;
1553 0 0       0 if ($ref->[0] eq 'spoofed') {
1554 0         0 $self->send_event(
1555             "daemon_" . lc $type,
1556             $full,
1557             $ref->[1],
1558             $args->[1],
1559             );
1560             }
1561             else {
1562 0         0 $self->send_output(
1563             {
1564             prefix => $full,
1565             command => $type,
1566             params => [$target, $args->[1]],
1567             },
1568             $ref->[0],
1569             );
1570             }
1571             }
1572             else {
1573 0         0 push @$ref, ['407', $target];
1574 0         0 next LOOP;
1575             }
1576             }
1577              
1578 31         176 my ($channel, $status_msg);
1579 31 100       119 if ($targ_type eq 'channel') {
1580 17         74 $channel = $self->_state_chan_name($target);
1581             }
1582 31 50       287 if ($targ_type eq 'channel_ext') {
1583 0         0 $channel = $self->_state_chan_name($targs->{target}[1]);
1584 0         0 $status_msg = $targs->{target}[0];
1585             }
1586 31 50 66     236 if ($channel && $status_msg
      33        
1587             && !$self->state_user_chan_mode($nick, $channel)) {
1588 0         0 push @$ref, ['482', $target];
1589 0         0 next LOOP;
1590             }
1591 31 100       132 if ($channel) {
1592 17         101 my $res = $self->state_can_send_to_channel($nick,$channel,$args->[1],$type);
1593 17 50       93 if ( !$res ) {
    100          
1594 0         0 next LOOP;
1595             }
1596             elsif ( ref $res eq 'ARRAY' ) {
1597 7         22 push @$ref, $res;
1598 7         36 next LOOP;
1599             }
1600 10 100 100     62 if ( $res != 2 && $self->state_flood_attack_channel($nick,$channel,$type) ) {
1601 1         6 next LOOP;
1602             }
1603 9         27 my $common = { };
1604 9 50       66 my $msg = {
1605             command => $type,
1606             params => [
1607             ($status_msg ? $target : $channel), $args->[1]
1608             ],
1609             };
1610 9         45 for my $member ($self->state_chan_list($channel, $status_msg)) {
1611 27 50       72 next if $self->_state_user_is_deaf($member);
1612 27         374 $common->{ $self->_state_user_route($member) }++;
1613             }
1614 9         33 delete $common->{ $self->_state_user_route($nick) };
1615 9         36 for my $route_id (keys %$common) {
1616 18         66 $msg->{prefix} = $uid;
1617 18 100       52 if ($self->_connection_is_client($route_id)) {
1618 17         39 $msg->{prefix} = $full;
1619             }
1620 18 50       66 if ($route_id ne 'spoofed') {
1621 18         77 $self->send_output($msg, $route_id);
1622             }
1623             else {
1624 0 0       0 my $tmsg = $type eq 'PRIVMSG' ? 'public' : 'notice';
1625 0         0 $self->send_event(
1626             "daemon_$tmsg",
1627             $full,
1628             $channel,
1629             $args->[1],
1630             );
1631             }
1632             }
1633 9         71 next LOOP;
1634             }
1635              
1636 14         45 my $server = $self->server_name();
1637 14 50       48 if ($self->state_nick_exists($target)) {
1638 14         57 $target = $self->state_user_nick($target);
1639              
1640             # Flood check
1641 14 100       246 next LOOP if $self->state_flood_attack_client($nick,$target,$type);
1642              
1643 13 50       67 if (my $away = $self->_state_user_away_msg($target)) {
1644 0         0 push @$ref, {
1645             prefix => $server,
1646             command => '301',
1647             params => [$nick, $target, $away],
1648             };
1649             }
1650              
1651 13         275 my $targ_umode = $self->state_user_umode($target);
1652              
1653             # Target user has CALLERID on
1654 13 100 66     275 if ($targ_umode && $targ_umode =~ /[Gg]/) {
1655 1         6 my $targ_rec = $self->{state}{users}{uc_irc($target)};
1656 1         13 my $targ_uid = $targ_rec->{uid};
1657 1         3 my $local = $targ_uid =~ m!^sid!;
1658 1 50 0     40 if (($targ_umode =~ /G/
      33        
      33        
      33        
1659             && (!$self->state_users_share_chan($target, $nick)
1660             || !$targ_rec->{accepts}{uc_irc($nick)}))
1661             || ($targ_umode =~ /g/
1662             && !$targ_rec->{accepts}{uc_irc($nick)})) {
1663              
1664 1         28 push @$ref, {
1665             prefix => $server,
1666             command => '716',
1667             params => [
1668             $nick,
1669             $target,
1670             'is in +g mode (server side ignore)',
1671             ],
1672             };
1673              
1674 1 50 33     26 if (!$targ_rec->{last_caller}
1675             || time() - $targ_rec->{last_caller} >= 60) {
1676              
1677 1         6 my ($n, $uh) = split /!/,
1678             $self->state_user_full($nick);
1679             $self->send_output(
1680             {
1681             prefix => ( $local ? $server : $sid ),
1682             command => '718',
1683             params => [
1684             ( $local ? $target : $targ_uid ),
1685             "$n\[$uh\]",
1686             'is messaging you, and you are umode +g.',
1687             ]
1688             },
1689             $targ_rec->{route_id},
1690 1 0       5 ) if $targ_rec->{route_id} ne 'spoofed';
    0          
    50          
1691 1         16 push @$ref, {
1692             prefix => $server,
1693             command => '717',
1694             params => [
1695             $nick,
1696             $target,
1697             'has been informed that you messaged them.',
1698             ],
1699             };
1700             }
1701 1         5 $targ_rec->{last_caller} = time();
1702 1         6 next LOOP;
1703             }
1704             }
1705              
1706 12         45 my $targ_uid = $self->state_user_uid($target);
1707 12         229 my $msg = {
1708             prefix => $uid,
1709             command => $type,
1710             params => [$targ_uid, $args->[1]],
1711             };
1712 12         71 my $route_id = $self->_state_user_route($target);
1713              
1714 12 100       45 if ($route_id eq 'spoofed') {
1715 2         6 $msg->{prefix} = $full;
1716 2         15 $self->send_event(
1717             "daemon_" . lc $type,
1718             $full,
1719             $target,
1720             $args->[1],
1721             );
1722             }
1723             else {
1724 10 100       57 if ($self->_connection_is_client($route_id)) {
1725 5         17 $msg->{prefix} = $full;
1726 5         15 $msg->{params}[0] = $target;
1727             }
1728 10         55 $self->send_output($msg, $route_id);
1729             }
1730 12         459 next LOOP;
1731             }
1732             }
1733             }
1734              
1735 31 50       221 return @$ref if wantarray;
1736 0         0 return $ref;
1737             }
1738              
1739             sub _daemon_cmd_accept {
1740 0     0   0 my $self = shift;
1741 0   0     0 my $nick = shift || return;
1742 0         0 my $server = $self->server_name();
1743 0         0 my $ref = [ ];
1744 0         0 my $args = [ @_ ];
1745 0         0 my $count = @$args;
1746              
1747             SWITCH: {
1748 0 0 0     0 if (!$count || !$args->[0] || $args->[0] eq '*') {
  0   0     0  
1749 0         0 my $record = $self->{state}{users}{uc_irc($nick)};
1750 0         0 my @list;
1751 0         0 for my $accept (keys %{ $record->{accepts} }) {
  0         0  
1752 0 0       0 if (!$self->state_nick_exists($accept)) {
1753 0         0 delete $record->{accepts}{$accept};
1754 0         0 next;
1755             }
1756 0         0 push @list, $self->state_user_nick($accept);
1757             }
1758 0 0       0 push @$ref, {
1759             prefix => $server,
1760             command => '281',
1761             params => [$nick, join( ' ', @list)],
1762             } if @list;
1763              
1764 0         0 push @$ref, {
1765             prefix => $server,
1766             command => '282',
1767             params => [$nick, 'End of /ACCEPT list'],
1768             };
1769 0         0 last SWITCH;
1770             }
1771             }
1772              
1773 0         0 my $record = $self->{state}{users}{uc_irc($nick)};
1774              
1775 0         0 for (keys %{ $record->{accepts} }) {
  0         0  
1776 0 0       0 delete $record->{accepts}{$_} if !$self->state_nick_exists($_);
1777             }
1778              
1779 0         0 OUTER: for my $target (split /,/, $args->[0]) {
1780 0 0       0 if (my ($foo) = $target =~ /^\-(.+)$/) {
1781 0         0 my $dfoo = delete $record->{accepts}{uc_irc($foo)};
1782 0 0       0 if (!$dfoo) {
1783 0         0 push @$ref, {
1784             prefix => $server,
1785             command => '458',
1786             params => [$nick, $foo, "doesn\'t exist"],
1787             };
1788             }
1789 0         0 delete $self->{state}{accepts}{uc_irc($foo)}{uc_irc($nick)};
1790 0 0       0 if (!keys %{ $self->{state}{accepts}{uc_irc($foo)} }) {
  0         0  
1791 0         0 delete $self->{state}{accepts}{uc_irc($foo)};
1792             }
1793 0         0 next OUTER;
1794             }
1795              
1796 0 0       0 if (!$self->state_nick_exists($target)) {
1797 0         0 push @$ref, ['401', $target];
1798 0         0 next OUTER;
1799             }
1800             # 457 ERR_ACCEPTEXIST
1801 0 0       0 if ($record->{accepts}{uc_irc($target)}) {
1802 0         0 push @$ref, {
1803             prefix => $server,
1804             command => '457',
1805             params => [
1806             $nick,
1807             $self->state_user_nick($target),
1808             'already exists',
1809             ],
1810             };
1811 0         0 next OUTER;
1812             }
1813              
1814 0 0 0     0 if ($record->{umode} && $record->{umode} =~ /G/
      0        
1815             && $self->_state_users_share_chan($nick, $target) ) {
1816 0         0 push @$ref, {
1817             prefix => $server,
1818             command => '457',
1819             params => [
1820             $nick,
1821             $self->state_user_nick($target),
1822             'already exists',
1823             ],
1824             };
1825 0         0 next OUTER;
1826             }
1827              
1828             $self->{state}{accepts}{uc_irc($target)}{uc_irc($nick)}
1829 0         0 = $record->{accepts}{uc_irc($target)} = time;
1830 0         0 my @list = map { $self->state_user_nick($_) } keys %{ $record->{accepts} };
  0         0  
  0         0  
1831              
1832 0 0       0 push @$ref, {
1833             prefix => $server,
1834             command => '281',
1835             params => [
1836             $nick,
1837             join(' ', @list),
1838             ],
1839             } if @list;
1840              
1841 0         0 push @$ref, {
1842             prefix => $server,
1843             command => '282',
1844             params => [$nick, 'End of /ACCEPT list'],
1845             };
1846             }
1847              
1848 0 0       0 return @$ref if wantarray;
1849 0         0 return $ref;
1850             }
1851              
1852             sub _daemon_cmd_quit {
1853 226     226   687 my $self = shift;
1854 226   50     923 my $nick = shift || return;
1855 226         622 my $qmsg = shift;
1856 226         601 my $ref = [ ];
1857 226         949 my $name = uc $self->server_name();
1858 226         909 my $sid = $self->server_sid();
1859              
1860 226         1231 $nick = uc_irc($nick);
1861 226         4301 my $record = delete $self->{state}{peers}{$name}{users}{$nick};
1862 226 50       906 $qmsg = 'Client Quit' if !$qmsg;
1863 226         937 my $full = $record->{full}->();
1864 226         1196 delete $self->{state}{peers}{$name}{uids}{ $record->{uid} };
1865 226         597 my $uid = $record->{uid};
1866             $self->send_output(
1867             {
1868             prefix => $uid,
1869             command => 'QUIT',
1870             params => [$qmsg],
1871             },
1872             $self->_state_connected_peers(),
1873 226 100       2353 ) if !$record->{killed};
1874              
1875 226         1614 push @$ref, {
1876             prefix => $full,
1877             command => 'QUIT',
1878             params => [$qmsg],
1879             };
1880 226         1450 $self->send_event("daemon_quit", $full, $qmsg);
1881              
1882             # Remove from peoples accept lists
1883 226         26384 for my $user (keys %{ $record->{accepts} }) {
  226         1532  
1884 0         0 delete $self->{state}{users}{$user}{accepts}{uc_irc($nick)};
1885             }
1886              
1887 226 100       1384 if ( defined $self->{state}{watches}{$nick} ) {
1888 1         3 my $laston = time();
1889 1         16 $self->{state}{watches}{$nick}{laston} = $laston;
1890 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$nick}{uids} } ) {
  1         6  
1891 1 50       5 next if !defined $self->{state}{uids}{$wuid};
1892 1         3 my $wrec = $self->{state}{uids}{$wuid};
1893             $self->send_output(
1894             {
1895             prefix => $record->{server},
1896             command => '601',
1897             params => [
1898             $wrec->{nick},
1899             $record->{nick},
1900             $record->{auth}{ident},
1901             $record->{auth}{hostname},
1902             $laston,
1903             'logged offline',
1904             ],
1905             },
1906             $wrec->{route_id},
1907 1         12 );
1908             }
1909             }
1910             # clear WATCH list
1911 226         547 foreach my $watched ( keys %{ $record->{watches} } ) {
  226         997  
1912 4         12 delete $self->{state}{watches}{$watched}{uids}{$uid};
1913             delete $self->{state}{watches}{$watched}
1914 4 50       7 if !keys %{ $self->{state}{watches}{$watched}{uids} };
  4         19  
1915             }
1916              
1917             # Okay, all 'local' users who share a common channel with user.
1918 226         722 my $common = { };
1919 226         661 for my $uchan (keys %{ $record->{chans} }) {
  226         1045  
1920 92         427 delete $self->{state}{chans}{$uchan}{users}{$uid};
1921 92         193 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  92         581  
1922 81 100       1202 next if $user !~ m!^$sid!;
1923 56         267 $common->{$user} = $self->_state_uid_route($user);
1924             }
1925              
1926 92 100       233 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  92         483  
1927 39         289 delete $self->{state}{chans}{$uchan};
1928             }
1929             }
1930              
1931 226         1071 push @$ref, $common->{$_} for keys %$common;
1932 226 100       1434 $self->{state}{stats}{ops_online}-- if $record->{umode} =~ /o/;
1933 226 100       1520 $self->{state}{stats}{invisible}-- if $record->{umode} =~ /i/;
1934 226 100       1213 delete $self->{state}{users}{$nick} if !$record->{nick_collision};
1935 226         841 delete $self->{state}{uids}{ $record->{uid} };
1936 226         732 delete $self->{state}{localops}{$record->{route_id}};
1937 226         3606 unshift @{ $self->{state}{whowas}{$nick} }, {
1938             logoff => time(),
1939             account => $record->{account},
1940             nick => $record->{nick},
1941             user => $record->{auth}{ident},
1942             host => $record->{auth}{hostname},
1943             real => $record->{auth}{realhost},
1944             sock => $record->{socket}[0],
1945             ircname => $record->{ircname},
1946 226         538 server => $name,
1947             };
1948 226 50       1029 return @$ref if wantarray;
1949 226         1698 return $ref;
1950             }
1951              
1952             sub _daemon_cmd_ping {
1953 3     3   7 my $self = shift;
1954 3   50     8 my $nick = shift || return;
1955 3         8 my $server = $self->server_name();
1956 3         8 my $sid = $self->server_sid();
1957 3         8 my $args = [ @_ ];
1958 3         7 my $count = @$args;
1959 3         5 my $ref = [ ];
1960              
1961             SWITCH: {
1962 3 100       6 if (!$count) {
  3         7  
1963 1         5 push @$ref, [ '409' ];
1964 1         3 last SWITCH;
1965             }
1966              
1967 2 100 66     13 if ($count >= 2 && !$self->state_peer_exists($args->[1])) {
1968 1         4 push @$ref, ['402', $args->[1]];
1969 1         3 last SWITCH;
1970             }
1971 1 50 33     9 if ($count >= 2 && (uc $args->[1] ne uc $server)) {
1972 1         7 my $target = $self->_state_peer_sid($args->[1]);
1973 1         5 $self->send_output(
1974             {
1975             prefix => $self->state_user_uid($nick),
1976             command => 'PING',
1977             params => [$nick, $target],
1978             },
1979             $self->_state_sid_route($target),
1980             );
1981 1         4 last SWITCH;
1982             }
1983 0         0 push @$ref, {
1984             prefix => $sid,
1985             command => 'PONG',
1986             params => [$server, $args->[0]],
1987             };
1988             }
1989 3 50       21 return @$ref if wantarray;
1990 0         0 return $ref;
1991             }
1992              
1993             sub _daemon_cmd_pong {
1994 0     0   0 my $self = shift;
1995 0   0     0 my $nick = shift || return;
1996 0         0 my $server = uc $self->server_name();
1997 0         0 my $args = [ @_ ];
1998 0         0 my $count = @$args;
1999 0         0 my $ref = [ ];
2000              
2001             SWITCH: {
2002 0 0       0 if (!$count) {
  0         0  
2003 0         0 push @$ref, ['409'];
2004 0         0 last SWITCH;
2005             }
2006 0 0 0     0 if ($count >= 2 && !$self->state_peer_exists($args->[1])) {
2007 0         0 push @$ref, ['402', $args->[1]];
2008 0         0 last SWITCH;
2009             }
2010 0 0 0     0 if ($count >= 2 && uc $args->[1] ne uc $server) {
2011 0         0 my $target = $self->_state_peer_sid($args->[1]);
2012 0         0 $self->send_output(
2013             {
2014             prefix => $self->state_user_uid($nick),
2015             command => 'PONG',
2016             params => [$nick, $target],
2017             },
2018             $self->_state_sid_route($target),
2019             );
2020 0         0 last SWITCH;
2021             }
2022 0         0 delete $self->{state}{users}{uc_irc($nick)}{pinged};
2023             }
2024              
2025 0 0       0 return @$ref if wantarray;
2026 0         0 return $ref;
2027             }
2028              
2029             sub _daemon_cmd_pass {
2030 0     0   0 my $self = shift;
2031 0   0     0 my $nick = shift || return;
2032 0         0 my $server = uc $self->server_name();
2033 0         0 my $ref = [['462']];
2034 0 0       0 return @$ref if wantarray;
2035 0         0 return $ref;
2036             }
2037              
2038             sub _daemon_cmd_user {
2039 0     0   0 my $self = shift;
2040 0   0     0 my $nick = shift || return;
2041 0         0 my $server = uc $self->server_name();
2042 0         0 my $ref = [['462']];
2043 0 0       0 return @$ref if wantarray;
2044 0         0 return $ref;
2045             }
2046              
2047             sub _daemon_cmd_oper {
2048 25     25   80 my $self = shift;
2049 25   50     113 my $nick = shift || return;
2050 25         93 my $server = $self->server_name();
2051 25         112 my $sid = $self->server_sid();
2052 25         90 my $ref = [ ];
2053 25         100 my $args = [@_];
2054 25         76 my $count = @$args;
2055              
2056             SWITCH: {
2057 25 50       61 last SWITCH if $self->state_user_is_operator($nick);
  25         269  
2058 25 50 33     670 if (!$count || $count < 2) {
2059 0         0 push @$ref, ['461', 'OPER'];
2060 0         0 last SWITCH;
2061             }
2062              
2063 25         124 my $record = $self->{state}{users}{uc_irc($nick)};
2064 25         416 my $result = $self->_state_o_line($nick, @$args);
2065 25 100 100     234 if (!$result || $result <= 0) {
2066 3         6 my $omsg; my $errcode = '491';
  3         8  
2067 3 100       21 if (!defined $result) {
    50          
    100          
    50          
2068 1         3 $omsg = 'no operator {} block';
2069             }
2070             elsif ($result == -1) {
2071 0         0 $omsg = 'password mismatch';
2072 0         0 $errcode = '464';
2073             }
2074             elsif ($result == -2) {
2075 1         2 $omsg = 'requires SSL/TLS';
2076             }
2077             elsif ($result == -3) {
2078 1         2 $omsg = 'client certificate fingerprint mismatch';
2079             }
2080             else {
2081 0         0 $omsg = 'host mismatch';
2082             }
2083             $self->_send_to_realops(
2084             sprintf(
2085             'Failed OPER attempt as %s by %s (%s) - %s',
2086 3         17 $args->[0], $nick, (split /!/, $record->{full}->())[1], $omsg),
2087             'Notice',
2088             's',
2089             );
2090 3         11 push @$ref, [$errcode];
2091 3         14 last SWITCH;
2092             }
2093 22         82 my $opuser = $args->[0];
2094 22         181 $self->{stats}{ops}++;
2095 22         143 $record->{umode} .= 'o';
2096 22         78 $record->{opuser} = $opuser;
2097 22         80 $self->{state}{stats}{ops_online}++;
2098 22         196 push @$ref, {
2099             prefix => $server,
2100             command => '381',
2101             params => [$nick, 'You are now an IRC operator'],
2102             };
2103              
2104 22         133 my @peers = $self->_state_connected_peers();
2105              
2106 22 50       144 if (my $whois = $self->{config}{ops}{$opuser}{whois}) {
2107 0         0 $record->{svstags}{313} = {
2108             numeric => '313',
2109             umodes => '+',
2110             tagline => $whois,
2111             };
2112             $self->send_output(
2113             {
2114             prefix => $sid,
2115             command => 'SVSTAG',
2116             params => [
2117             $record->{uid},
2118             $record->{ts},
2119 0         0 '313', '+', $whois,
2120             ],
2121             },
2122             @peers,
2123             );
2124             }
2125              
2126 22   66     130 my $umode = $self->{config}{ops}{$opuser}{umode} || $self->{config}{oper_umode};
2127 22         94 $record->{umode} .= $umode;
2128 22         75 $umode .= 'o';
2129 22         249 $umode = join '', sort split //, $umode;
2130              
2131 22         82 my $uid = $record->{uid};
2132 22         108 my $full = $record->{full}->();
2133              
2134 22         136 my $notice = sprintf("%s{%s} is now an operator",$full,$opuser);
2135              
2136 22         320 $self->send_output(
2137             {
2138             prefix => $sid,
2139             command => 'GLOBOPS',
2140             params => [ $notice ],
2141             },
2142             @peers,
2143             );
2144              
2145 22         177 $self->_send_to_realops( $notice );
2146              
2147 22         161 my $reply = {
2148             prefix => $uid,
2149             command => 'MODE',
2150             params => [$uid, "+$umode"],
2151             };
2152              
2153 22         127 $self->send_output(
2154             $reply,
2155             @peers,
2156             );
2157 22         147 $self->send_event(
2158             "daemon_umode",
2159             $full,
2160             "+$umode",
2161             );
2162              
2163              
2164 22         2814 my $route_id = $record->{route_id};
2165 22         125 $self->{state}{localops}{$route_id} = time;
2166 22         141 $self->antiflood($route_id, 0);
2167 22         66 $reply->{prefix} = $full;
2168 22         96 $reply->{params}[0] = $record->{nick};
2169 22         97 push @$ref, $reply;
2170             }
2171              
2172 25 50       347 return @$ref if wantarray;
2173 0         0 return $ref;
2174             }
2175              
2176             sub _daemon_cmd_die {
2177 1     1   3 my $self = shift;
2178 1   50     5 my $nick = shift || return;
2179 1         4 my $server = $self->server_name();
2180 1         4 my $ref = [ ];
2181              
2182             SWITCH: {
2183 1 50       2 if (!$self->state_user_is_operator($nick)) {
  1         3  
2184 0         0 push @$ref, ['481'];
2185 0         0 last SWITCH;
2186             }
2187 1         5 $self->send_event("daemon_die", $nick);
2188 1         154 $self->shutdown();
2189             }
2190 1 50       6 return @$ref if wantarray;
2191 0         0 return $ref;
2192             }
2193              
2194             sub _daemon_cmd_close {
2195 1     1   3 my $self = shift;
2196 1   50     5 my $nick = shift || return;
2197 1         4 my $server = $self->server_name();
2198 1         4 my $ref = [ ];
2199              
2200             SWITCH: {
2201 1 50       4 if (!$self->state_user_is_operator($nick)) {
  1         6  
2202 0         0 push @$ref, ['723','close'];
2203 0         0 last SWITCH;
2204             }
2205 1         6 $self->send_event("daemon_close", $nick);
2206 1         105 my $count = 0;
2207 1         3 foreach my $conn_id ( keys %{ $self->{state}{conns} } ) {
  1         8  
2208 6 100       21 next if $self->{state}{conns}{$conn_id}{type} ne 'u';
2209 1         3 my $crec = $self->{state}{conns}{$conn_id};
2210             push @$ref, {
2211             prefix => $server,
2212             command => '362',
2213             params => [
2214             $nick,
2215             sprintf(
2216             '%s[%s@%s]',
2217             ( $crec->{name} || $crec->{nick} || '' ),
2218             ( $crec->{user} || 'unknown' ),
2219 1   50     27 $crec->{socket}[0],
      50        
2220             ),
2221             'Closed: status = unknown',
2222             ],
2223             };
2224 1         3 $count++;
2225 1         7 $self->_terminate_conn_error($conn_id,'Oper Closing');
2226             }
2227 1         7 push @$ref, {
2228             prefix => $server,
2229             command => '363',
2230             params => [
2231             $nick,
2232             $count,
2233             'Connections closed',
2234             ],
2235             };
2236             }
2237 1 50       11 return @$ref if wantarray;
2238 0         0 return $ref;
2239             }
2240              
2241             sub _daemon_cmd_set {
2242 5     5   14 my $self = shift;
2243 5   50     18 my $nick = shift || return;
2244 5         15 my $server = $self->server_name();
2245 5         14 my $ref = [ ];
2246 5         13 my $args = [@_];
2247 5         9 my $count = @$args;
2248              
2249             my %vars = (
2250             FLOODCOUNT => sub {
2251 0     0   0 my $val = shift;
2252 0 0 0     0 if ( $val && $val >= 0 ) {
2253 0         0 $self->{config}{floodcount} = $val;
2254 0         0 $self->_send_to_realops(
2255             sprintf(
2256             '%s has changed FLOODCOUNT to %s',
2257             $self->state_user_full($nick,1), $val,
2258             ), qw[Notice s],
2259             );
2260             }
2261             else {
2262             push @$ref, {
2263             prefix => $server,
2264             command => 'NOTICE',
2265             params => [
2266             $nick,
2267             sprintf(
2268             'FLOODCOUNT is currently %s',
2269             $self->{config}{floodcount},
2270 0         0 ),
2271             ],
2272             };
2273             }
2274             },
2275             FLOODTIME => sub {
2276 0     0   0 my $val = shift;
2277 0 0 0     0 if ( $val && $val >= 0 ) {
2278 0         0 $self->{config}{floodtime} = $val;
2279 0         0 $self->_send_to_realops(
2280             sprintf(
2281             '%s has changed FLOODTIME to %s',
2282             $self->state_user_full($nick,1), $val,
2283             ), qw[Notice s],
2284             );
2285             }
2286             else {
2287             push @$ref, {
2288             prefix => $server,
2289             command => 'NOTICE',
2290             params => [
2291             $nick,
2292             sprintf(
2293             'FLOODTIME is currently %s',
2294             $self->{config}{floodtime},
2295 0         0 ),
2296             ],
2297             };
2298             }
2299             },
2300             IDENTTIMEOUT => sub {
2301 0     0   0 my $val = shift;
2302 0 0 0     0 if ( $val && $val >= 0 ) {
2303 0         0 $self->{config}{ident_timeout} = $val;
2304 0         0 $self->_send_to_realops(
2305             sprintf(
2306             '%s has changed IDENTTIMEOUT to %s',
2307             $self->state_user_full($nick,1), $val,
2308             ), qw[Notice s],
2309             );
2310             }
2311             else {
2312             push @$ref, {
2313             prefix => $server,
2314             command => 'NOTICE',
2315             params => [
2316             $nick,
2317             sprintf(
2318             'IDENTTIMEOUT is currently %s',
2319 0   0     0 ( $self->{config}{ident_timeout} || 10 ),
2320             ),
2321             ],
2322             };
2323             }
2324             },
2325             MAX => sub {
2326 2     2   6 my $val = shift;
2327 2 100 66     31 if ( $val && $val >= 0 ) {
2328 1 50       6 if ( $val > 7000 ) {
2329             push @$ref, {
2330             prefix => $server,
2331             command => 'NOTICE',
2332             params => [
2333             $nick,
2334             sprintf(
2335             'You cannot set MAXCLIENTS to > 7000, restoring to %u',
2336             $self->{config}{MAXCLIENTS},
2337 0         0 ),
2338             ],
2339             };
2340 0         0 return;
2341             }
2342 1 50       4 if ( $val < 32 ) {
2343             push @$ref, {
2344             prefix => $server,
2345             command => 'NOTICE',
2346             params => [
2347             $nick,
2348             sprintf(
2349             'You cannot set MAXCLIENTS to < 32, restoring to %u',
2350             $self->{config}{MAXCLIENTS},
2351 1         9 ),
2352             ],
2353             };
2354 1         4 return;
2355             }
2356 0         0 $self->{config}{MAXCLIENTS} = $val;
2357 0         0 $self->_send_to_realops(
2358             sprintf(
2359             '%s has changed MAXCLIENTS to %s',
2360             $self->state_user_full($nick,1), $val,
2361             ), qw[Notice s],
2362             );
2363             }
2364             else {
2365             push @$ref, {
2366             prefix => $server,
2367             command => 'NOTICE',
2368             params => [
2369             $nick,
2370             sprintf(
2371             'MAXCLIENTS is currently %s',
2372             $self->{config}{MAXCLIENTS},
2373 1         9 ),
2374             ],
2375             };
2376             }
2377             },
2378             SPAMNUM => sub {
2379 0     0   0 my $val = shift;
2380 0 0 0     0 if ( defined $val && $val >= 0 ) {
2381 0         0 $self->{config}{MAX_JOIN_LEAVE_COUNT} = $val;
2382 0 0       0 if ( $val == 0 ) {
2383 0         0 $self->_send_to_realops(
2384             sprintf(
2385             '%s has disabled ANTI_SPAMBOT',
2386             $self->state_user_full($nick,1),
2387             ), qw[Notice s],
2388             );
2389             }
2390             else {
2391 0         0 $self->_send_to_realops(
2392             sprintf(
2393             '%s has changed SPAMNUM to %s',
2394             $self->state_user_full($nick,1), $val,
2395             ), qw[Notice s],
2396             );
2397             }
2398             }
2399             else {
2400             push @$ref, {
2401             prefix => $server,
2402             command => 'NOTICE',
2403             params => [
2404             $nick,
2405             sprintf(
2406             'SPAMNUM is currently %s',
2407             $self->{config}{MAX_JOIN_LEAVE_COUNT},
2408 0         0 ),
2409             ],
2410             };
2411             }
2412             },
2413             SPAMTIME => sub {
2414 0     0   0 my $val = shift;
2415 0 0 0     0 if ( $val && $val >= 0 ) {
2416 0         0 $self->{config}{MIN_JOIN_LEAVE_TIME} = $val;
2417 0         0 $self->_send_to_realops(
2418             sprintf(
2419             '%s has changed SPAMTIME to %s',
2420             $self->state_user_full($nick,1), $val,
2421             ), qw[Notice s],
2422             );
2423             }
2424             else {
2425             push @$ref, {
2426             prefix => $server,
2427             command => 'NOTICE',
2428             params => [
2429             $nick,
2430             sprintf(
2431             'SPAMTIME is currently %s',
2432             $self->{config}{MIN_JOIN_LEAVE_TIME},
2433 0         0 ),
2434             ],
2435             };
2436             }
2437             },
2438             JFLOODTIME => sub {
2439 2     2   5 my $val = shift;
2440 2 100 66     11 if ( $val && $val >= 0 ) {
2441 1         3 $self->{config}{joinfloodtime} = $val;
2442 1         6 $self->_send_to_realops(
2443             sprintf(
2444             '%s has changed JFLOODTIME to %s',
2445             $self->state_user_full($nick,1), $val,
2446             ), qw[Notice s],
2447             );
2448             }
2449             else {
2450             push @$ref, {
2451             prefix => $server,
2452             command => 'NOTICE',
2453             params => [
2454             $nick,
2455             sprintf(
2456             'JFLOODTIME is currently %s',
2457             $self->{config}{joinfloodtime},
2458 1         11 ),
2459             ],
2460             };
2461             }
2462             },
2463             JFLOODCOUNT => sub {
2464 0     0   0 my $val = shift;
2465 0 0 0     0 if ( $val && $val >= 0 ) {
2466 0         0 $self->{config}{joinfloodcount} = $val;
2467 0         0 $self->_send_to_realops(
2468             sprintf(
2469             '%s has changed JFLOODCOUNT to %s',
2470             $self->state_user_full($nick,1), $val,
2471             ), qw[Notice s],
2472             );
2473             }
2474             else {
2475             push @$ref, {
2476             prefix => $server,
2477             command => 'NOTICE',
2478             params => [
2479             $nick,
2480             sprintf(
2481             'JFLOODCOUNT is currently %s',
2482             $self->{config}{joinfloodcount},
2483 0         0 ),
2484             ],
2485             };
2486             }
2487             },
2488 5         135 );
2489              
2490             SWITCH: {
2491 5 50       15 if (!$self->state_user_is_operator($nick)) {
  5         15  
2492 0         0 push @$ref, ['481'];
2493 0         0 last SWITCH;
2494             }
2495 5 100       17 if ($count > 0) {
2496 4 50       21 if ( defined $vars{ uc $args->[0] } ) {
2497 4         17 $vars{ uc $args->[0] }->( $args->[1] );
2498 4         12 last SWITCH;
2499             }
2500 0         0 push @$ref, {
2501             prefix => $server,
2502             command => 'NOTICE',
2503             params => [
2504             $nick,
2505             'Variable not found.',
2506             ],
2507             };
2508 0         0 last SWITCH;
2509             }
2510 1         11 push @$ref, {
2511             prefix => $server,
2512             command => 'NOTICE',
2513             params => [
2514             $nick,
2515             'Available QUOTE SET commands:',
2516             ],
2517             };
2518 1         5 my @names;
2519 1         15 foreach my $var ( sort keys %vars ) {
2520 8         29 push @names, $var;
2521 8 100       19 if ( scalar @names == 4 ) {
2522 2         14 push @$ref, {
2523             prefix => $server,
2524             command => 'NOTICE',
2525             params => [
2526             $nick,
2527             join(' ',@names),
2528             ],
2529             };
2530 2         26 @names = ();
2531             }
2532             }
2533 1 50       9 if (@names) {
2534 0         0 push @$ref, {
2535             prefix => $server,
2536             command => 'NOTICE',
2537             params => [
2538             $nick,
2539             join(' ',@names),
2540             ],
2541             };
2542             }
2543             }
2544 5 50       168 return @$ref if wantarray;
2545 0         0 return $ref;
2546             }
2547              
2548             sub _daemon_cmd_rehash {
2549 1     1   3 my $self = shift;
2550 1   50     5 my $nick = shift || return;
2551 1         3 my $server = $self->server_name();
2552 1         3 my $ref = [ ];
2553              
2554             SWITCH: {
2555 1 50       2 if (!$self->state_user_is_operator($nick)) {
  1         3  
2556 0         0 push @$ref, ['481'];
2557 0         0 last SWITCH;
2558             }
2559 1         6 $self->send_event("daemon_rehash", $nick);
2560 1         114 push @$ref, {
2561             prefix => $server,
2562             command => '383',
2563             params => [$nick, 'ircd.conf', 'Rehashing'],
2564             };
2565             }
2566 1 50       11 return @$ref if wantarray;
2567 0         0 return $ref;
2568             }
2569              
2570             sub _daemon_cmd_locops {
2571 0     0   0 my $self = shift;
2572 0   0     0 my $nick = shift || return;
2573 0         0 my $server = $self->server_name();
2574 0         0 my $ref = [ ];
2575 0         0 my $args = [@_];
2576 0         0 my $count = @$args;
2577              
2578             SWITCH: {
2579 0 0       0 if (!$self->state_user_is_operator($nick)) {
  0         0  
2580 0         0 push @$ref, ['723', 'locops'];
2581 0         0 last SWITCH;
2582             }
2583 0 0       0 if (!$count) {
2584 0         0 push @$ref, ['461', 'LOCOPS'];
2585 0         0 last SWITCH;
2586             }
2587 0         0 my $full = $self->state_user_full($nick,1);
2588 0         0 $self->_send_to_realops( "from $nick: " . $args->[0], 'locops', 'l' );
2589 0         0 $self->send_event("daemon_locops", $full, $args->[0]);
2590             }
2591              
2592 0 0       0 return @$ref if wantarray;
2593 0         0 return $ref;
2594             }
2595              
2596             sub _daemon_cmd_wallops {
2597 0     0   0 my $self = shift;
2598 0   0     0 my $nick = shift || return;
2599 0         0 my $server = $self->server_name();
2600 0         0 my $ref = [ ];
2601 0         0 my $args = [@_];
2602 0         0 my $count = @$args;
2603              
2604             SWITCH: {
2605 0 0       0 if (!$self->state_user_is_operator($nick)) {
  0         0  
2606 0         0 push @$ref, ['723', 'wallops'];
2607 0         0 last SWITCH;
2608             }
2609 0 0       0 if (!$count) {
2610 0         0 push @$ref, ['461', 'WALLOPS'];
2611 0         0 last SWITCH;
2612             }
2613              
2614 0         0 my $full = $self->state_user_full($nick);
2615 0         0 my $uid = $self->state_user_uid($nick);
2616              
2617 0         0 $self->send_output(
2618             {
2619             prefix => $uid,
2620             command => 'WALLOPS',
2621             params => [$args->[0]],
2622             },
2623             $self->_state_connected_peers(),
2624             );
2625              
2626             $self->send_output(
2627             {
2628             prefix => $full,
2629             command => 'WALLOPS',
2630             params => [$args->[0]],
2631             },
2632 0         0 keys %{ $self->{state}{wallops} },
  0         0  
2633             );
2634              
2635 0         0 $self->send_event("daemon_wallops", $full, $args->[0]);
2636             }
2637              
2638 0 0       0 return @$ref if wantarray;
2639 0         0 return $ref;
2640             }
2641              
2642             sub _daemon_cmd_globops {
2643 0     0   0 my $self = shift;
2644 0   0     0 my $nick = shift || return;
2645 0         0 my $server = $self->server_name();
2646 0         0 my $sid = $self->server_sid();
2647 0         0 my $ref = [ ];
2648 0         0 my $args = [@_];
2649 0         0 my $count = @$args;
2650              
2651             SWITCH: {
2652 0 0       0 if (!$self->state_user_is_operator($nick)) {
  0         0  
2653 0         0 push @$ref, ['723', 'globops'];
2654 0         0 last SWITCH;
2655             }
2656 0 0       0 if (!$count) {
2657 0         0 push @$ref, ['461', 'GLOBOPS'];
2658 0         0 last SWITCH;
2659             }
2660              
2661             $self->send_output(
2662             {
2663 0         0 prefix => $self->state_user_uid($nick),
2664             command => 'GLOBOPS',
2665             params => [ $args->[0] ],
2666             },
2667             $self->_state_connected_peers(),
2668             );
2669              
2670 0         0 my $msg = "from $nick: " . $args->[0];
2671              
2672 0         0 $self->_send_to_realops(
2673             $msg,
2674             'Globops',
2675             's',
2676             );
2677              
2678 0         0 $self->send_event("daemon_globops", $nick, $args->[0]);
2679             }
2680 0 0       0 return @$ref if wantarray;
2681 0         0 return $ref;
2682             }
2683              
2684             sub _daemon_cmd_connect {
2685 0     0   0 my $self = shift;
2686 0   0     0 my $nick = shift || return;
2687 0         0 my $server = $self->server_name();
2688 0         0 my $ref = [ ];
2689 0         0 my $args = [@_];
2690 0         0 my $count = @$args;
2691              
2692             SWITCH: {
2693 0 0       0 if (!$self->state_user_is_operator($nick)) {
  0         0  
2694 0         0 push @$ref, ['481'];
2695 0         0 last SWITCH;
2696             }
2697 0 0       0 if (!$count) {
2698 0         0 push @$ref, ['461', 'CONNECT'];
2699 0         0 last SWITCH;
2700             }
2701 0 0 0     0 if ($count >= 3 && !$self->state_peer_exists($args->[2])) {
2702 0         0 push @$ref, ['402', $args->[2]];
2703 0         0 last SWITCH;
2704             }
2705 0 0 0     0 if ($count >= 3 && uc $server ne uc $args->[2]) {
2706 0         0 $args->[2] = $self->_state_peer_name($args->[2]);
2707 0         0 $self->send_output(
2708             {
2709             prefix => $nick,
2710             command => 'CONNECT',
2711             params => $args,
2712             },
2713             $self->_state_peer_route($args->[2]),
2714             );
2715 0         0 last SWITCH;
2716             }
2717 0 0 0     0 if (!$self->{config}{peers}{uc $args->[0]}
2718             || $self->{config}{peers}{uc $args->[0]}{type} ne 'r') {
2719 0         0 push @$ref, {
2720             command => 'NOTICE',
2721             params => [
2722             $nick,
2723             "Connect: Host $args->[0] is not listed in ircd.conf",
2724             ],
2725             };
2726 0         0 last SWITCH;
2727             }
2728 0 0       0 if (my $peer_name = $self->_state_peer_name($args->[0])) {
2729 0         0 push @$ref, {
2730             command => 'NOTICE',
2731             params => [
2732             $nick,
2733             "Connect: Server $args->[0] already exists from $peer_name.",
2734             ],
2735             };
2736 0         0 last SWITCH;
2737             }
2738              
2739 0         0 my $connector = $self->{config}{peers}{uc $args->[0]};
2740 0         0 my $name = $connector->{name};
2741 0   0     0 my $rport = $args->[1] || $connector->{rport};
2742 0         0 my $raddr = $connector->{raddress};
2743 0         0 $self->add_connector(
2744             remoteaddress => $raddr,
2745             remoteport => $rport,
2746             name => $name,
2747             );
2748             }
2749              
2750 0 0       0 return @$ref if wantarray;
2751 0         0 return $ref;
2752             }
2753              
2754             sub _daemon_cmd_squit {
2755 0     0   0 my $self = shift;
2756 0   0     0 my $nick = shift || return;
2757 0         0 my $server = $self->server_name();
2758 0         0 my $ref = [ ];
2759 0         0 my $args = [@_];
2760 0         0 my $count = @$args;
2761              
2762             SWITCH: {
2763 0 0       0 if (!$self->state_user_is_operator($nick)) {
  0         0  
2764 0         0 push @$ref, ['481'];
2765 0         0 last SWITCH;
2766             }
2767 0 0       0 if (!$count) {
2768 0         0 push @$ref, ['461', 'SQUIT'];
2769 0         0 last SWITCH;
2770             }
2771 0 0 0     0 if (!$self->state_peer_exists($args->[0])
2772             || uc $server eq uc $args->[0]) {
2773 0         0 push @$ref, ['402', $args->[0]];
2774 0         0 last SWITCH;
2775             }
2776              
2777 0         0 my $peer = uc $args->[0];
2778 0   0     0 my $reason = $args->[1] || 'No Reason';
2779 0         0 $args->[0] = $self->_state_peer_name($peer);
2780 0         0 $args->[1] = $reason;
2781              
2782 0         0 my $conn_id = $self->_state_peer_route($peer);
2783              
2784 0 0       0 if ( !grep { $_ eq $peer }
  0         0  
2785 0         0 keys %{ $self->{state}{peers}{uc $server}{peers} }) {
2786 0         0 $self->send_output(
2787             {
2788             prefix => $self->state_user_uid($nick),
2789             command => 'SQUIT',
2790             params => [ $self->_state_peer_sid($peer), $reason ],
2791             },
2792             $conn_id,
2793             );
2794 0         0 last SWITCH;
2795             }
2796              
2797 0         0 $self->disconnect($conn_id, $reason);
2798 0         0 $self->send_output(
2799             {
2800             command => 'ERROR',
2801             params => [
2802             join ' ', 'Closing Link:',
2803             $self->_client_ip($conn_id), $args->[0], "($nick)"
2804             ],
2805             },
2806             $conn_id,
2807             );
2808             }
2809              
2810 0 0       0 return @$ref if wantarray;
2811 0         0 return $ref;
2812             }
2813              
2814             sub _daemon_cmd_rkline {
2815 2     2   5 my $self = shift;
2816 2   50     8 my $nick = shift || return;
2817 2         8 my $server = $self->server_name();
2818 2         5 my $ref = [ ];
2819 2         7 my $args = [@_];
2820 2         6 my $count = @$args;
2821              
2822             SWITCH: {
2823 2 50       4 if (!$self->state_user_is_operator($nick)) {
  2         9  
2824 0         0 push @$ref, ['481'];
2825 0         0 last SWITCH;
2826             }
2827 2 50 33     28 if (!$count || $count < 1) {
2828 0         0 push @$ref, ['461', 'RKLINE'];
2829 0         0 last SWITCH;
2830             }
2831 2         81 my $duration = 0;
2832 2 100       24 if ($args->[0] =~ /^\d+$/) {
2833 1         3 $duration = shift @$args;
2834 1 50       4 $duration = 14400 if $duration > 14400;
2835             }
2836 2         6 my $mask = shift @$args;
2837 2 50       6 if (!$mask) {
2838 0         0 push @$ref, ['461', 'RKLINE'];
2839 0         0 last SWITCH;
2840             }
2841 2         10 my ($user, $host) = split /\@/, $mask;
2842 2 50 33     12 if (!$user || !$host) {
2843 0         0 last SWITCH;
2844             }
2845 2         12 my $full = $self->state_user_full($nick);
2846 2         4 my $reason;
2847              
2848             {
2849 2 50       4 if (!$reason) {
  2         16  
2850 2   50     18 $reason = pop @$args || '';
2851             }
2852             $self->send_event(
2853 2         13 "daemon_rkline",
2854             $full,
2855             $server,
2856             $duration,
2857             $user,
2858             $host,
2859             $reason,
2860             );
2861              
2862 2 50       239 last SWITCH if !$self->_state_add_drkx_line( 'rkline', $full, time(),
2863             $server, $duration * 60,
2864             $user, $host, $reason );
2865              
2866 2 100       10 my $temp = $duration ? "temporary $duration min. " : '';
2867              
2868 2         10 my $reply_notice = "Added ${temp}RK-Line [$user\@host]";
2869 2         11 my $locop_notice = "$full added ${temp}RK-Line for [$user\@$host] [$reason]";
2870              
2871 2         10 push @$ref, {
2872             prefix => $server,
2873             command => 'NOTICE',
2874             params => [ $nick, $reply_notice ],
2875             };
2876              
2877 2         9 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
2878              
2879 2         13 $self->_state_do_local_users_match_rkline($user, $host, $reason);
2880             }
2881             }
2882              
2883 2 50       14 return @$ref if wantarray;
2884 2         8 return $ref;
2885             }
2886              
2887             sub _daemon_cmd_unrkline {
2888 1     1   3 my $self = shift;
2889 1   50     5 my $nick = shift || return;
2890 1         6 my $server = $self->server_name();
2891 1         3 my $ref = [ ];
2892 1         4 my $args = [@_];
2893 1         3 my $count = @$args;
2894              
2895             SWITCH: {
2896 1 50       2 if (!$self->state_user_is_operator($nick)) {
  1         5  
2897 0         0 push @$ref, ['481'];
2898 0         0 last SWITCH;
2899             }
2900 1 50 33     8 if (!$count || $count < 1) {
2901 0         0 push @$ref, ['461', 'UNRKLINE'];
2902 0         0 last SWITCH;
2903             }
2904 1         7 my ($user, $host) = split /\@/, $args->[0];
2905 1 50 33     7 if (!$user || !$host) {
2906 0         0 last SWITCH;
2907             }
2908              
2909 1         7 my $result = $self->_state_del_drkx_line( 'rkline', $user, $host );
2910              
2911 1 50       4 if ( !$result ) {
2912 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, "No RK-Line for [$user\@$host] found" ] };
2913 0         0 last SWITCH;
2914             }
2915              
2916 1         5 my $full = $self->state_user_full($nick);
2917              
2918 1         6 $self->send_event(
2919             "daemon_unrkline", $full, $server, $user, $host,
2920             );
2921              
2922 1         117 push @$ref, {
2923             prefix => $server,
2924             command => 'NOTICE',
2925             params => [ $nick, "RK-Line for [$user\@$host] is removed" ],
2926             };
2927              
2928 1         10 $self->_send_to_realops( "$full has removed the RK-Line for: [$user\@$host]", 'Notice', 's' );
2929             }
2930              
2931 1 50       4 return @$ref if wantarray;
2932 1         4 return $ref;
2933             }
2934              
2935             sub _daemon_cmd_kline {
2936 4     4   10 my $self = shift;
2937 4   50     15 my $nick = shift || return;
2938 4         13 my $server = $self->server_name();
2939 4         11 my $ref = [ ];
2940 4         12 my $args = [@_];
2941 4         83 my $count = @$args;
2942             # KLINE [time] [ ON ] :[reason]
2943              
2944             SWITCH: {
2945 4 50       13 if (!$self->state_user_is_operator($nick)) {
  4         20  
2946 0         0 push @$ref, ['481'];
2947 0         0 last SWITCH;
2948             }
2949 4 50 33     44 if (!$count || $count < 1) {
2950 0         0 push @$ref, ['461', 'KLINE'];
2951 0         0 last SWITCH;
2952             }
2953 4         75 my $duration = 0;
2954 4 100       46 if ($args->[0] =~ /^\d+$/) {
2955 2         8 $duration = shift @$args;
2956 2 50       8 $duration = 14400 if $duration > 14400;
2957             }
2958 4         11 my $mask = shift @$args;
2959 4 50       14 if (!$mask) {
2960 0         0 push @$ref, ['461', 'KLINE'];
2961 0         0 last SWITCH;
2962             }
2963 4         10 my ($user, $host);
2964 4 50       18 if ($mask !~ /\@/) {
2965 0 0       0 if (my $rogue = $self->_state_user_full($mask)) {
2966 0         0 ($user, $host) = (split /[!\@]/, $rogue )[1..2];
2967             }
2968             else {
2969 0         0 push @$ref, ['401', $mask];
2970 0         0 last SWITCH;
2971             }
2972             }
2973             else {
2974 4         123 ($user, $host) = split /\@/, $mask;
2975             }
2976              
2977 4         22 my $full = $self->state_user_full($nick);
2978 4         11 my $us = 0;
2979 4         14 my $ucserver = uc $server;
2980 4 50 66     35 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
2981             && scalar @$args < 2) {
2982 0         0 push @$ref, ['461', 'KLINE'];
2983 0         0 last SWITCH;
2984             }
2985 4         22 my ($target, $reason);
2986 4 100 66     39 if ($args->[0] && uc $args->[0] eq 'ON') {
2987 1         3 my $on = shift @$args;
2988 1         4 $target = shift @$args;
2989 1   50     100 $reason = shift @$args || 'No Reason';
2990 1         6 my %targets;
2991              
2992 1         3 for my $peer (keys %{ $self->{state}{peers} }) {
  1         7  
2993 4 50       12 if (matches_mask($target, $peer)) {
2994 4 100       185 if ($ucserver eq $peer) {
2995 1         3 $us = 1;
2996             }
2997             else {
2998 3         10 $targets{ $self->_state_peer_route($peer) }++;
2999             }
3000             }
3001             }
3002              
3003             $self->send_output(
3004             {
3005             prefix => $self->state_user_uid($nick),
3006             command => 'KLINE',
3007             params => [
3008             $target,
3009             $duration * 60,
3010             $user,
3011             $host,
3012             $reason,
3013             ],
3014             },
3015 1         4 grep { $self->_state_peer_capab($_, 'KLN') } keys %targets,
  2         24  
3016             );
3017             }
3018             else {
3019 3         9 $us = 1;
3020             }
3021              
3022 4 50       16 if ($us) {
3023 4 100       12 $target = $server if !$target;
3024 4 100       20 if (!$reason) {
3025 3   50     13 $reason = pop @$args || 'No Reason';
3026             }
3027              
3028 4 50       28 last SWITCH if !$self->_state_add_drkx_line( 'kline', $full, time(), $server,
3029             $duration * 60, $user, $host, $reason );
3030 4         28 $self->send_event(
3031             "daemon_kline",
3032             $full,
3033             $target,
3034             $duration,
3035             $user,
3036             $host,
3037             $reason,
3038             );
3039              
3040 4 100       513 my $temp = $duration ? "temporary $duration min. " : '';
3041              
3042 4         18 my $reply_notice = "Added ${temp}K-Line [$user\@host]";
3043 4         16 my $locop_notice = "$full added ${temp}K-Line for [$user\@$host] [$reason]";
3044              
3045 4         22 push @$ref, {
3046             prefix => $server,
3047             command => 'NOTICE',
3048             params => [ $nick, $reply_notice ],
3049             };
3050              
3051 4         27 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3052              
3053 4         22 $self->_state_do_local_users_match_kline($user, $host, $reason);
3054             }
3055             }
3056              
3057 4 50       14 return @$ref if wantarray;
3058 4         15 return $ref;
3059             }
3060              
3061             sub _daemon_cmd_unkline {
3062 2     2   7 my $self = shift;
3063 2   50     8 my $nick = shift || return;
3064 2         10 my $server = $self->server_name();
3065 2         5 my $ref = [ ];
3066 2         7 my $args = [@_];
3067 2         6 my $count = @$args;
3068             # UNKLINE [ ON ]
3069              
3070             SWITCH: {
3071 2 50       4 if (!$self->state_user_is_operator($nick)) {
  2         8  
3072 0         0 push @$ref, ['481'];
3073 0         0 last SWITCH;
3074             }
3075 2 50 33     15 if (!$count || $count < 1) {
3076 0         0 push @$ref, ['461', 'UNKLINE'];
3077 0         0 last SWITCH;
3078             }
3079 2         6 my ($user, $host);
3080 2 50       11 if ($args->[0] !~ /\@/) {
3081 0 0       0 if (my $rogue = $self->state_user_full($args->[0])) {
3082 0         0 ($user, $host) = (split /[!\@]/, $rogue)[1..2]
3083             }
3084             else {
3085 0         0 push @$ref, ['401', $args->[0]];
3086 0         0 last SWITCH;
3087             }
3088             }
3089             else {
3090 2         10 ($user, $host) = split /\@/, $args->[0];
3091             }
3092              
3093 2         9 my $full = $self->state_user_full($nick);
3094 2         5 my $us = 0;
3095 2         7 my $ucserver = uc $server;
3096 2 50 66     14 if ($count > 1 && uc $args->[2] eq 'ON' && $count < 3) {
      33        
3097 0         0 push @$ref, ['461', 'UNKLINE'];
3098 0         0 last SWITCH;
3099             }
3100 2 50 66     15 if ($count > 1 && $args->[2] && uc $args->[2] eq 'ON') {
      33        
3101 0         0 my $target = $args->[3];
3102 0         0 my %targets;
3103 0         0 for my $peer (keys %{ $self->{state}{peers} }) {
  0         0  
3104 0 0       0 if (matches_mask($target, $peer)) {
3105 0 0       0 if ($ucserver eq $peer) {
3106 0         0 $us = 1;
3107             }
3108             else {
3109 0         0 $targets{ $self->_state_peer_route( $peer ) }++;
3110             }
3111             }
3112             }
3113              
3114             $self->send_output(
3115             {
3116             prefix => $self->state_user_uid($nick),
3117             command => 'UNKLINE',
3118             params => [$target, $user, $host],
3119             colonify => 0,
3120             },
3121 0         0 grep { $self->_state_peer_capab($_, 'UNKLN') } keys %targets,
  0         0  
3122             );
3123             }
3124             else {
3125 2         5 $us = 1;
3126             }
3127              
3128 2 50       7 last SWITCH if !$us;
3129              
3130 2   33     26 my $target = $args->[3] || $server;
3131              
3132 2         11 my $result = $self->_state_del_drkx_line( 'kline', $user, $host );
3133              
3134 2 50       8 if ( !$result ) {
3135 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, "No K-Line for [$user\@$host] found" ] };
3136 0         0 last SWITCH;
3137             }
3138              
3139             $self->send_event(
3140 2         10 "daemon_unkline", $full, $target, $user, $host,
3141             );
3142              
3143 2         213 push @$ref, {
3144             prefix => $server,
3145             command => 'NOTICE',
3146             params => [ $nick, "K-Line for [$user\@$host] is removed" ],
3147             };
3148              
3149 2         25 $self->_send_to_realops( "$full has removed the K-Line for: [$user\@$host]", 'Notice', 's' );
3150             }
3151              
3152 2 50       10 return @$ref if wantarray;
3153 2         8 return $ref;
3154             }
3155              
3156             sub _daemon_cmd_resv {
3157 6     6   18 my $self = shift;
3158 6   50     24 my $nick = shift || return;
3159 6         25 my $server = $self->server_name();
3160 6         35 my $sid = $self->server_sid();
3161 6         61 my $ref = [ ];
3162 6         26 my $args = [ @_ ];
3163 6         18 my $count = @$args;
3164              
3165             SWITCH: {
3166 6 50       14 if (!$self->state_user_is_operator($nick)) {
  6         32  
3167 0         0 push @$ref, ['481'];
3168 0         0 last SWITCH;
3169             }
3170 6 50 33     98 if (!$count || $count < 2) {
3171 0         0 push @$ref, ['461', 'RESV'];
3172 0         0 last SWITCH;
3173             }
3174 6         31 my $duration = 0;
3175 6 100       51 if ($args->[0] =~ /^\d+$/) {
3176 2         6 $duration = shift @$args;
3177 2 50       19 $duration = 14400 if $duration > 14400;
3178             }
3179 6         19 my $mask = shift @$args;
3180 6 50       23 if (!$mask) {
3181 0         0 push @$ref, ['461', 'RESV'];
3182 0         0 last SWITCH;
3183             }
3184 6 50 66     89 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
3185             && scalar @$args < 2) {
3186 0         0 push @$ref, ['461', 'RESV'];
3187 0         0 last SWITCH;
3188             }
3189 6         133 my ($peermask,$reason);
3190 6         20 my $us = 0;
3191 6 100 66     48 if ($args->[0] && uc $args->[0] eq 'ON') {
3192 1         4 my $on = shift @$args;
3193 1         3 $peermask = shift @$args;
3194 1   50     4 $reason = shift @$args || '';
3195 1         3 my %targpeers; my $ucserver = uc $server;
  1         3  
3196 1         4 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         8  
3197 4 50       19 if (matches_mask($peermask, $peer)) {
3198 4 100       191 if ($ucserver eq $peer) {
3199 1         3 $us = 1;
3200             }
3201             else {
3202 3         12 $targpeers{ $self->_state_peer_route($peer) }++;
3203             }
3204             }
3205             }
3206             $self->send_output(
3207             {
3208             prefix => $self->state_user_uid($nick),
3209             command => 'RESV',
3210             params => [
3211             $peermask,
3212             ( $duration * 60 ),
3213             $mask,
3214             $reason,
3215             ],
3216             },
3217 1         4 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         25  
3218             );
3219             }
3220             else {
3221 5         12 $us = 1;
3222             }
3223              
3224 6 50       23 last SWITCH if !$us;
3225              
3226 6 50       34 if ( $self->_state_have_resv($mask) ) {
3227 0         0 push @$ref, {
3228             prefix => $server,
3229             command => 'NOTICE',
3230             params => [ $nick, "A RESV has already been placed on: $mask" ],
3231             };
3232 0         0 last SWITCH;
3233             }
3234              
3235 6 100       21 if ( !$reason ) {
3236 5   50     17 $reason = shift @$args || '';
3237             }
3238              
3239 6         33 my $full = $self->state_user_full($nick);
3240              
3241 6 50       62 last SWITCH if !$self->_state_add_drkx_line( 'resv', $full, time(), $server,
3242             $duration * 60, $mask, $reason );
3243 6         42 $self->send_event(
3244             "daemon_resv",
3245             $full,
3246             $mask,
3247             $duration,
3248             $reason,
3249             );
3250              
3251 6 100       697 my $temp = $duration ? "temporary $duration min. " : '';
3252              
3253 6         32 my $reply_notice = "Added ${temp}RESV [$mask]";
3254 6         32 my $locop_notice = "$full added ${temp}RESV for [$mask] [$reason]";
3255              
3256 6         34 push @$ref, {
3257             prefix => $server,
3258             command => 'NOTICE',
3259             params => [ $nick, $reply_notice ],
3260             };
3261              
3262 6         41 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3263              
3264             }
3265              
3266 6 50       30 return @$ref if wantarray;
3267 6         25 return $ref;
3268             }
3269              
3270             sub _daemon_cmd_unresv {
3271 4     4   14 my $self = shift;
3272 4   50     18 my $nick = shift || return;
3273 4         17 my $server = $self->server_name();
3274 4         15 my $sid = $self->server_sid();
3275 4         13 my $ref = [ ];
3276 4         13 my $args = [ @_ ];
3277 4         11 my $count = @$args;
3278              
3279             SWITCH: {
3280 4 50       9 if (!$self->state_user_is_operator($nick)) {
  4         29  
3281 0         0 push @$ref, ['481'];
3282 0         0 last SWITCH;
3283             }
3284 4 50       15 if (!$count ) {
3285 0         0 push @$ref, ['461', 'UNRESV'];
3286 0         0 last SWITCH;
3287             }
3288 4         27 my $unmask = shift @$args;
3289 4 50 66     28 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
3290             && scalar @$args < 2) {
3291 0         0 push @$ref, ['461', 'UNRESV'];
3292 0         0 last SWITCH;
3293             }
3294 4         11 my $us = 0;
3295 4 100 66     25 if ($args->[0] && uc $args->[0] eq 'ON') {
3296 1         3 my $on = shift @$args;
3297 1         3 my $peermask = shift @$args;
3298 1         3 my %targpeers; my $ucserver = uc $server;
  1         3  
3299 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         8  
3300 4 50       12 if (matches_mask($peermask, $peer)) {
3301 4 100       176 if ($ucserver eq $peer) {
3302 1         3 $us = 1;
3303             }
3304             else {
3305 3         12 $targpeers{ $self->_state_peer_route($peer) }++;
3306             }
3307             }
3308             }
3309             $self->send_output(
3310             {
3311             prefix => $self->state_user_uid($nick),
3312             command => 'UNRESV',
3313             params => [
3314             $peermask,
3315             $unmask,
3316             ],
3317             colonify => 0,
3318             },
3319 1         6 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         24  
3320             );
3321             }
3322             else {
3323 3         7 $us = 1;
3324             }
3325              
3326 4 50       17 last SWITCH if !$us;
3327              
3328 4         25 my $result = $self->_state_del_drkx_line( 'resv', $unmask );
3329              
3330 4 50       23 if ( !$result ) {
3331 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, "No RESV for [$unmask] found" ] };
3332 0         0 last SWITCH;
3333             }
3334              
3335 4         16 my $full = $self->state_user_full($nick);
3336 4         24 $self->send_event(
3337             "daemon_unresv",
3338             $full,
3339             $unmask,
3340             );
3341              
3342 4         465 push @$ref, {
3343             prefix => $server,
3344             command => 'NOTICE',
3345             params => [ $nick, "RESV for [$unmask] is removed" ],
3346             };
3347              
3348 4         31 $self->_send_to_realops( "$full has removed the RESV for: [$unmask]", 'Notice', 's' );
3349             }
3350              
3351 4 50       28 return @$ref if wantarray;
3352 4         35 return $ref;
3353             }
3354              
3355             sub _daemon_cmd_xline {
3356 3     3   8 my $self = shift;
3357 3   50     22 my $nick = shift || return;
3358 3         13 my $server = $self->server_name();
3359 3         13 my $sid = $self->server_sid();
3360 3         10 my $ref = [ ];
3361 3         9 my $args = [ @_ ];
3362 3         9 my $count = @$args;
3363              
3364             SWITCH: {
3365 3 50       6 if (!$self->state_user_is_operator($nick)) {
  3         19  
3366 0         0 push @$ref, ['481'];
3367 0         0 last SWITCH;
3368             }
3369 3 50 33     32 if (!$count || $count < 2) {
3370 0         0 push @$ref, ['461', 'XLINE'];
3371 0         0 last SWITCH;
3372             }
3373 3         9 my $duration = 0;
3374 3 100       23 if ($args->[0] =~ /^\d+$/) {
3375 2         7 $duration = shift @$args;
3376 2 50       9 $duration = 14400 if $duration > 14400;
3377             }
3378 3         8 my $mask = shift @$args;
3379 3 50       11 if (!$mask) {
3380 0         0 push @$ref, ['461', 'XLINE'];
3381 0         0 last SWITCH;
3382             }
3383 3 50 66     28 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
3384             && scalar @$args < 2) {
3385 0         0 push @$ref, ['461', 'XLINE'];
3386 0         0 last SWITCH;
3387             }
3388 3         108 my ($peermask,$reason);
3389 3         8 my $us = 0;
3390 3 100 66     21 if ($args->[0] && uc $args->[0] eq 'ON') {
3391 1         3 my $on = shift @$args;
3392 1         3 $peermask = shift @$args;
3393 1   50     3 $reason = shift @$args || '';
3394 1         3 my %targpeers; my $ucserver = uc $server;
  1         3  
3395 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         7  
3396 4 50       14 if (matches_mask($peermask, $peer)) {
3397 4 100       212 if ($ucserver eq $peer) {
3398 1         86 $us = 1;
3399             }
3400             else {
3401 3         11 $targpeers{ $self->_state_peer_route($peer) }++;
3402             }
3403             }
3404             }
3405             $self->send_output(
3406             {
3407             prefix => $self->state_user_uid($nick),
3408             command => 'XLINE',
3409             params => [
3410             $peermask,
3411             ( $duration * 60 ),
3412             $mask,
3413             $reason,
3414             ],
3415             },
3416 1         11 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         23  
3417             );
3418             }
3419             else {
3420 2         5 $us = 1;
3421             }
3422              
3423 3 50       15 last SWITCH if !$us;
3424              
3425 3 100       11 if ( !$reason ) {
3426 2   50     7 $reason = shift @$args || '';
3427             }
3428              
3429 3         15 my $full = $self->state_user_full($nick);
3430              
3431 3 50       22 last SWITCH if !$self->_state_add_drkx_line( 'xline', $full, time(), $server,
3432             $duration * 60, $mask, $reason );
3433 3         27 $self->send_event(
3434             "daemon_xline",
3435             $full,
3436             $mask,
3437             $duration,
3438             $reason,
3439             );
3440              
3441 3 100       358 my $temp = $duration ? "temporary $duration min. " : '';
3442              
3443 3         12 my $reply_notice = "Added ${temp}X-Line [$mask]";
3444 3         15 my $locop_notice = "$full added ${temp}X-Line for [$mask] [$reason]";
3445              
3446 3         16 push @$ref, {
3447             prefix => $server,
3448             command => 'NOTICE',
3449             params => [ $nick, $reply_notice ],
3450             };
3451              
3452 3         16 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3453              
3454 3         20 $self->_state_do_local_users_match_xline($mask,$reason);
3455             }
3456              
3457 3 50       12 return @$ref if wantarray;
3458 3         12 return $ref;
3459             }
3460              
3461             sub _daemon_cmd_unxline {
3462 2     2   6 my $self = shift;
3463 2   50     12 my $nick = shift || return;
3464 2         8 my $server = $self->server_name();
3465 2         8 my $sid = $self->server_sid();
3466 2         6 my $ref = [ ];
3467 2         8 my $args = [ @_ ];
3468 2         8 my $count = @$args;
3469              
3470             SWITCH: {
3471 2 50       4 if (!$self->state_user_is_operator($nick)) {
  2         10  
3472 0         0 push @$ref, ['481'];
3473 0         0 last SWITCH;
3474             }
3475 2 50       7 if (!$count ) {
3476 0         0 push @$ref, ['461', 'UNXLINE'];
3477 0         0 last SWITCH;
3478             }
3479 2         7 my $unmask = shift @$args;
3480 2 50 66     20 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
3481             && scalar @$args < 2) {
3482 0         0 push @$ref, ['461', 'UNXLINE'];
3483 0         0 last SWITCH;
3484             }
3485 2         6 my $us = 0;
3486 2 100 66     14 if ($args->[0] && uc $args->[0] eq 'ON') {
3487 1         3 my $on = shift @$args;
3488 1         3 my $peermask = shift @$args;
3489 1         3 my %targpeers; my $ucserver = uc $server;
  1         3  
3490 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         7  
3491 4 50       9 if (matches_mask($peermask, $peer)) {
3492 4 100       163 if ($ucserver eq $peer) {
3493 1         5 $us = 1;
3494             }
3495             else {
3496 3         9 $targpeers{ $self->_state_peer_route($peer) }++;
3497             }
3498             }
3499             }
3500             $self->send_output(
3501             {
3502             prefix => $self->state_user_uid($nick),
3503             command => 'UNXLINE',
3504             params => [
3505             $peermask,
3506             $unmask,
3507             ],
3508             colonify => 0,
3509             },
3510 1         4 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         24  
3511             );
3512             }
3513             else {
3514 1         3 $us = 1;
3515             }
3516              
3517 2 50       12 last SWITCH if !$us;
3518              
3519 2         12 my $result = $self->_state_del_drkx_line( 'xline', $unmask );
3520              
3521 2 50       7 if ( !$result ) {
3522 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, "No X-Line for [$unmask] found" ] };
3523 0         0 last SWITCH;
3524             }
3525              
3526 2         11 my $full = $self->state_user_full($nick);
3527 2         11 $self->send_event(
3528             "daemon_unxline",
3529             $full,
3530             $unmask,
3531             );
3532              
3533 2         236 push @$ref, {
3534             prefix => $server,
3535             command => 'NOTICE',
3536             params => [ $nick, "X-Line for [$unmask] is removed" ],
3537             };
3538              
3539 2         14 $self->_send_to_realops( "$full has removed the X-Line for: [$unmask]", 'Notice', 's' );
3540             }
3541              
3542 2 50       35 return @$ref if wantarray;
3543 2         11 return $ref;
3544             }
3545              
3546             sub _daemon_cmd_dline {
3547 3     3   10 my $self = shift;
3548 3   50     13 my $nick = shift || return;
3549 3         17 my $server = $self->server_name();
3550 3         25 my $sid = $self->server_sid();
3551 3         9 my $ref = [ ];
3552 3         12 my $args = [ @_ ];
3553 3         10 my $count = @$args;
3554              
3555             SWITCH: {
3556 3 50       11 if (!$self->state_user_is_operator($nick)) {
  3         17  
3557 0         0 push @$ref, ['481'];
3558 0         0 last SWITCH;
3559             }
3560 3 50 33     41 if (!$count || $count < 2) {
3561 0         0 push @$ref, ['461', 'DLINE'];
3562 0         0 last SWITCH;
3563             }
3564 3         10 my $duration = 0;
3565 3 100       36 if ($args->[0] =~ /^\d+$/) {
3566 2         7 $duration = shift @$args;
3567 2 50       13 $duration = 14400 if $duration > 14400;
3568             }
3569 3         12 my $mask = shift @$args;
3570 3 50       13 if (!$mask) {
3571 0         0 push @$ref, ['461', 'KLINE'];
3572 0         0 last SWITCH;
3573             }
3574 3         7 my $netmask;
3575 3 50 33     178 if ( $mask !~ m![:.]! && $self->state_nick_exists($mask) ) {
    50 33        
3576 0         0 my $uid = $self->state_user_uid($mask);
3577 0 0       0 if ( $uid !~ m!^$sid! ) {
3578 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, 'Cannot DLINE nick on another server' ] };
3579 0         0 last SWITCH;
3580             }
3581 0 0 0     0 if ( $self->{state}{uids}{$uid}{umode} =~ m!o! || $self->{state}{uids}{$uid}{route_id} eq 'spoofed' ) {
3582 0         0 my $tnick = $self->{state}{uids}{$uid}{nick};
3583 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, "$tnick is E-lined" ] };
3584 0         0 last SWITCH;
3585             }
3586 0         0 my $addr = $self->{state}{uids}{$uid}{socket}[0];
3587 0         0 $netmask = Net::CIDR::cidrvalidate($addr);
3588             }
3589             elsif ( $mask !~ m![:.]! && !$self->state_nick_exists($mask) ) {
3590 0         0 push @$ref, ['401', $mask];
3591 0         0 last SWITCH;
3592             }
3593 3 50       13 if ( !$netmask ) {
3594 3         23 $netmask = Net::CIDR::cidrvalidate($mask);
3595 3 50       2036 if ( !$netmask ) {
3596 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, 'Unable to parse provided IP mask' ] };
3597 0         0 last SWITCH;
3598             }
3599             }
3600 3 50 66     33 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
3601             && scalar @$args < 2) {
3602 0         0 push @$ref, ['461', 'DLINE'];
3603 0         0 last SWITCH;
3604             }
3605 3         9 my ($peermask,$reason,$on);
3606 3         20 my $us = 0;
3607 3 100 66     60 if ($args->[0] && uc $args->[0] eq 'ON') {
3608 1         4 $on = shift @$args;
3609 1         3 $peermask = shift @$args;
3610 1   50     3 $reason = shift @$args || '';
3611 1         3 my %targpeers; my $ucserver = uc $server;
  1         4  
3612 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         9  
3613 4 50       15 if (matches_mask($peermask, $peer)) {
3614 4 100       201 if ($ucserver eq $peer) {
3615 1         3 $us = 1;
3616             }
3617             else {
3618 3         11 $targpeers{ $self->_state_peer_route($peer) }++;
3619             }
3620             }
3621             }
3622             $self->send_output(
3623             {
3624             prefix => $self->state_user_uid($nick),
3625             command => 'DLINE',
3626             params => [
3627             $peermask,
3628             ( $duration * 60 ),
3629             $netmask,
3630             $reason,
3631             ],
3632             },
3633 1         5 grep { $self->_state_peer_capab($_, 'DLN') } keys %targpeers,
  2         27  
3634             );
3635             }
3636             else {
3637 2         6 $us = 1;
3638             }
3639              
3640 3 50       14 last SWITCH if !$us;
3641              
3642 3 100       12 if ( !$reason ) {
3643 2   50     8 $reason = shift @$args || '';
3644             }
3645              
3646 3         17 my $full = $self->state_user_full($nick);
3647              
3648 3 50       23 last SWITCH if !$self->_state_add_drkx_line( 'dline',
3649             $full, time, $server, $duration * 60,
3650             $netmask, $reason );
3651              
3652 3         26 $self->send_event(
3653             "daemon_dline",
3654             $full,
3655             $netmask,
3656             $duration,
3657             $reason,
3658             );
3659              
3660 3         459 $self->add_denial( $netmask, 'You have been D-lined.' );
3661              
3662 3 100       14 my $temp = $duration ? "temporary $duration min. " : '';
3663              
3664 3         13 my $reply_notice = "Added ${temp}D-Line [$netmask]";
3665 3         14 my $locop_notice = "$full added ${temp}D-Line for [$netmask] [$reason]";
3666              
3667 3         15 push @$ref, {
3668             prefix => $server,
3669             command => 'NOTICE',
3670             params => [ $nick, $reply_notice ],
3671             };
3672              
3673 3         21 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3674              
3675 3         19 $self->_state_do_local_users_match_dline($netmask,$reason);
3676             }
3677              
3678 3 50       15 return @$ref if wantarray;
3679 3         13 return $ref;
3680             }
3681              
3682             sub _daemon_cmd_undline {
3683 2     2   7 my $self = shift;
3684 2   50     11 my $nick = shift || return;
3685 2         12 my $server = $self->server_name();
3686 2         9 my $sid = $self->server_sid();
3687 2         6 my $ref = [ ];
3688 2         8 my $args = [ @_ ];
3689 2         5 my $count = @$args;
3690              
3691             SWITCH: {
3692 2 50       6 if (!$self->state_user_is_operator($nick)) {
  2         9  
3693 0         0 push @$ref, ['481'];
3694 0         0 last SWITCH;
3695             }
3696 2 50       12 if (!$count ) {
3697 0         0 push @$ref, ['461', 'UNDLINE'];
3698 0         0 last SWITCH;
3699             }
3700 2         6 my $unmask = shift @$args;
3701 2 50 66     19 if ($args->[0] && uc $args->[0] eq 'ON'
      66        
3702             && scalar @$args < 2) {
3703 0         0 push @$ref, ['461', 'UNDLINE'];
3704 0         0 last SWITCH;
3705             }
3706 2         5 my $us = 0;
3707 2 100 66     14 if ($args->[0] && uc $args->[0] eq 'ON') {
3708 1         2 my $on = shift @$args;
3709 1         3 my $peermask = shift @$args;
3710 1         2 my %targpeers; my $ucserver = uc $server;
  1         3  
3711 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         7  
3712 4 50       26 if (matches_mask($peermask, $peer)) {
3713 4 100       151 if ($ucserver eq $peer) {
3714 1         3 $us = 1;
3715             }
3716             else {
3717 3         11 $targpeers{ $self->_state_peer_route($peer) }++;
3718             }
3719             }
3720             }
3721             $self->send_output(
3722             {
3723             prefix => $self->state_user_uid($nick),
3724             command => 'UNDLINE',
3725             params => [
3726             $peermask,
3727             $unmask,
3728             ],
3729             colonify => 0,
3730             },
3731 1         5 grep { $self->_state_peer_capab($_, 'UNDLN') } keys %targpeers,
  2         24  
3732             );
3733             }
3734             else {
3735 1         2 $us = 1;
3736             }
3737              
3738 2 50       9 last SWITCH if !$us;
3739              
3740 2         12 my $result = $self->_state_del_drkx_line( 'dline', $unmask );
3741              
3742 2 50       9 if ( !$result ) {
3743 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $nick, "No D-Line for [$unmask] found" ] };
3744 0         0 last SWITCH;
3745             }
3746              
3747 2         11 my $full = $self->state_user_full($nick);
3748 2         17 $self->send_event(
3749             "daemon_undline",
3750             $full,
3751             $unmask,
3752             );
3753              
3754 2         245 $self->del_denial( $unmask );
3755              
3756 2         16 push @$ref, {
3757             prefix => $server,
3758             command => 'NOTICE',
3759             params => [ $nick, "D-Line for [$unmask] is removed" ],
3760             };
3761              
3762 2         13 $self->_send_to_realops(
3763             "$full has removed the D-Line for: [$unmask]",
3764             'Notice',
3765             's',
3766             );
3767             }
3768              
3769 2 50       9 return @$ref if wantarray;
3770 2         8 return $ref;
3771             }
3772              
3773             sub _daemon_cmd_kill {
3774 0     0   0 my $self = shift;
3775 0   0     0 my $nick = shift || return;
3776             my $server = ( $self->{config}{'hidden_servers'} ?
3777 0 0       0 $self->{config}{'hidden_servers'} : $self->server_name() );
3778 0         0 my $ref = [ ];
3779 0         0 my $args = [@_];
3780 0         0 my $count = @$args;
3781              
3782             SWITCH: {
3783 0 0       0 if (!$self->state_user_is_operator($nick)) {
  0         0  
3784 0         0 push @$ref, ['481'];
3785 0         0 last SWITCH;
3786             }
3787 0 0       0 if (!$count) {
3788 0         0 push @$ref, ['461', 'KILL'];
3789 0         0 last SWITCH;
3790             }
3791 0 0       0 if ($self->state_peer_exists($args->[0])) {
3792 0         0 push @$ref, ['483'];
3793 0         0 last SWITCH;
3794             }
3795 0 0       0 if (!$self->state_nick_exists($args->[0])) {
3796 0         0 push @$ref, ['401', $args->[0]];
3797 0         0 last SWITCH;
3798             }
3799 0         0 my $target = $self->state_user_nick($args->[0]);
3800 0         0 my $targuid = $self->state_user_uid($target);
3801 0         0 my $uid = $self->state_user_uid($nick);
3802 0   0     0 my $comment = $args->[1] || '';
3803 0 0       0 if ($self->_state_is_local_user($target)) {
3804 0         0 my $route_id = $self->_state_user_route($target);
3805 0         0 $self->send_output(
3806             {
3807             prefix => $uid,
3808             command => 'KILL',
3809             params => [
3810             $targuid,
3811             join('!', $server, $nick )." ($comment)",
3812             ]
3813             },
3814             $self->_state_connected_peers(),
3815             );
3816              
3817 0         0 $self->send_output(
3818             {
3819             prefix => $self->state_user_full($nick),
3820             command => 'KILL',
3821             params => [$target, $comment],
3822             },
3823             $route_id,
3824             );
3825 0 0       0 if ($route_id eq 'spoofed') {
3826 0         0 $self->call('del_spoofed_nick', $target, "Killed ($comment)");
3827             }
3828             else {
3829 0         0 $self->{state}{conns}{$route_id}{killed} = 1;
3830 0         0 $self->_terminate_conn_error($route_id, "Killed ($comment)");
3831             }
3832             }
3833             else {
3834 0         0 $self->{state}{uids}{$targuid}{killed} = 1;
3835 0         0 $self->send_output(
3836             {
3837             prefix => $uid,
3838             command => 'KILL',
3839             params => [
3840             $targuid,
3841             join('!', $server, $nick )." ($comment)",
3842             ],
3843             },
3844             $self->_state_connected_peers(),
3845             );
3846             $self->send_output(
3847 0         0 @{ $self->_daemon_peer_quit(
  0         0  
3848             $targuid,
3849             "Killed ($nick ($comment))"
3850             )}
3851             );
3852             }
3853             }
3854              
3855 0 0       0 return @$ref if wantarray;
3856 0         0 return $ref;
3857             }
3858              
3859             sub _daemon_peer_tracing {
3860 4     4   12 my $self = shift;
3861 4         9 my $cmd = shift;
3862 4   50     16 my $peer_id = shift || return;
3863 4   50     24 my $uid = shift || return;
3864 4         16 my $server = $self->server_name();
3865 4         14 my $sid = $self->server_sid();
3866 4         13 my $args = [@_];
3867 4         11 my $count = @$args;
3868 4         10 my $ref = [ ];
3869 4         13 $cmd = uc $cmd;
3870              
3871             SWITCH: {
3872 4 50       8 if ($count > 1) {
  4         14  
3873 0   0     0 my $targ = ( $self->state_user_uid($args->[1]) || $self->_state_peer_sid($args->[1] ) );
3874 0 0       0 if (!$targ) {
3875 0         0 push @$ref, {
3876             prefix => $sid,
3877             command => '402',
3878             params => [
3879             $uid,
3880             $args->[1],
3881             ],
3882             };
3883 0         0 last SWITCH;
3884             }
3885 0 0       0 if ($targ !~ m!^$sid!) {
3886 0         0 my $psid = substr $targ, 0, 3;
3887 0         0 $self->send_output(
3888             {
3889             prefix => $uid,
3890             command => $cmd,
3891             params => [
3892             $args->[0],
3893             $targ,
3894             ],
3895             },
3896             $self->_state_sid_route($psid),
3897             );
3898 0         0 last SWITCH;
3899             }
3900             }
3901 4 50       16 if ($args->[0]) {
3902 4   33     21 my $targ = ( $self->state_user_uid($args->[0]) || $self->_state_peer_sid($args->[0] ) );
3903 4 50       27 if (!$targ) {
3904 0         0 push @$ref, {
3905             prefix => $sid,
3906             command => '402',
3907             params => [
3908             $uid,
3909             $args->[0],
3910             ],
3911             };
3912 0         0 last SWITCH;
3913             }
3914 4 100       84 if ($targ !~ m!^$sid!) {
3915 2         7 my $name;
3916             my $route_id;
3917 2 50       12 if ( length $targ == 3 ) {
3918 2         12 $name = $self->{state}{sids}{$targ}{name};
3919 2         8 $route_id = $self->{state}{sids}{$targ}{route_id};
3920             }
3921             else {
3922 0         0 $name = $self->{state}{uids}{$targ}{nick};
3923 0         0 $route_id = $self->{state}{uids}{$targ}{route_id};
3924             }
3925             push @$ref, {
3926             prefix => $sid,
3927             command => '200',
3928             params => [
3929             $uid,
3930             'Link',
3931             $self->server_version(),
3932             $name,
3933             $self->{state}{conns}{$route_id}{name},
3934 2         13 ],
3935             };
3936 2         33 $self->send_output(
3937             {
3938             prefix => $uid,
3939             command => $cmd,
3940             params => [
3941             $targ,
3942             ],
3943             },
3944             $route_id,
3945             );
3946 2         12 last SWITCH;
3947             }
3948             }
3949 2 100       12 my $method = ( $cmd eq 'ETRACE' ? '_daemon_do_etrace' : '_daemon_do_trace' );
3950 2         8 push @$ref, $_ for @{ $self->$method($uid, @$args) };
  2         16  
3951             }
3952 4 50       38 return @$ref if wantarray;
3953 0         0 return $ref;
3954             }
3955              
3956             sub _state_find_peer {
3957 3     3   12 my $self = shift;
3958 3   50     16 my $targ = shift || return;
3959 3         8 my $connid = shift;
3960 3         11 my $server = $self->server_name();
3961 3         12 my $sid = $self->server_sid();
3962 3         11 my $ume = uc $server;
3963 3         7 my $result;
3964              
3965 3 50       44 if ($self->state_nick_exists($targ)) {
3966 0         0 $result = $self->state_user_uid($targ);
3967             }
3968 3 50 33     48 if (!$result && $self->state_peer_exists($targ)) {
3969 0         0 $result = $self->_state_peer_sid($targ);
3970             }
3971 3 50 33     30 if (!$result && $targ =~ m![\x2A\x3F]!) {
3972 3         9 PEERS: foreach my $peer ( sort keys %{ $self->{state}{peers} } ) {
  3         35  
3973 9 100       349 if ( matches_mask($targ,$peer,'ascii') ) {
3974 1 50       97 return $sid if $ume eq $peer;
3975 1         6 my $peerrec = $self->{state}{peers}{$peer};
3976             next PEERS if $connid && $connid eq $peerrec->{route_id}
3977 1 0 33     5 && $peerrec->{type} eq 'r';
      33        
3978 1         3 $result = $peerrec->{sid};
3979 1         3 last PEERS;
3980             }
3981             }
3982 3 100       87 if (!$result) {
3983 2         5 USERS: foreach my $user ( sort keys %{ $self->{state}{users} } ) {
  2         37  
3984 10 100       293 if ( matches_mask($targ,$user) ) {
3985 2         76 my $rec = $self->{state}{users}{$user};
3986 2 50       37 return $sid if $rec->{uid} =~ m!^$sid!;
3987             next USERS if $connid && $connid eq $rec->{route_id}
3988 2 0 33     13 && $self->{state}{sids}{ $rec->{sid} }{type} eq 'r';
      33        
3989 2         6 $result = $rec->{uid};
3990             last USERS
3991 2         8 }
3992             }
3993             }
3994             }
3995 3 50       21 return $result if $result;
3996 0         0 return;
3997             }
3998              
3999             sub _daemon_client_tracing {
4000 6     6   19 my $self = shift;
4001 6         14 my $cmd = shift;
4002 6   50     26 my $nick = shift || return;
4003 6         23 my $server = $self->server_name();
4004 6         27 my $sid = $self->server_sid();
4005 6         30 my $args = [@_];
4006 6         15 my $count = @$args;
4007 6         15 my $ref = [ ];
4008 6         18 $cmd = uc $cmd;
4009              
4010             SWITCH: {
4011 6 100       15 if (!$self->state_user_is_operator($nick)) {
  6         33  
4012 2 100       32 if ( $cmd eq 'ETRACE' ) {
4013 1         2 push @$ref, ['481'];
4014 1         3 last SWITCH;
4015             }
4016 1         8 push @$ref, {
4017             prefix => $server,
4018             command => '262',
4019             params => [
4020             $nick, $server, 'End of TRACE',
4021             ],
4022             };
4023 1         3 last SWITCH;
4024             }
4025 4 50       20 if ($count > 1) {
4026 0         0 my $targ = $self->_state_find_peer($args->[1]);
4027 0 0       0 if (!$targ) {
4028 0         0 push @$ref, [ '402', $args->[1] ];
4029 0         0 last SWITCH;
4030             }
4031 0 0       0 if ($targ !~ m!^$sid!) {
4032 0         0 my $psid = substr $targ, 0, 3;
4033 0         0 $self->send_output(
4034             {
4035             prefix => $self->state_user_uid($nick),
4036             command => $cmd,
4037             params => [
4038             $args->[0],
4039             $targ,
4040             ],
4041             },
4042             $self->_state_sid_route($psid),
4043             );
4044 0         0 last SWITCH;
4045             }
4046             }
4047 4         24 my $uid = $self->state_user_uid($nick);
4048 4 100       67 if ($args->[0]) {
4049 2         13 my $targ = $self->_state_find_peer($args->[0]);
4050 2 50       18 if (!$targ) {
4051 0         0 push @$ref, [ '402', $args->[0] ];
4052 0         0 last SWITCH;
4053             }
4054 2 50       24 if ($targ !~ m!^$sid!) {
4055 2         7 my $name;
4056             my $route_id;
4057 2 50       13 if ( length $targ == 3 ) {
4058 0         0 $name = $self->{state}{sids}{$targ}{name};
4059 0         0 $route_id = $self->{state}{sids}{$targ}{route_id};
4060             }
4061             else {
4062 2         9 $name = $self->{state}{uids}{$targ}{nick};
4063 2         7 $route_id = $self->{state}{uids}{$targ}{route_id};
4064             }
4065             push @$ref, {
4066             prefix => $server,
4067             command => '200',
4068             params => [
4069             $nick,
4070             'Link',
4071             $self->server_version(),
4072             $name,
4073             $self->{state}{conns}{$route_id}{name},
4074 2         14 ],
4075             };
4076 2         30 $self->send_output(
4077             {
4078             prefix => $uid,
4079             command => $cmd,
4080             params => [
4081             $targ,
4082             ],
4083             },
4084             $route_id,
4085             );
4086 2         11 last SWITCH;
4087             }
4088             }
4089 2 100       11 my $method = ( $cmd eq 'ETRACE' ? '_daemon_do_etrace' : '_daemon_do_trace' );
4090 2         5 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  14         23  
  14         20  
  14         36  
4091 2         21 @{ $self->$method($uid, @$args) };
4092             }
4093 6 50       83 return @$ref if wantarray;
4094 0         0 return $ref;
4095             }
4096              
4097             sub _daemon_do_etrace {
4098 2     2   6 my $self = shift;
4099 2   50     12 my $uid = shift || return;
4100 2         8 my $server = $self->server_name();
4101 2         8 my $sid = $self->server_sid();
4102 2         7 my $args = [@_];
4103 2         8 my $count = @$args;
4104 2         6 my $ref = [ ];
4105              
4106             SWITCH: {
4107 2         5 my $rec = $self->{state}{uids}{$uid};
  2         11  
4108             $self->_send_to_realops(
4109             sprintf(
4110             'ETRACE requested by %s (%s@%s) [%s]',
4111             $rec->{nick},
4112             $rec->{auth}{ident},
4113             $rec->{auth}{hostname},
4114             $rec->{server},
4115 2         39 ),
4116             'Notice',
4117             'y',
4118             );
4119 2         63 my $doall = 0;
4120 2 100       19 if (!$args->[0]) {
    50          
    50          
4121 1         3 $doall = 1;
4122             }
4123             elsif (uc $args->[0] eq uc $server) {
4124 0         0 $doall = 1;
4125             }
4126             elsif ($args->[0] eq $sid) {
4127 1         3 $doall = 1;
4128             }
4129 2         6 my $name = $args->[0];
4130 2 100 66     38 if ($name && $name =~ m!^[0-9]!) {
4131 1         8 $name = $self->state_user_nick($name);
4132             }
4133 2 50       9 $name = uc_irc $name if $name;
4134             # Local clients
4135 2         6 my @connects;
4136 2         6 my $conns = $self->{state}{conns};
4137 2         23 foreach my $conn_id ( keys %$conns ) {
4138 12 100       45 next if $conns->{$conn_id}{type} ne 'c';
4139 6 100       19 next if defined $self->{state}{localops}{ $conn_id };
4140 4         10 push @connects, $conn_id;
4141             }
4142 2         22 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  2         20  
4143             @connects ) {
4144 4 50 33     25 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{nick} );
      33        
4145 4         11 my $connrec = $conns->{$conn_id};
4146             push @$ref, {
4147             prefix => $sid,
4148             command => '709',
4149             params => [
4150             $uid,
4151             'User', 'users',
4152             $connrec->{nick},
4153             $connrec->{auth}{ident},
4154             $connrec->{auth}{hostname},
4155             $connrec->{socket}[0],
4156             $connrec->{ircname},
4157 4         38 ],
4158             };
4159             }
4160 2         6 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  0         0  
4161 2         13 keys %{ $self->{state}{localops} } ) {
4162 2 50 33     24 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{nick} );
      33        
4163 2         7 my $connrec = $conns->{$conn_id};
4164             push @$ref, {
4165             prefix => $sid,
4166             command => '709',
4167             params => [
4168             $uid,
4169             'Oper', 'opers',
4170             $connrec->{nick},
4171             $connrec->{auth}{ident},
4172             $connrec->{auth}{hostname},
4173             $connrec->{socket}[0],
4174             $connrec->{ircname},
4175 2         30 ],
4176             };
4177             }
4178             # End of ETRACE
4179 2         16 push @$ref, {
4180             prefix => $sid,
4181             command => '759',
4182             params => [
4183             $uid, $server, 'End of ETRACE',
4184             ],
4185             };
4186             }
4187              
4188 2 50       8 return @$ref if wantarray;
4189 2         12 return $ref;
4190             }
4191              
4192             sub _daemon_do_trace {
4193 2     2   8 my $self = shift;
4194 2   50     7 my $uid = shift || return;
4195 2         6 my $server = $self->server_name();
4196 2         6 my $sid = $self->server_sid();
4197 2         5 my $args = [@_];
4198 2         5 my $count = @$args;
4199 2         3 my $ref = [ ];
4200              
4201             SWITCH: {
4202 2         6 my $rec = $self->{state}{uids}{$uid};
  2         8  
4203             $self->_send_to_realops(
4204             sprintf(
4205             'TRACE requested by %s (%s@%s) [%s]',
4206             $rec->{nick},
4207             $rec->{auth}{ident},
4208             $rec->{auth}{hostname},
4209             $rec->{server},
4210 2         24 ),
4211             'Notice',
4212             'y',
4213             );
4214 2         6 my $doall = 0;
4215 2 100       14 if (!$args->[0]) {
    50          
    50          
4216 1         2 $doall = 1;
4217             }
4218             elsif (uc $args->[0] eq uc $server) {
4219 0         0 $doall = 1;
4220             }
4221             elsif ($args->[0] eq $sid) {
4222 1         3 $doall = 1;
4223             }
4224 2         6 my $name = $args->[0];
4225 2 100 66     13 if ($name && $name =~ m!^[0-9]!) {
4226 1         12 $name = $self->state_user_nick($name);
4227             }
4228 2 50       7 $name = uc_irc $name if $name;
4229             # Local clients
4230 2         7 my $conns = $self->{state}{conns};
4231 2         5 my %connects;
4232 2         9 foreach my $conn_id ( keys %$conns ) {
4233 12 100       36 next if defined $self->{state}{localops}{ $conn_id };
4234 10         12 push @{ $connects{ $conns->{$conn_id}{type} } }, $conn_id;
  10         33  
4235             }
4236 2         5 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  2         22  
4237 2         14 @{ $connects{c} } ) {
4238 4 50 33     19 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{nick} );
      33        
4239 4         8 my $connrec = $conns->{$conn_id};
4240             push @$ref, {
4241             prefix => $sid,
4242             command => '205',
4243             params => [
4244             $uid,
4245             'User', 'users',
4246             $connrec->{nick},
4247             sprintf('[%s@%s]',$connrec->{auth}{ident},$connrec->{auth}{hostname}),
4248             sprintf('(%s)',$connrec->{socket}[0]),
4249             time - $connrec->{seen},
4250             time - $connrec->{idle_time},
4251 4         53 ],
4252             colonify => 0,
4253             };
4254             }
4255 2         6 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  0         0  
4256 2         10 keys %{ $self->{state}{localops} } ) {
4257 2 50 33     14 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{nick} );
      33        
4258 2         7 my $connrec = $conns->{$conn_id};
4259             push @$ref, {
4260             prefix => $sid,
4261             command => '204',
4262             params => [
4263             $uid,
4264             'Oper', 'opers',
4265             $connrec->{nick},
4266             sprintf('[%s@%s]',$connrec->{auth}{ident},$connrec->{auth}{hostname}),
4267             sprintf('(%s)',$connrec->{socket}[0]),
4268             time - $connrec->{seen},
4269             time - $connrec->{idle_time},
4270 2         30 ],
4271             colonify => 0,
4272             };
4273             }
4274             # Servers
4275 2         7 foreach my $conn_id ( sort { $conns->{$a}{name} cmp $conns->{$b}{name} }
  2         18  
4276 2         9 @{ $connects{p} } ) {
4277 4 50 33     32 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{name} );
      33        
4278 4         7 my $connrec = $conns->{$conn_id};
4279 4         8 my $srvcnt = 0; my $clicnt = 0;
  4         7  
4280 4         49 $self->_state_peer_dependents( $connrec->{sid}, \$srvcnt, \$clicnt );
4281             push @$ref, {
4282             prefix => $sid,
4283             command => '206',
4284             params => [
4285             $uid,
4286             'Serv', 'server',
4287             "${srvcnt}S", "${clicnt}C",
4288             sprintf(
4289             '%s[%s@%s]', $connrec->{name},
4290             ( $connrec->{auth}{ident} || 'unknown' ),
4291             ( $connrec->{auth}{hostname} || $connrec->{socket}[0] ) ),
4292             sprintf('%s!%s@%s','*','*',$connrec->{name}),
4293             time - $connrec->{conn_time},
4294 4   50     92 ],
      33        
4295             colonify => 0,
4296             };
4297             }
4298             # Unknowns
4299 2         6 foreach my $conn_id ( sort { $conns->{$a}{nick} <=> $conns->{$b}{nick} }
  0         0  
4300 2         8 @{ $connects{u} } ) {
4301 2 50       17 next if !$doall;
4302 2         6 my $connrec = $conns->{$conn_id};
4303             push @$ref, {
4304             prefix => $sid,
4305             command => '203',
4306             params => [
4307             $uid,
4308             '????', 'default',
4309             sprintf(
4310             '[%s@%s]', ( $connrec->{auth}{ident} || 'unknown' ),
4311             ( $connrec->{auth}{hostname} || $connrec->{socket}[0] ) ),
4312             sprintf('(%s)',$connrec->{socket}[0]),
4313             time - $connrec->{conn_time},
4314 2   50     66 ],
      33        
4315             colonify => 0,
4316             };
4317             }
4318 2 50       10 if ($doall) {
4319 2 50       9 my $users = ( defined $connects{c} ? @{ $connects{c} } : 0 );
  2         6  
4320 2 50       9 my $opers = ( defined $self->{state}{localops} ? keys %{ $self->{state}{localops} } : 0 );
  2         7  
4321 2 50       8 my $servers = ( defined $connects{p} ? @{ $connects{p} } : 0 );;
  2         5  
4322 2         4 $users -= $opers;
4323             # 209
4324 2 50       7 if ($servers) {
4325 2         17 push @$ref, {
4326             prefix => $sid,
4327             command => '209',
4328             params => [
4329             $uid,
4330             'Class', 'server', $servers,
4331             ],
4332             colonify => 0,
4333             };
4334             }
4335 2 50       8 if ($opers) {
4336 2         12 push @$ref, {
4337             prefix => $sid,
4338             command => '209',
4339             params => [
4340             $uid,
4341             'Class', 'opers', $opers,
4342             ],
4343             colonify => 0,
4344             };
4345             }
4346 2 50       15 if ($users) {
4347 2         13 push @$ref, {
4348             prefix => $sid,
4349             command => '209',
4350             params => [
4351             $uid,
4352             'Class', 'users', $users,
4353             ],
4354             colonify => 0,
4355             };
4356             }
4357             }
4358             # End of TRACE
4359 2         22 push @$ref, {
4360             prefix => $sid,
4361             command => '262',
4362             params => [
4363             $uid, $server, 'End of TRACE',
4364             ],
4365             };
4366             }
4367              
4368 2 50       11 return @$ref if wantarray;
4369 2         12 return $ref;
4370             }
4371              
4372             sub _state_peer_dependents {
4373 6     6   11 my $self = shift;
4374 6   50     16 my $sid = shift || return;
4375 6         9 my $srvcnt = shift;
4376 6         9 my $clicnt = shift;
4377              
4378 6         10 $$srvcnt++;
4379 6         9 $$clicnt += keys %{ $self->{state}{sids}{$sid}{uids} };
  6         26  
4380 6         10 foreach my $psid ( keys %{ $self->{state}{sids}{$sid}{sids} } ) {
  6         26  
4381 2         10 $self->_state_peer_dependents($psid,$srvcnt,$clicnt);
4382             }
4383 6         15 return;
4384             }
4385             sub _daemon_cmd_nick {
4386 23     23   61 my $self = shift;
4387 23   50     80 my $nick = shift || return;
4388 23         127 my $new = shift;
4389 23         76 my $server = uc $self->server_name();
4390 23         193 my $sid = $self->server_sid();
4391 23         68 my $ref = [ ];
4392              
4393             SWITCH: {
4394 23 50       56 if (!$new) {
  23         160  
4395 0         0 push @$ref, ['431'];
4396 0         0 last SWITCH;
4397             }
4398 23         83 my $nicklen = $self->server_config('NICKLEN');
4399 23 50       88 $new = substr($new, 0, $nicklen) if length($new) > $nicklen;
4400 23 100       80 if ($nick eq $new) {
4401 2         6 last SWITCH;
4402             }
4403 21 50       109 if (!is_valid_nick_name($new)) {
4404 0         0 push @$ref, ['432', $new];
4405 0         0 last SWITCH;
4406             }
4407 21         344 my $unick = uc_irc($nick);
4408 21         389 my $record = $self->{state}{users}{$unick};
4409 21 100       100 if ( my $reason = $self->_state_is_resv( $new, $record->{route_id} ) ) {
4410 1         4 $self->_send_to_realops(
4411             sprintf(
4412             'Forbidding reserved nick %s from user %s',
4413             $new,
4414             $self->state_user_full($nick),
4415             ),
4416             'Notice',
4417             'j',
4418             );
4419 1         4 push @$ref, {
4420             prefix => $self->server_name(),
4421             command => '432',
4422             params => [
4423             $nick,
4424             $new,
4425             $reason,
4426             ],
4427             };
4428 1         4 last SWITCH;
4429             }
4430 20         68 my $unew = uc_irc($new);
4431 20 50 33     315 if ($self->state_nick_exists($new) && $unick ne $unew) {
4432 0         0 push @$ref, ['433', $new];
4433 0         0 last SWITCH;
4434             }
4435 20         84 my $full = $record->{full}->();
4436 20         90 my $common = { $record->{uid} => $record->{route_id} };
4437              
4438 20         65 my $nonickchange = '';
4439 20         41 CHANS: for my $chan (keys %{ $record->{chans} }) {
  20         189  
4440 4         16 my $chanrec = $self->{state}{chans}{$chan};
4441 4 100       25 if ( $chanrec->{mode} =~ /N/ ) {
4442 2 50       37 if ( $record->{chans} !~ /[oh]/ ) {
4443 2         9 $nonickchange = $chanrec->{name};
4444 2         19 last CHANS;
4445             }
4446             }
4447 2         5 USER: for my $user ( keys %{ $chanrec->{users} } ) {
  2         8  
4448 4 50       52 next USER if $user !~ m!^$sid!;
4449 4         27 $common->{$user} = $self->_state_uid_route($user);
4450             }
4451             }
4452              
4453 20 100       94 if ($nonickchange) {
4454 2         9 push @$ref,['447',$nonickchange];
4455 2         8 last SWITCH;
4456             }
4457              
4458 18         125 my $lastattempt = $record->{_nick_last};
4459 18 50 66     85 if ( $lastattempt && ( $lastattempt + $self->{config}{max_nick_time} < time() ) ) {
4460 0         0 $record->{_nick_count} = 0;
4461             }
4462              
4463 18 100 33     266 if ( ( $self->{config}{anti_nick_flood} && $record->{umode} !~ /o/ ) &&
      66        
      100        
4464             $record->{_nick_count} && ( $record->{_nick_count} >= $self->{config}{max_nick_changes} ) ) {
4465 1         5 push @$ref,['438',$new,$self->{config}{max_nick_time}];
4466 1         5 last SWITCH;
4467             }
4468              
4469 17         61 $record->{_nick_last} = time();
4470 17         47 $record->{_nick_count}++;
4471              
4472 17 50       67 if ($unick eq $unew) {
4473 0         0 $record->{nick} = $new;
4474 0         0 $record->{ts} = time;
4475             }
4476             else {
4477 17         51 $record->{nick} = $new;
4478 17         43 $record->{ts} = time;
4479             # Remove from peoples accept lists
4480 17         33 for (keys %{ $record->{accepts} }) {
  17         107  
4481 0         0 delete $self->{state}{users}{$_}{accepts}{$unick};
4482             }
4483 17         70 delete $record->{accepts};
4484             # WATCH ON/OFF
4485 17 100       73 if ( defined $self->{state}{watches}{$unick} ) {
4486 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         5  
4487 1 50       5 next if !defined $self->{state}{uids}{$wuid};
4488 1         3 my $wrec = $self->{state}{uids}{$wuid};
4489 1         3 my $laston = time();
4490 1         3 $self->{state}{watches}{$unick}{laston} = $laston;
4491             $self->send_output(
4492             {
4493             prefix => $record->{server},
4494             command => '605',
4495             params => [
4496             $wrec->{nick},
4497             $nick,
4498             $record->{auth}{ident},
4499             $record->{auth}{hostname},
4500             $laston,
4501             'is offline',
4502             ],
4503             },
4504             $wrec->{route_id},
4505 1         11 );
4506             }
4507             }
4508 17 100       80 if ( defined $self->{state}{watches}{$unew} ) {
4509 1         2 foreach my $wuid ( keys %{ $self->{state}{watches}{$unew}{uids} } ) {
  1         7  
4510 1 50       5 next if !defined $self->{state}{uids}{$wuid};
4511 1         3 my $wrec = $self->{state}{uids}{$wuid};
4512             $self->send_output(
4513             {
4514             prefix => $record->{server},
4515             command => '604',
4516             params => [
4517             $wrec->{nick},
4518             $record->{nick},
4519             $record->{auth}{ident},
4520             $record->{auth}{hostname},
4521             $record->{ts},
4522             'is online',
4523             ],
4524             },
4525             $wrec->{route_id},
4526 1         12 );
4527             }
4528             }
4529 17         85 delete $self->{state}{users}{$unick};
4530 17         63 $self->{state}{users}{$unew} = $record;
4531 17         61 delete $self->{state}{peers}{$server}{users}{$unick};
4532 17         96 $self->{state}{peers}{$server}{users}{$unew} = $record;
4533 17 100       88 if ( $record->{umode} =~ /r/ ) {
4534 1         5 $record->{umode} =~ s/r//g;
4535             $self->send_output(
4536             {
4537             prefix => $full,
4538             command => 'MODE',
4539             params => [
4540             $record->{nick},
4541             '-r',
4542             ],
4543             },
4544             $record->{route_id},
4545 1         10 );
4546             }
4547 17         309 unshift @{ $self->{state}{whowas}{$unick} }, {
4548             logoff => time(),
4549             account => $record->{account},
4550             nick => $nick,
4551             user => $record->{auth}{ident},
4552             host => $record->{auth}{hostname},
4553             real => $record->{auth}{realhost},
4554             sock => $record->{socket}[0],
4555             ircname => $record->{ircname},
4556             server => $record->{server},
4557 17         46 };
4558             }
4559              
4560 17         219 $self->_send_to_realops(
4561             sprintf(
4562             'Nick change: From %s to %s [%s]',
4563             $nick, $new, (split /!/, $full)[1],
4564             ),
4565             'Notice',
4566             'n',
4567             );
4568              
4569             $self->send_output(
4570             {
4571             prefix => $record->{uid},
4572             command => 'NICK',
4573 17         137 params => [$new, $record->{ts}],
4574             },
4575             $self->_state_connected_peers(),
4576             );
4577              
4578 17         109 $self->send_event("daemon_nick", $full, $new);
4579              
4580 17         2105 $self->send_output(
4581             {
4582             prefix => $full,
4583             command => 'NICK',
4584             params => [$new],
4585             },
4586             values %$common,
4587             );
4588             }
4589              
4590 23 50       159 return @$ref if wantarray;
4591 0         0 return $ref;
4592             }
4593              
4594             sub _daemon_cmd_away {
4595 5     5   11 my $self = shift;
4596 5   50     12 my $nick = shift || return;
4597 5         10 my $msg = shift;
4598 5         11 my $server = $self->server_name();
4599 5         10 my $ref = [ ];
4600              
4601             SWITCH: {
4602 5         8 my $rec = $self->{state}{users}{uc_irc($nick)};
  5         18  
4603 5 100       70 if (!$msg) {
4604 2         5 delete $rec->{away};
4605             $self->send_output(
4606             {
4607             prefix => $rec->{uid},
4608 2         12 command => 'AWAY',
4609             },
4610             $self->_state_connected_peers(),
4611             );
4612             push @$ref, {
4613             prefix => $server,
4614             command => '305',
4615 2         12 params => [ $rec->{nick}, 'You are no longer marked as being away' ],
4616             };
4617 2         8 $self->_state_do_away_notify($rec->{uid},'*',$msg);
4618 2         4 last SWITCH;
4619             }
4620              
4621 3         7 $rec->{away} = $msg;
4622              
4623             $self->send_output(
4624             {
4625             prefix => $rec->{uid},
4626 3         18 command => 'AWAY',
4627             params => [$msg],
4628             },
4629             $self->_state_connected_peers(),
4630             );
4631             push @$ref, {
4632             prefix => $server,
4633             command => '306',
4634 3         18 params => [ $rec->{nick}, 'You have been marked as being away' ],
4635             };
4636 3         17 $self->_state_do_away_notify($rec->{uid},'*',$msg);
4637             }
4638              
4639 5 50       34 return @$ref if wantarray;
4640 0         0 return $ref;
4641             }
4642              
4643             sub _daemon_client_miscell {
4644 6     6   16 my $self = shift;
4645 6         9 my $cmd = shift;
4646 6   50     15 my $nick = shift || return;
4647 6         11 my $target = shift;
4648 6         14 my $server = $self->server_name();
4649 6         12 my $ref = [ ];
4650              
4651             SWITCH: {
4652 6 50 33     11 if ($target && !$self->state_peer_exists($target)) {
  6         19  
4653 0         0 push @$ref, ['402', $target];
4654 0         0 last SWITCH;
4655             }
4656 6 50 33     67 if ($target && uc $server ne uc $target) {
4657 0         0 $target = $self->_state_peer_sid($target);
4658 0         0 $self->send_output(
4659             {
4660             prefix => $self->state_user_uid($nick),
4661             command => uc $cmd,
4662             params => [$target],
4663             },
4664             $self->_state_sid_route($target),
4665             );
4666 0         0 last SWITCH;
4667             }
4668 6 100       38 if ($cmd =~ m!^(ADMIN|INFO|MOTD)$!i) {
4669 3         13 $self->_send_to_realops(
4670             sprintf(
4671             '%s requested by %s (%s) [%s]',
4672             $cmd, $nick, (split /!/,$self->state_user_full($nick))[1], $server,
4673             ), qw[Notice y],
4674             );
4675             }
4676 6         23 my $method = '_daemon_do_' . lc $cmd;
4677 6         25 my $uid = $self->state_user_uid($nick);
4678 6         62 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  30         39  
  30         39  
  30         53  
4679 6         53 @{ $self->$method($uid) };
4680             }
4681              
4682 6 50       54 return @$ref if wantarray;
4683 0         0 return $ref;
4684             }
4685              
4686             sub _daemon_peer_miscell {
4687 5     5   10 my $self = shift;
4688 5         8 my $cmd = shift;
4689 5   50     14 my $uid = shift || return;
4690 5         11 my $sid = $self->server_sid();
4691 5         12 my $args = [@_];
4692 5         10 my $count = @$args;
4693 5         8 my $ref = [ ];
4694              
4695             SWITCH: {
4696 5 50 33     20 if ($cmd ne 'STATS' && $args->[0] !~ m!^$sid!) {
  5         56  
4697 0         0 $self->send_output(
4698             {
4699             prefix => $uid,
4700             command => $cmd,
4701             params => $args,
4702             },
4703             $self->_state_sid_route(substr $args->[0], 0, 3),
4704             );
4705 0         0 last SWITCH;
4706             }
4707 5 50 33     17 if ($cmd eq 'STATS' && $args->[1] !~ m!^$sid!) {
4708 0         0 $self->send_output(
4709             {
4710             prefix => $uid,
4711             command => $cmd,
4712             params => $args,
4713             },
4714             $self->_state_sid_route(substr $args->[1], 0, 3),
4715             );
4716 0         0 last SWITCH;
4717             }
4718 5 100       19 if ($cmd =~ m!^(ADMIN|INFO|MOTD)$!i) {
4719 3         10 my $urec = $self->{state}{uids}{$uid};
4720             $self->_send_to_realops(
4721             sprintf(
4722             '%s requested by %s (%s) [%s]',
4723             $cmd, $urec->{nick}, (split /!/,$urec->{full}->())[1], $urec->{server},
4724 3         15 ), qw[Notice y],
4725             );
4726             }
4727 5         18 my $method = '_daemon_do_' . lc $cmd;
4728 5         25 $ref = $self->$method($uid, @$args);
4729             }
4730              
4731 5 50       57 return @$ref if wantarray;
4732 0         0 return $ref;
4733             }
4734              
4735             # Pseudo cmd for ISupport 005 numerics
4736             sub _daemon_do_isupport {
4737 229     229   717 my $self = shift;
4738 229   50     964 my $uid = shift || return;
4739 229         931 my $sid = $self->server_sid();
4740 229         622 my $ref = [ ];
4741              
4742             push @$ref, {
4743             prefix => $sid,
4744             command => '005',
4745             params => [
4746             $uid,
4747             join(' ', map {
4748 229         1121 (defined $self->{config}{isupport}{$_}
4749 2519 100       10672 ? join '=', $_, $self->{config}{isupport}{$_}
4750             : $_
4751             )
4752             } qw(CALLERID EXCEPTS INVEX MAXCHANNELS MAXLIST MAXTARGETS
4753             NICKLEN TOPICLEN KICKLEN KNOCK DEAF)
4754             ),
4755             'are supported by this server',
4756             ],
4757             };
4758              
4759             push @$ref, {
4760             prefix => $sid,
4761             command => '005',
4762             params => [
4763             $uid,
4764             join(' ', map {
4765 229         1423 (defined $self->{config}{isupport}{$_}
4766 1603 100       6584 ? join '=', $_, $self->{config}{isupport}{$_}
4767             : $_
4768             )
4769             } qw(CHANTYPES PREFIX CHANMODES NETWORK CASEMAPPING SAFELIST ELIST)
4770             ), 'are supported by this server',
4771             ],
4772             };
4773              
4774 229 50       1169 return @$ref if wantarray;
4775 229         975 return $ref;
4776             }
4777              
4778             sub _daemon_do_info {
4779 2     2   8 my $self = shift;
4780 2   50     23 my $uid = shift || return;
4781 2         6 my $sid = $self->server_sid();
4782 2         5 my $ref = [ ];
4783              
4784             {
4785 2         5 for my $info (@{ $self->server_config('Info') }) {
  2         4  
  2         6  
4786 20         131 push @$ref, {
4787             prefix => $sid,
4788             command => '371',
4789             params => [$uid, $info],
4790             };
4791             }
4792              
4793 2         9 push @$ref, {
4794             prefix => $sid,
4795             command => '374',
4796             params => [$uid, 'End of /INFO list.'],
4797             };
4798             }
4799              
4800 2 50       5 return @$ref if wantarray;
4801 2         6 return $ref;
4802             }
4803              
4804             sub _daemon_do_version {
4805 2     2   5 my $self = shift;
4806 2   50     6 my $uid = shift || return;
4807 2         6 my $sid = $self->server_sid();
4808 2         4 my $ref = [ ];
4809              
4810 2         31 push @$ref, {
4811             prefix => $sid,
4812             command => '351',
4813             params => [
4814             $uid,
4815             $self->server_version(),
4816             $self->server_name(),
4817             'eGHIMZ6 TS6ow',
4818             ],
4819             };
4820              
4821 2         5 push @$ref, $_ for @{ $self->_daemon_do_isupport($uid) };
  2         8  
4822              
4823 2 50       6 return @$ref if wantarray;
4824 2         4 return $ref;
4825             }
4826              
4827             sub _daemon_do_admin {
4828 2     2   6 my $self = shift;
4829 2   50     6 my $uid = shift || return;
4830 2         6 my $sid = $self->server_sid();
4831 2         5 my $ref = [ ];
4832 2         7 my $admin = $self->server_config('Admin');
4833              
4834             {
4835 2         4 push @$ref, {
  2         9  
4836             prefix => $sid,
4837             command => '256',
4838             params => [$uid, $self->server_name(), 'Administrative Info'],
4839             };
4840              
4841 2         10 push @$ref, {
4842             prefix => $sid,
4843             command => '257',
4844             params => [$uid, $admin->[0]],
4845             };
4846              
4847 2         9 push @$ref, {
4848             prefix => $sid,
4849             command => '258',
4850             params => [$uid, $admin->[1]],
4851             };
4852              
4853 2         10 push @$ref, {
4854             prefix => $sid,
4855             command => '259',
4856             params => [$uid, $admin->[2]],
4857             };
4858             }
4859              
4860 2 50       6 return @$ref if wantarray;
4861 2         4 return $ref;
4862             }
4863              
4864             sub _daemon_cmd_summon {
4865 0     0   0 my $self = shift;
4866 0   0     0 my $nick = shift || return;
4867 0         0 my $server = $self->server_name();
4868 0         0 my $ref = [ ];
4869 0         0 push @$ref, '445';
4870 0 0       0 return @$ref if wantarray;
4871 0         0 return $ref;
4872             }
4873              
4874             sub _daemon_do_time {
4875 3     3   6 my $self = shift;
4876 3   50     12 my $uid = shift || return;
4877 3         11 my $sid = $self->server_sid();
4878 3         7 my $ref = [ ];
4879              
4880             {
4881 3         7 push @$ref, {
  3         13  
4882             prefix => $sid,
4883             command => '391',
4884             params => [
4885             $uid,
4886             $self->server_name(),
4887             strftime("%A %B %e %Y -- %T %z", localtime),
4888             ],
4889             };
4890             }
4891              
4892 3 50       18 return @$ref if wantarray;
4893 3         13 return $ref;
4894             }
4895              
4896             sub _daemon_do_users {
4897 229     229   746 my $self = shift;
4898 229   50     1008 my $uid = shift || return;
4899 229         598 my $hidden = shift;
4900 229         799 my $sid = $self->server_sid();
4901 229         631 my $ref = [ ];
4902 229         567 my $global = keys %{ $self->{state}{uids} };
  229         872  
4903 229 100       1007 my $local = $hidden ? $global : scalar keys %{ $self->{state}{sids}{$sid}{uids} };
  223         874  
4904 229 100       1013 my $maxloc = $hidden ? 'maxglobal' : 'maxlocal';
4905              
4906             push @$ref, {
4907             prefix => $sid,
4908             command => '265',
4909             params => [
4910             $uid,
4911             "Current local users: $local Max: "
4912 229         2217 . $self->{state}{stats}{$maxloc},
4913             ],
4914             };
4915              
4916             push @$ref, {
4917             prefix => $sid,
4918             command => '266',
4919             params => [
4920             $uid,
4921             "Current global users: $global Max: "
4922             . $self->{state}{stats}{maxglobal},
4923 229         1964 ],
4924             };
4925              
4926 229 50       2027 return @$ref if wantarray;
4927 0         0 return $ref;
4928             }
4929              
4930             sub _daemon_cmd_lusers {
4931 2     2   8 my $self = shift;
4932 2   50     11 my $nick = shift || return;
4933 2         7 my $server = $self->server_name();
4934 2         8 my $ref = [ ];
4935 2         8 my $args = [@_];
4936 2         7 my $count = @$args;
4937              
4938             SWITCH: {
4939 2 50 33     7 if ($count && $count > 1) {
  2         12  
4940 0   0     0 my $target = ( $self->_state_peer_sid($args->[1]) || $self->state_user_uid($args->[1]) );
4941 0 0       0 if (!$target) {
4942 0         0 push @$ref, ['402', $args->[1]];
4943 0         0 last SWITCH;
4944             }
4945 0         0 my $targsid = substr $target, 0, 3;
4946 0         0 my $sid = $self->server_sid();
4947 0 0       0 if ( $targsid ne $sid ) {
4948 0         0 $self->send_output(
4949             {
4950             prefix => $self->state_user_uid($nick),
4951             command => 'LUSERS',
4952             params => [
4953             $args->[0],
4954             $target,
4955             ],
4956             },
4957             $self->_state_sid_route($targsid),
4958             );
4959 0         0 last SWITCH;
4960             }
4961             }
4962 2         11 my $uid = $self->state_user_uid($nick);
4963 2         33 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  13         29  
  13         41  
  13         36  
4964 2         9 @{ $self->_daemon_do_lusers($uid) };
4965             }
4966              
4967 2 50       27 return @$ref if wantarray;
4968 0         0 return $ref;
4969             }
4970              
4971             sub _daemon_peer_lusers {
4972 0     0   0 my $self = shift;
4973 0   0     0 my $uid = shift || return;
4974 0         0 my $sid = $self->server_sid();
4975 0         0 my $ref = [ ];
4976 0         0 my $args = [@_];
4977 0         0 my $count = @$args;
4978              
4979             SWITCH: {
4980 0 0 0     0 if (!$count || $count < 2) {
  0         0  
4981 0         0 last SWITCH;
4982             }
4983 0   0     0 my $target = ( $self->_state_peer_sid($args->[1]) || $self->state_user_uid($args->[1]) );
4984 0 0       0 if (!$target) {
4985 0         0 push @$ref, ['402', $args->[1]];
4986 0         0 last SWITCH;
4987             }
4988 0         0 my $targsid = substr $target, 0, 3;
4989 0 0       0 if ( $targsid ne $sid ) {
4990 0         0 $self->send_output(
4991             {
4992             prefix => $uid,
4993             command => 'LUSERS',
4994             params => $args,
4995             },
4996             $self->_state_sid_route($targsid),
4997             );
4998 0         0 last SWITCH;
4999             }
5000 0         0 push @$ref, $_ for @{ $self->_daemon_do_lusers($uid) };
  0         0  
5001             }
5002              
5003 0 0       0 return @$ref if wantarray;
5004 0         0 return $ref;
5005             }
5006              
5007             sub _daemon_do_lusers {
5008 229     229   726 my $self = shift;
5009 229   50     928 my $uid = shift || return;
5010 229         935 my $sid = $self->server_sid();
5011 229         678 my $ref = [ ];
5012 229   66     1397 my $hidden = ( $self->{config}{'hidden_servers'} && $self->{state}{uids}{$uid}{umode} !~ /o/ );
5013 229         858 my $invisible = $self->{state}{stats}{invisible};
5014 229         535 my $users = keys(%{ $self->{state}{uids} }) - $invisible;
  229         1332  
5015 229 100       1043 my $servers = $hidden ? 1 : scalar keys %{ $self->{state}{sids} };
  223         1019  
5016 229         544 my $chans = keys %{ $self->{state}{chans} };
  229         1004  
5017 229 100       897 my $local = $hidden ? ( $users + $invisible ) : scalar keys %{ $self->{state}{sids}{$sid}{uids} };
  223         1075  
5018 229 100       856 my $peers = $hidden ? 0 : scalar keys %{ $self->{state}{sids}{$sid}{sids} };
  223         916  
5019 229         813 my $totalconns = $self->{state}{stats}{conns_cumlative};
5020 229         775 my $mlocal = $self->{state}{stats}{maxlocal};
5021 229         591 my $conns = $self->{state}{stats}{maxconns};
5022              
5023 229         2582 push @$ref, {
5024             prefix => $sid,
5025             command => '251',
5026             params => [
5027             $uid,
5028             "There are $users users and $invisible invisible on "
5029             . "$servers servers",
5030             ],
5031             };
5032              
5033 229         807 $servers--;
5034              
5035             push @$ref, {
5036             prefix => $sid,
5037             command => '252',
5038             params => [
5039             $uid,
5040             $self->{state}{stats}{ops_online},
5041             "IRC Operators online",
5042             ]
5043 229 100       2064 } if $self->{state}{stats}{ops_online};
5044              
5045 229 100       1160 push @$ref, {
5046             prefix => $sid,
5047             command => '254',
5048             params => [$uid, $chans, "channels formed"],
5049             } if $chans;
5050              
5051 229         1919 push @$ref, {
5052             prefix => $sid,
5053             command => '255',
5054             params => [$uid, "I have $local clients and $peers servers"],
5055             };
5056              
5057 229         1499 push @$ref, $_ for $self->_daemon_do_users($uid, $hidden);
5058              
5059 229 100       2792 push @$ref, {
5060             prefix => $sid,
5061             command => '250',
5062             params => [
5063             $uid, "Highest connection count: $conns ($mlocal clients) "
5064             . "($totalconns connections received)",
5065             ],
5066             } if !$hidden;
5067              
5068 229 50       1048 return @$ref if wantarray;
5069 229         1178 return $ref;
5070             }
5071              
5072             sub _daemon_do_motd {
5073 229     229   670 my $self = shift;
5074 229   50     1042 my $uid = shift || return;
5075 229         1121 my $sid = $self->server_sid();
5076 229         894 my $server = $self->server_name();
5077 229         633 my $ref = [ ];
5078 229         1005 my $motd = $self->server_config('MOTD');
5079              
5080             {
5081 229 100 66     546 if ($motd && ref $motd eq 'ARRAY') {
  229         1192  
5082 2         13 push @$ref, {
5083             prefix => $sid,
5084             command => '375',
5085             params => [$uid, "- $server Message of the day - "],
5086             };
5087             push @$ref, {
5088             prefix => $sid,
5089             command => '372',
5090             params => [$uid, "- $_"]
5091 2         41 } for @$motd;
5092 2         9 push @$ref, {
5093             prefix => $sid,
5094             command => '376',
5095             params => [$uid, "End of MOTD command"],
5096             };
5097             }
5098             else {
5099             push @$ref, {
5100             prefix => $sid,
5101             command => '422',
5102 227         1800 params => [$uid, $self->{Error_Codes}{'422'}[1]],
5103             };
5104             }
5105             }
5106              
5107 229 50       968 return @$ref if wantarray;
5108 229         907 return $ref;
5109             }
5110              
5111             sub _daemon_cmd_stats {
5112 22     22   58 my $self = shift;
5113 22   50     79 my $nick = shift || return;
5114 22         50 my $char = shift;
5115 22         51 my $target = shift;
5116 22         64 my $server = $self->server_name();
5117 22         84 my $sid = $self->server_sid();
5118 22         60 my $ref = [ ];
5119              
5120             SWITCH: {
5121 22 50       46 if (!$char) {
  22         77  
5122 0         0 push @$ref, ['461', 'STATS'];
5123 0         0 last SWITCH;
5124             }
5125 22         78 $char = substr $char, 0, 1;
5126 22 100       103 if (!$self->state_user_is_operator($nick)) {
5127 21         366 my $lastuse = $self->{state}{lastuse}{stats};
5128 21         74 my $pacewait = $self->{config}{pace_wait};
5129 21 100 100     152 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      66        
5130 1         4 push @$ref, ['263', 'STATS'];
5131 1         4 last SWITCH;
5132             }
5133 20         68 $self->{state}{lastuse}{stats} = time();
5134             }
5135 21 100 66     149 if ($char =~ /^[Ll]$/ && !$target) {
5136 2         60 push @$ref, ['461', 'STATS'];
5137 2         9 last SWITCH;
5138             }
5139 19 100       92 if ($target) {
5140 1         8 my $targ = $self->_state_find_peer($target);
5141 1 50       4 if (!$targ) {
5142 0         0 push @$ref, [ '402', $target ];
5143 0         0 last SWITCH;
5144             }
5145 1 50       14 if ($targ !~ m!^$sid!) {
5146 1         3 my $psid = substr $targ, 0, 3;
5147 1         6 $self->send_output(
5148             {
5149             prefix => $self->state_user_uid($nick),
5150             command => 'STATS',
5151             params => [
5152             $char,
5153             $targ,
5154             ],
5155             },
5156             $self->_state_sid_route($psid),
5157             );
5158 1         6 last SWITCH;
5159             }
5160             }
5161 18         82 my $uid = $self->state_user_uid($nick);
5162 18         236 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  42         86  
  42         77  
  42         138  
5163 18         111 @{ $self->_daemon_do_stats($uid, $char, $target) };
5164             }
5165              
5166 22 50       200 return @$ref if wantarray;
5167 0         0 return $ref;
5168             }
5169              
5170             sub _rbytes {
5171 4     4   7 my $bytes=shift;
5172 4         6 my $d=2;
5173 4 50       9 return undef if !defined $bytes;
5174 4 100       39 return [ $bytes, 'Bytes' ] if abs($bytes) <= 2** 0*1000;
5175 2 50       38 return [ sprintf("%.*f",$d,$bytes/2**10), 'Kilobytes' ] if abs($bytes) < 2**10*1000;
5176 0 0       0 return [ sprintf("%.*f",$d,$bytes/2**20), 'Megabytes' ] if abs($bytes) < 2**20*1000;
5177 0 0       0 return [ sprintf("%.*f",$d,$bytes/2**30), 'Gigabytes' ] if abs($bytes) < 2**30*1000;
5178 0 0       0 return [ sprintf("%.*f",$d,$bytes/2**40), 'Terabytes' ] if abs($bytes) < 2**40*1000;
5179 0         0 return [ sprintf("%.*f",$d,$bytes/2**50), 'Petabytes' ];
5180             }
5181              
5182             sub _daemon_do_stats {
5183 18     18   46 my $self = shift;
5184 18   50     64 my $uid = shift || return;
5185 18         52 my $char = shift;
5186 18         38 my $targ = shift;
5187 18         43 my $server = $self->server_name();
5188 18         51 my $sid = $self->server_sid();
5189 18         49 my $ref = [ ];
5190              
5191 18         78 my $rec = $self->{state}{uids}{$uid};
5192 18         82 my $is_oper = ( $rec->{umode} =~ /o/ );
5193 18         62 my $is_admin = ( $rec->{umode} =~ /a/ );
5194              
5195 18         177 my %perms = (
5196             admin => qr/[AaEFf]/,
5197             oper => qr/[OoCcDdeHhIiKkLlQqSsTtUvXxYyz?]/,
5198             );
5199              
5200             $self->_send_to_realops(
5201             sprintf(
5202             'STATS %s requested by %s (%s@%s) [%s]',
5203             $char, $rec->{nick}, $rec->{auth}{ident},
5204             $rec->{auth}{hostname}, $rec->{server},
5205 18         291 ), qw[Notice y],
5206             );
5207              
5208             SWITCH: {
5209 18 100 66     36 if (($char =~ $perms{admin} && !$is_admin) ||
  18   66     314  
      100        
5210             ($char =~ $perms{oper} && !$is_oper)) {
5211 17         101 push @$ref, {
5212             prefix => $sid,
5213             command => '481',
5214             params => [
5215             $uid,
5216             'Permission denied - You are not an IRC operator',
5217             ],
5218             };
5219 17         58 last SWITCH;
5220             }
5221 1 50       6 if ($char =~ /^[aA]$/) {
5222 0         0 require Net::DNS::Resolver;
5223 0         0 foreach my $ns ( Net::DNS::Resolver->new()->nameservers ) {
5224 0         0 push @$ref, {
5225             prefix => $sid,
5226             command => '226',
5227             params => [
5228             $uid,
5229             $ns,
5230             ],
5231             };
5232             }
5233 0         0 last SWITCH;
5234             }
5235 1 50       4 if ($char =~ /^[cC]$/) {
5236 0         0 foreach my $peer ( sort keys %{ $self->{config}{peers} } ) {
  0         0  
5237 0         0 my $cblk = $self->{config}{peers}{$peer};
5238 0         0 my $feat;
5239 0 0       0 $feat .= 'A' if $cblk->{auto};
5240 0 0       0 $feat .= 'S' if $cblk->{ssl};
5241 0 0       0 $feat = '*' if !length $feat;
5242             push @$ref, {
5243             prefix => $sid,
5244             command => '213',
5245             params => [
5246             $uid, 'C',
5247             ( $cblk->{raddress} || $cblk->{sockaddr} ),
5248             $feat,
5249             $cblk->{name},
5250 0   0     0 ( $cblk->{rport} || $cblk->{sockport} ),
      0        
5251             'server',
5252             ],
5253             colonify => 0,
5254             };
5255             }
5256 0         0 last SWITCH;
5257             }
5258 1 50       4 if ($char eq 's') {
5259 0         0 foreach my $pseudo ( sort keys %{ $self->{config}{pseudo} } ) {
  0         0  
5260 0         0 my $prec = $self->{config}{pseudo}{$pseudo};
5261             push @$ref, {
5262             prefix => $sid,
5263             command => '227',
5264             params => [
5265             $uid, 's',
5266             $prec->{cmd},
5267             $prec->{name},
5268             join( '@', $prec->{nick},
5269             $prec->{host}),
5270 0   0     0 ( $prec->{prepend} || '*' ),
5271             ],
5272             };
5273             }
5274 0         0 last SWITCH;
5275             }
5276 1 50       15 if ($char eq 'S') {
5277 0         0 foreach my $service ( sort keys %{ $self->{state}{services} } ) {
  0         0  
5278 0         0 my $srec = $self->{state}{services}{$service};
5279             push @$ref, {
5280             prefix => $sid,
5281             command => '246',
5282             params => [
5283             $uid, 'S', '*', '*',
5284 0         0 $srec->{name}, 0, 0,
5285             ],
5286             colonify => 0,
5287             };
5288             }
5289 0         0 last SWITCH;
5290             }
5291 1 50       7 if ($char =~ /^[Dd]$/) {
5292 0         0 my $tdline = ( $char eq 'd' );
5293 0         0 foreach my $dline ( @{ $self->{state}{dlines} } ) {
  0         0  
5294 0 0 0     0 next if $tdline && !$dline->{duration};
5295 0 0 0     0 next if !$tdline && $dline->{duration};
5296             push @$ref, {
5297             prefix => $sid,
5298             command => '225',
5299             params => [
5300             $uid, $char,
5301             $dline->{mask}, $dline->{reason},
5302 0         0 ],
5303             };
5304             }
5305 0         0 last SWITCH;
5306             }
5307 1 50       4 if ($char eq 'e') {
5308 0         0 foreach my $mask ( sort keys %{ $self->{exemptions} } ) {
  0         0  
5309 0         0 push @$ref, {
5310             prefix => $sid,
5311             command => '225',
5312             params => [
5313             $uid, $char,
5314             $mask, '',
5315             ],
5316             };
5317             }
5318 0         0 last SWITCH;
5319             }
5320 1 50       12 if ($char =~ /^[Xx]$/) {
5321 0         0 my $txline = ( $char eq 'x' );
5322 0         0 foreach my $xline ( @{ $self->{state}{xlines} } ) {
  0         0  
5323 0 0 0     0 next if $txline && !$xline->{duration};
5324 0 0 0     0 next if !$txline && $xline->{duration};
5325             push @$ref, {
5326             prefix => $sid,
5327             command => '247',
5328             params => [
5329             $uid, $char,
5330             $xline->{mask}, $xline->{reason},
5331 0         0 ],
5332             };
5333             }
5334 0         0 last SWITCH;
5335             }
5336 1 50       5 if ($char =~ /^[Kk]$/) {
5337 0         0 my $tkline = ( $char eq 'k' );
5338 0         0 foreach my $kline ( @{ $self->{state}{klines} } ) {
  0         0  
5339 0 0 0     0 next if $tkline && !$kline->{duration};
5340 0 0 0     0 next if !$tkline && $kline->{duration};
5341             push @$ref, {
5342             prefix => $sid,
5343             command => '216',
5344             params => [
5345             $uid, $char,
5346             $kline->{host}, '*',
5347             $kline->{user}, $kline->{reason},
5348 0         0 ],
5349             };
5350             }
5351 0         0 last SWITCH;
5352             }
5353 1 50       4 if ($char eq 'v') {
5354 0         0 my $srec = $self->{state}{sids}{$sid};
5355 0         0 my $count = 0;
5356 0         0 foreach my $psid ( keys %{ $srec->{sids} } ) {
  0         0  
5357 0         0 my $prec = $srec->{sids}{$psid};
5358 0         0 my $peer = $self->{config}{peers}{uc $prec->{name}};
5359 0         0 my $type = '*';
5360 0 0       0 $type = 'AutoConn.' if $peer->{auto};
5361 0 0       0 $type = 'Remote.' if $peer->{type} ne 'r';
5362             push @$ref, {
5363             prefix => $sid,
5364             command => '249',
5365             params => [
5366             $uid, 'v',
5367             $prec->{name},
5368             sprintf('(%s!%s@%s)', $type, '*', '*'),
5369             'Idle:',
5370 0         0 ( time() - $prec->{seen} ),
5371             ],
5372             colonify => 0,
5373             };
5374 0         0 $count++;
5375             }
5376 0         0 push @$ref, {
5377             prefix => $sid,
5378             command => '249',
5379             params => [
5380             $uid, 'v',
5381             "$count Server(s)",
5382             ],
5383             };
5384 0         0 last SWITCH;
5385             }
5386 1 50       3 if ($char eq 'P') {
5387 0         0 foreach my $listener ( keys %{ $self->{listeners} } ) {
  0         0  
5388 0         0 my $lrec = $self->{listeners}{$listener};
5389             push @$ref, {
5390             prefix => $sid,
5391             command => '220',
5392             params => [
5393             $uid, 'P',
5394             $lrec->{port},
5395             ( $is_admin ?
5396             ( $lrec->{bindaddr} || '*' ) : $server ),
5397             '*',
5398 0 0 0     0 ( $lrec->{usessl} ? 's' : 'S' ),
    0          
5399             'active',
5400             ],
5401             };
5402             }
5403 0         0 last SWITCH;
5404             }
5405 1 50       4 if ($char eq 'u') {
5406 0         0 my $uptime = time - $self->server_config('created');
5407 0         0 my $days = int $uptime / 86400;
5408 0         0 my $remain = $uptime % 86400;
5409 0         0 my $hours = int $remain / 3600;
5410 0         0 $remain %= 3600;
5411 0         0 my $mins = int $remain / 60;
5412 0         0 $remain %= 60;
5413              
5414 0         0 push @$ref, {
5415             prefix => $sid,
5416             command => '242',
5417             params => [
5418             $uid,
5419             sprintf("Server Up %d days, %2.2d:%2.2d:%2.2d",
5420             $days, $hours, $mins, $remain),
5421             ],
5422             };
5423              
5424 0         0 my $totalconns = $self->{state}{stats}{conns_cumlative};
5425 0         0 my $local = $self->{state}{stats}{maxlocal};
5426 0         0 my $conns = $self->{state}{stats}{maxconns};
5427              
5428 0         0 push @$ref, {
5429             prefix => $sid,
5430             command => '250',
5431             params => [
5432             $uid, 'u',
5433             "Highest connection count: $conns ($local "
5434             ."clients) ($totalconns connections received)",
5435             ],
5436             };
5437 0         0 last SWITCH;
5438             }
5439 1 50       4 if ($char =~ /^[mM]$/) {
5440 0         0 my $cmds = $self->{state}{stats}{cmds};
5441             push @$ref, {
5442             prefix => $sid,
5443             command => '212',
5444             params => [
5445             $uid, 'M',
5446             $_,
5447             $cmds->{$_}{local},
5448             $cmds->{$_}{bytes},
5449             $cmds->{$_}{remote},
5450             ],
5451 0         0 } for sort keys %$cmds;
5452 0         0 last SWITCH;
5453             }
5454 1 50       4 if ($char eq 'p') {
5455 0         0 my @ops = map { $self->_client_nickname( $_ ) }
5456 0         0 keys %{ $self->{state}{localops} };
  0         0  
5457 0         0 for my $op (sort @ops) {
5458 0         0 my $record = $self->{state}{users}{uc_irc($op)};
5459 0 0 0     0 next if $record->{umode} =~ /H/ && !$is_oper;
5460             push @$ref, {
5461             prefix => $sid,
5462             command => '249',
5463             params => [
5464             $uid, 'p',
5465             sprintf("[O] %s (%s\@%s) Idle: %u",
5466             $record->{nick}, $record->{auth}{ident},
5467             $record->{auth}{hostname},
5468 0         0 time - $record->{idle_time}),
5469             ],
5470             colonify => 0,
5471             };
5472             }
5473              
5474 0         0 push @$ref, {
5475             prefix => $sid,
5476             command => '249',
5477             params => [$uid, scalar @ops . " OPER(s)"],
5478             };
5479 0         0 last SWITCH;
5480             }
5481 1 50       4 if ($char =~ /^[Oo]$/) {
5482 0         0 foreach my $op ( keys %{ $self->{config}{ops} } ) {
  0         0  
5483 0         0 my $orec = $self->{config}{ops}{$op};
5484 0         0 my $mask = 'localhost';
5485 0 0       0 if ( $orec->{ipmask} ) {
5486 0 0       0 if (ref $orec->{ipmask} eq 'ARRAY') {
5487 0         0 $mask = '';
5488             }
5489             else {
5490 0         0 $mask = $orec->{ipmask};
5491             }
5492             }
5493             push @$ref, {
5494             prefix => $sid,
5495             command => '243',
5496             params => [
5497             $uid, 'O',
5498             sprintf('%s@%s','*', $mask ),
5499             '*', $orec->{username},
5500 0         0 $orec->{umode}, 'opers',
5501             ],
5502             };
5503             }
5504 0         0 last SWITCH;
5505             }
5506 1 50       5 if ($char =~ /^[Qq]$/) {
5507 0         0 my @chans; my @nicks;
5508 0         0 foreach my $mask ( sort keys %{ $self->{state}{resvs} } ) {
  0         0  
5509 0 0       0 if ($mask =~ m!^\#!) {
5510 0         0 push @chans, $mask;
5511             }
5512             else {
5513 0         0 push @nicks, $mask;
5514             }
5515             }
5516 0         0 foreach my $mask (@chans,@nicks) {
5517 0         0 my $resv = $self->{state}{resvs}{$mask};
5518             push @$ref, {
5519             prefix => $sid,
5520             command => '217',
5521             params => [
5522             $uid,
5523             ( $resv->{duration} ? 'q' : 'Q' ),
5524             $resv->{mask}, $resv->{reason},
5525 0 0       0 ],
5526             };
5527             }
5528 0         0 last SWITCH;
5529             }
5530 1 50       4 if ($char =~ /^[Ll]$/) {
5531 0         0 my $doall = 0;
5532 0 0       0 if (uc $targ eq uc $server) {
    0          
5533 0         0 $doall = 1;
5534             }
5535             elsif ($targ eq $sid) {
5536 0         0 $doall = 1;
5537             }
5538 0         0 my $name = $targ;
5539 0 0 0     0 if (!$doall && $name =~ m!^[0-9]!) {
5540 0         0 $name = $self->state_user_nick($name);
5541             }
5542 0         0 my $conns = $self->{state}{conns};
5543 0         0 my %connects;
5544 0         0 foreach my $conn_id ( keys %$conns ) {
5545 0         0 push @{ $connects{ $conns->{$conn_id}{type} } }, $conn_id;
  0         0  
5546             }
5547             # unknown
5548 0 0       0 foreach my $conn_id ( @{ ( $doall ? $connects{u} : [] ) } ) {
  0         0  
5549 0         0 my $connrec = $conns->{$conn_id};
5550 0         0 my $send = $connrec->{stats}->send();
5551 0         0 my $recv = $connrec->{stats}->recv();
5552 0         0 my $msgs = $self->connection_msgs($conn_id);
5553             push @$ref, {
5554             prefix => $sid,
5555             command => '211',
5556             params => [
5557             $uid,
5558             sprintf(
5559             '%s[%s@%s]', ( $connrec->{nick} || '' ),
5560             ( $connrec->{auth}{ident} || 'unknown' ),
5561             ( $char eq 'L' ? $connrec->{socket}[0] :
5562             ($connrec->{auth}{hostname} || $connrec->{socket}[0] ) ),
5563             ), '0', $msgs->[0], ( $send >> 10 ), $msgs->[1], ( $recv >> 10 ),
5564             sprintf(
5565             '%s %s -',
5566             ( time - $connrec->{conn_time} ),
5567 0 0 0     0 ( time > $connrec->{seen} ? ( time - $connrec->{seen} ) : 0 ),
    0 0        
      0        
5568             ),
5569             ],
5570             };
5571             }
5572             # clients
5573 0         0 foreach my $conn_id ( sort { $conns->{$a}{nick} <=> $conns->{$b}{nick} }
  0         0  
5574 0         0 @{ $connects{c} } ) {
5575 0 0 0     0 next if !$doall && !matches_mask($name,$conns->{$conn_id}{nick});
5576 0         0 my $connrec = $conns->{$conn_id};
5577 0         0 my $send = $connrec->{stats}->send();
5578 0         0 my $recv = $connrec->{stats}->recv();
5579 0         0 my $msgs = $self->connection_msgs($conn_id);
5580             push @$ref, {
5581             prefix => $sid,
5582             command => '211',
5583             params => [
5584             $uid,
5585             sprintf(
5586             '%s[%s@%s]', ( $connrec->{nick} || '' ),
5587             ( $connrec->{auth}{ident} || 'unknown' ),
5588             ( $char eq 'L' ? $connrec->{socket}[0] :
5589             ($connrec->{auth}{hostname} || $connrec->{socket}[0] ) ),
5590             ), '0', $msgs->[0], ( $send >> 10 ), $msgs->[1], ( $recv >> 10 ),
5591             sprintf(
5592             '%s %s -',
5593             ( time - $connrec->{conn_time} ),
5594 0 0 0     0 ( time > $connrec->{seen} ? ( time - $connrec->{seen} ) : 0 ),
    0 0        
      0        
5595             ),
5596             ],
5597             };
5598             }
5599             # servers
5600 0         0 foreach my $conn_id ( sort { $conns->{$a}{name} cmp $conns->{$b}{name} }
  0         0  
5601 0         0 @{ $connects{p} } ) {
5602 0 0 0     0 next if !$doall && !matches_mask($name,$conns->{$conn_id}{name});
5603 0         0 my $connrec = $conns->{$conn_id};
5604 0         0 my $send = $connrec->{stats}->send();
5605 0         0 my $recv = $connrec->{stats}->recv();
5606 0         0 my $msgs = $self->connection_msgs($conn_id);
5607             push @$ref, {
5608             prefix => $sid,
5609             command => '211',
5610             params => [
5611             $uid,
5612             sprintf(
5613             '%s[%s@%s]', ( $connrec->{name} || '' ),
5614             ( $connrec->{auth}{ident} || 'unknown' ),
5615             ( $char eq 'L' ? $connrec->{socket}[0] :
5616             ($connrec->{auth}{hostname} || $connrec->{socket}[0] ) ),
5617             ), '0', $msgs->[0], ( $send >> 10 ), $msgs->[1], ( $recv >> 10 ),
5618             sprintf(
5619             '%s %s %s',
5620             ( time - $connrec->{conn_time} ),
5621             ( time > $connrec->{seen} ? ( time - $connrec->{seen} ) : 0 ),
5622 0 0 0     0 join ' ', @{ $connrec->{capab} },
  0 0 0     0  
      0        
5623             ),
5624             ],
5625             };
5626             }
5627 0         0 last SWITCH;
5628             }
5629 1 50       4 if ($char eq '?') {
5630 1         2 my $trecv = my $tsent = 0; my $scnt = 0;
  1         2  
5631 1         3 foreach my $link ( sort keys %{ $self->{state}{sids}{$sid}{sids} } ) {
  1         10  
5632 2         4 $scnt++;
5633 2         5 my $srec = $self->{state}{sids}{$link};
5634 2         8 my $send = $srec->{stats}->send();
5635 2         22 my $recv = $srec->{stats}->recv();
5636 2         30 my $msgs = $self->connection_msgs($srec->{route_id});
5637 2         5 $trecv += $recv; $tsent += $send;
  2         4  
5638             push @$ref, {
5639             prefix => $sid,
5640             command => '211',
5641             params => [
5642             $uid,
5643             sprintf('%s[unknown@%s]', $srec->{name}, $srec->{socket}[0]),
5644             '0', $msgs->[0], ( $send >> 10 ), $msgs->[1], ( $recv >> 10 ),
5645             sprintf(
5646             '%s %s %s',
5647             ( time - $srec->{conn_time} ),
5648             ( time > $srec->{seen} ? ( time - $srec->{seen} ) : 0 ),
5649 2 50       17 join(' ', @{ $srec->{capab} })
  2         21  
5650             ),
5651             ],
5652             };
5653             }
5654 1         7 push @$ref, {
5655             prefix => $sid,
5656             command => '249',
5657             params => [ $uid, '?', "$scnt total server(s)", ],
5658             };
5659             push @$ref, {
5660             prefix => $sid,
5661             command => '249',
5662             params => [
5663 1         4 $uid, '?', sprintf('Sent total: %s %s', @{ _rbytes($tsent) }),
  1         3  
5664             ],
5665             };
5666             push @$ref, {
5667             prefix => $sid,
5668             command => '249',
5669             params => [
5670 1         4 $uid, '?', sprintf('Recv total: %s %s', @{ _rbytes($trecv) }),
  1         3  
5671             ],
5672             };
5673 1         6 my $uptime = time - $self->server_config('created');
5674             push @$ref, {
5675             prefix => $sid,
5676             command => '249',
5677             params => [
5678             $uid, '?', sprintf(
5679             'Server send: %s %s (%4.1f K/s)',
5680 1         4 @{ _rbytes($self->{_globalstats}{sent}) },
5681             ( $uptime == 0 ? 0 :
5682 1 50       4 ( ($self->{_globalstats}{sent} >> 10) / $uptime )
5683             ),
5684             ),
5685             ],
5686             };
5687             push @$ref, {
5688             prefix => $sid,
5689             command => '249',
5690             params => [
5691             $uid, '?', sprintf(
5692             'Server recv: %s %s (%4.1f K/s)',
5693 1         3 @{ _rbytes($self->{_globalstats}{recv}) },
5694             ( $uptime == 0 ? 0 :
5695 1 50       4 ( ($self->{_globalstats}{sent} >> 10) / $uptime )
5696             ),
5697             ),
5698             ],
5699             };
5700 1         4 last SWITCH;
5701             }
5702             }
5703              
5704 18         98 push @$ref, {
5705             prefix => $sid,
5706             command => '219',
5707             params => [$uid, $char, 'End of /STATS report'],
5708             };
5709              
5710 18 50       63 return @$ref if wantarray;
5711 18         116 return $ref;
5712             }
5713              
5714             sub _daemon_cmd_userhost {
5715 1     1   4 my $self = shift;
5716 1   50     4 my $nick = shift || return;
5717 1         5 my $server = $self->server_name();
5718 1         3 my $ref = [ ];
5719 1         5 my $str = '';
5720 1         3 my $cnt = 0;
5721              
5722 1         4 for my $query (@_) {
5723 3 50       9 last if $cnt >= 5;
5724 3         8 $cnt++;
5725 3         12 my $uid = $self->state_user_uid($query);
5726 3 50       44 next if !$uid;
5727 3         10 my $urec = $self->{state}{uids}{$uid};
5728 3         12 my ($name,$uh) = split /!/, $urec->{full}->();
5729 3 100       11 if ( $nick eq $name ) {
5730 1         6 $uh = join '@', (split /\@/, $uh)[0], $urec->{socket}[0];
5731             }
5732 3         6 my $status = '';
5733 3 50 33     48 if ( $urec->{umode} =~ /o/ && ( $urec->{umode} !~ /H/ ||
      66        
5734             $self->state_user_is_operator($nick) ) ) {
5735 1         3 $status .= '*';
5736             }
5737 3         5 $status .= '=';
5738 3 50       9 $status .= ( defined $urec->{away} ? '-' : '+' );
5739 3         12 $str = join ' ', $str, $name . $status . $uh;
5740 3         12 $str =~ s!^ !!g;
5741             }
5742              
5743 1 50       7 push @$ref, {
5744             prefix => $server,
5745             command => '302',
5746             params => [$nick, ($str ? $str : ':')],
5747             };
5748              
5749 1 50       11 return @$ref if wantarray;
5750 0         0 return $ref;
5751             }
5752              
5753             sub _daemon_cmd_ison {
5754 0     0   0 my $self = shift;
5755 0   0     0 my $nick = shift || return;
5756 0         0 my $server = $self->server_name();
5757 0         0 my $ref = [ ];
5758 0         0 my $args = [@_];
5759 0         0 my $count = @$args;
5760              
5761             SWITCH: {
5762 0 0       0 if (!$count) {
  0         0  
5763 0         0 push @$ref, ['461', 'ISON'];
5764 0         0 last SWITCH;
5765             }
5766 0         0 my $string = '';
5767             $string = join ' ', map {
5768             $self->{state}{users}{uc_irc($_)}{nick}
5769 0         0 } grep { $self->state_nick_exists($_) } @$args;
  0         0  
  0         0  
5770              
5771 0 0       0 push @$ref, {
5772             prefix => $server,
5773             command => '303',
5774             params => [$nick, ($string =~ /\s+/ ? $string : ":$string")],
5775             };
5776             }
5777              
5778 0 0       0 return @$ref if wantarray;
5779 0         0 return $ref;
5780             }
5781              
5782             sub _daemon_do_safelist {
5783 130     130   23615 my ($kernel,$self,$client) = @_[KERNEL,OBJECT,ARG0];
5784 130         366 my $server = $self->server_name();
5785 130         315 my $mask = $client->{safelist};
5786 130 100       422 return if !$mask;
5787 129         284 my $start = delete $mask->{start};
5788              
5789 129 100       317 if ($start) {
5790             $self->send_output(
5791             {
5792             prefix => $server,
5793             command => '321',
5794             params => [$client->{nick}, 'Channel', 'Users Name'],
5795             },
5796             $client->{route_id},
5797 7         92 );
5798 7         23 $mask->{chans} = [ keys %{ $self->{state}{chans} } ];
  7         125  
5799 7         40 $kernel->yield('_daemon_do_safelist',$client);
5800 7         517 return;
5801             }
5802             else {
5803 122         257 my $chan = shift @{ $mask->{chans} };
  122         305  
5804 122 100       380 if (!$chan) {
5805             $self->send_output(
5806             {
5807             prefix => $server,
5808             command => '323',
5809             params => [$client->{nick}, 'End of /LIST'],
5810             },
5811             $client->{route_id},
5812 6         64 );
5813 6         25 delete $client->{safelist};
5814 6         37 return;
5815             }
5816 116         204 my $show = 0;
5817             SWITCH: {
5818 116 50       210 last SWITCH if !defined $self->{state}{chans}{$chan};
  116         423  
5819 116 100       259 if ($mask->{all}) {
5820 30         51 $show = 1;
5821 30         55 last SWITCH;
5822             }
5823 86 50       220 if ($mask->{hide}) {
5824 0         0 my $match = matches_mask_array($mask->{hide},[$chan]);
5825 0 0       0 $show = 0 if keys %$match;
5826 0         0 last SWITCH;
5827             }
5828 86 100       204 if ($mask->{show}) {
5829 30         124 my $match = matches_mask_array($mask->{show},[$chan]);
5830 30 100       1829 if ( keys %$match ) {
5831 8         28 $show = 1;
5832             }
5833             else {
5834 22         35 $show = 0;
5835 22         61 last SWITCH;
5836             }
5837             }
5838 64 100 66     289 if ($mask->{users_max} || $mask->{users_min}) {
5839 28         44 my $usercnt = keys %{ $self->{state}{chans}{$chan}{users} };
  28         101  
5840 28 50       67 if ($mask->{users_max}) {
5841 0 0       0 if ($usercnt > $mask->{users_max}) {
5842 0         0 $show = 1;
5843             }
5844             else {
5845 0         0 $show = 0;
5846             }
5847             }
5848 28 50       65 if ($mask->{users_min}) {
5849 28 100       61 if ($usercnt < $mask->{users_min}) {
5850 6         16 $show = 1;
5851             }
5852             else {
5853 22         39 $show = 0;
5854             }
5855             }
5856             }
5857 64 50 33     236 if ($mask->{create_max} || $mask->{create_min}) {
5858 0         0 my $chants = $self->{state}{chans}{$chan}{ts};
5859 0 0       0 if ($mask->{create_max}) {
5860 0 0       0 if ($chants > $mask->{create_max}) {
5861 0         0 $show = 1;
5862             }
5863             else {
5864 0         0 $show = 0;
5865             }
5866             }
5867 0 0       0 if ($mask->{create_min}) {
5868 0 0       0 if ($chants < $mask->{create_min}) {
5869 0         0 $show = 1;
5870             }
5871             else {
5872 0         0 $show = 0;
5873             }
5874             }
5875             }
5876 64 100 33     351 if ($mask->{topic_max} || $mask->{topic_min} || $mask->{topic_msk}) {
      66        
5877 28         73 my $chantopic = $self->{state}{chans}{$chan}{topic};
5878 28 100       62 if (!$chantopic) {
5879 24         45 $show = 0;
5880             }
5881             else {
5882 4 50       13 if ($mask->{topic_max}) {
5883 0 0       0 if($mask->{topic_max} > $chantopic->[2]) {
5884 0         0 $show = 1;
5885             }
5886             else {
5887 0         0 $show = 0;
5888             }
5889             }
5890 4 50       13 if ($mask->{topic_min}) {
5891 0 0       0 if($mask->{topic_min} < $chantopic->[2]) {
5892 0         0 $show = 1;
5893             }
5894             else {
5895 0         0 $show = 0;
5896             }
5897             }
5898 4 50       12 if ($mask->{topic_msk}) {
5899 4 100       19 if(matches_mask($mask->{topic_msk},$chantopic->[0],'ascii')) {
5900 2         146 $show = 1;
5901             }
5902             else {
5903 2         88 $show = 0;
5904             }
5905             }
5906             }
5907             }
5908             }
5909 116         501 my $hidden = ( $self->{state}{chans}{$chan}{mode} =~ m![ps]! );
5910 116 100 100     466 if ($show && $hidden && !defined $client->{chans}{$chan}) {
      66        
5911 2         7 $show = 0;
5912             }
5913 116 100       233 if ($show) {
5914 44         95 my $chanrec = $self->{state}{chans}{$chan};
5915 44         228 my $bluf = sprintf('[+%s]', $chanrec->{mode});
5916 44 100       137 if ( defined $chanrec->{topic} ) {
5917 10         46 $bluf = join ' ', $bluf, $chanrec->{topic}[0];
5918             }
5919             $self->send_output(
5920             {
5921             prefix => $server,
5922             command => '322',
5923             params => [
5924             $client->{nick},
5925             $chanrec->{name},
5926 44         425 scalar keys %{ $chanrec->{users} },
5927             $bluf,
5928             ],
5929             },
5930             $client->{route_id},
5931 44         133 );
5932             }
5933 116         461 $kernel->yield('_daemon_do_safelist',$client);
5934             }
5935 116         8457 return;
5936             }
5937              
5938             sub _daemon_cmd_list {
5939 8     8   24 my $self = shift;
5940 8   50     32 my $nick = shift || return;
5941 8         26 my $server = $self->server_name();
5942 8         21 my $ref = [ ];
5943 8         26 my $args = [@_];
5944 8         22 my $count = @$args;
5945              
5946             SWITCH: {
5947 8         16 my $rec = $self->{state}{users}{uc_irc $nick};
  8         59  
5948 8         191 my $task = { start => 1 };
5949 8         20 my $errors;
5950 8 100       33 if (!$count) {
5951 3 100       15 if ($rec->{safelist}) {
5952 1         10 delete $rec->{safelist};
5953 1         7 push @$ref, {
5954             prefix => $server,
5955             command => '323',
5956             params => [$nick, 'End of /LIST'],
5957             };
5958 1         5 last SWITCH;
5959             }
5960 2         22 $task->{all} = 1;
5961             }
5962             else {
5963 5         26 OPTS: foreach my $opt ( split /,/, $args->[0] ) {
5964 5 100       42 if ($opt =~ m!^T!i) {
5965 1 0 33     8 if ($opt !~ m!^T:!i && $opt !~ m!^T[<>]\d+$!i) {
5966 0         0 $errors++;
5967 0         0 last OPTS;
5968             }
5969 1         10 my ($pre,$act,$mins) = $opt =~ m!^(T)([<>:])(.+)$!i;
5970 1 50       8 if ($act eq '<') {
    50          
5971 0         0 $task->{topic_min} = time() - ( $mins * 60 );
5972             }
5973             elsif ($act eq '>') {
5974 0         0 $task->{topic_max} = time() - ( $mins * 60 );
5975             }
5976             else {
5977 1         6 $task->{topic_msk} = $mins;
5978             }
5979 1         5 next OPTS;
5980             }
5981 4 50       26 if ($opt =~ m!^C!i) {
5982 0 0       0 if ($opt !~ m!^C[<>]\d+$!i) {
5983 0         0 $errors++;
5984 0         0 last OPTS;
5985             }
5986 0         0 my ($pre,$act,$mins) = $opt =~ m!^(C)([<>])(\d+)$!i;
5987 0 0       0 if ($act eq '<') {
5988 0         0 $task->{create_min} = time() - ( $mins * 60 );
5989             }
5990             else {
5991 0         0 $task->{create_max} = time() - ( $mins * 60 );
5992             }
5993 0         0 next OPTS;
5994             }
5995 4 100       21 if ($opt =~ m!^\
5996 1 50       9 if ($opt !~ m!^\<\d+$!) {
5997 0         0 $errors++;
5998 0         0 last OPTS;
5999             }
6000 1         8 my ($act,$users) = $opt =~ m!^(\<)(\d+)$!;
6001 1         5 $task->{users_min} = $users;
6002 1         5 next OPTS;
6003             }
6004 3 50       12 if ($opt =~ m!^\>!) {
6005 0 0       0 if ($opt !~ m!^\>\d+$!) {
6006 0         0 $errors++;
6007 0         0 last OPTS;
6008             }
6009 0         0 my ($act,$users) = $opt =~ m!^(\>)(\d+)$!;
6010 0         0 $task->{users_max} = $users;
6011 0         0 next OPTS;
6012             }
6013 3         13 my ($hide) = $opt =~ s/^!//;
6014 3 50 66     28 if ($opt !~ m![\x2A\x3F]! && $opt !~ m!^[#&]! ) {
6015 0         0 $errors++;
6016 0         0 last OPTS;
6017             }
6018 3 50       11 if ( $hide ) {
6019 0         0 push @{ $task->{hide} }, $opt;
  0         0  
6020             }
6021             else {
6022 3         6 push @{ $task->{show} }, $opt;
  3         18  
6023             }
6024             }
6025             }
6026 7 50       38 if ( $errors ) {
6027 0         0 push @$ref, ['521'];
6028 0         0 last SWITCH;
6029             }
6030 7         22 $rec->{safelist} = $task;
6031 7         41 $poe_kernel->yield('_daemon_do_safelist',$rec);
6032             }
6033              
6034 8 50       576 return @$ref if wantarray;
6035 0         0 return $ref;
6036             }
6037              
6038             sub _daemon_cmd_names {
6039 110     110   311 my $self = shift;
6040 110   50     453 my $nick = shift || return;
6041 110         431 my $server = $self->server_name();
6042 110         323 my $ref = [ ];
6043 110         330 my $args = [@_];
6044 110         321 my $count = @$args;
6045              
6046             # TODO: hybrid only seems to support NAMES #channel so fix this
6047             SWITCH: {
6048 110         224 my (@chans, $query);
  110         262  
6049 110 50       399 if (!$count) {
6050 0         0 @chans = $self->state_user_chans($nick);
6051 0         0 $query = '*';
6052             }
6053 110         357 my $last = pop @$args;
6054 110 50 33     1244 if ($count && $last !~ /^[#&]/
      33        
6055             && !$self->state_peer_exists($last)) {
6056 0         0 push @$ref, ['401', $last];
6057 0         0 last SWITCH;
6058             }
6059 110 50 33     1096 if ($count && $last !~ /^[#&]/ & uc $last ne uc $server) {
6060 0         0 $self->send_output(
6061             {
6062             prefix => $nick,
6063             command => 'NAMES',
6064             params => [@$args, $self->_state_peer_name($last)],
6065             },
6066             $self->_state_peer_route($last),
6067             );
6068 0         0 last SWITCH;
6069             }
6070 110 50 33     1045 if ($count && $last !~ /^[#&]/ && @$args == 0) {
      33        
6071 0         0 @chans = $self->state_user_chans($nick);
6072 0         0 $query = '*';
6073             }
6074 110 50 33     1054 if ($count && $last !~ /^[#&]/ && @$args == 1) {
      33        
6075 0         0 $last = pop @$args;
6076             }
6077 110 50 33     945 if ($count && $last =~ /^[#&]/) {
6078             my ($chan) = grep {
6079 110 50 33     555 $_ && $self->state_chan_exists($_)
  110         683  
6080             && $self->state_is_chan_member($nick, $_)
6081             } split /,/, $last;
6082 110         1813 @chans = ();
6083              
6084 110 50       412 if ($chan) {
6085 110         300 push @chans, $chan;
6086 110         584 $query = $self->_state_chan_name($chan);
6087             }
6088             else {
6089 0         0 $query = '*';
6090             }
6091             }
6092              
6093 110         1401 my $chan_prefix_method = 'state_chan_list_prefixed';
6094 110         461 my $uid = $self->state_user_uid($nick);
6095             $chan_prefix_method = 'state_chan_list_multi_prefixed'
6096 110 100       2393 if $self->{state}{uids}{$uid}{caps}{'multi-prefix'};
6097              
6098 110 100       815 my $flag = ( $self->{state}{uids}{$uid}{caps}{'userhost-in-names'} ? 'FULL' : '' );
6099              
6100 110         601 for my $chan (@chans) {
6101 110         491 my $record = $self->{state}{chans}{uc_irc($chan)};
6102 110         1376 my $type = '=';
6103 110 50       568 $type = '@' if $record->{mode} =~ /s/;
6104 110 50       539 $type = '*' if $record->{mode} =~ /p/;
6105 110         397 my $length = length($server)+3+length($chan)+length($nick)+7;
6106 110         222 my $buffer = '';
6107              
6108 110         716 for my $name (sort $self->$chan_prefix_method($record->{name},$flag)) {
6109 193 50       840 if (length(join ' ', $buffer, $name) + $length > 510) {
6110             push @$ref, {
6111             prefix => $server,
6112             command => '353',
6113 0         0 params => [$nick, $type, $record->{name}, $buffer]
6114             };
6115 0         0 $buffer = $name;
6116 0         0 next;
6117             }
6118 193 100       535 if ($buffer) {
6119 83         247 $buffer = join ' ', $buffer, $name;
6120             }
6121             else {
6122 110         299 $buffer = $name;
6123             }
6124             }
6125             push @$ref, {
6126             prefix => $server,
6127             command => '353',
6128 110         985 params => [$nick, $type, $record->{name}, $buffer],
6129             };
6130             }
6131 110         716 push @$ref, {
6132             prefix => $server,
6133             command => '366',
6134             params => [$nick, $query, 'End of NAMES list'],
6135             };
6136             }
6137              
6138 110 50       1274 return @$ref if wantarray;
6139 0         0 return $ref;
6140             }
6141              
6142             sub _daemon_cmd_whois {
6143 6     6   22 my $self = shift;
6144 6   50     33 my $nick = shift || return;
6145 6         27 my $server = $self->server_name();
6146 6         21 my $ref = [ ];
6147 6         25 my ($first, $second) = @_;
6148              
6149             SWITCH: {
6150 6 0 33     16 if (!$first && !$second) {
  6         28  
6151 0         0 push @$ref, ['431'];
6152 0         0 last SWITCH;
6153             }
6154 6 100 66     48 if (!$second && $first) {
6155 5         26 $second = (split /,/, $first)[0];
6156 5         14 $first = $server;
6157             }
6158 6 50 33     44 if ($first && $second) {
6159 6         27 $second = (split /,/, $second)[0];
6160             }
6161 6 100 66     40 if (uc_irc($first) eq uc_irc($second)
6162             && $self->state_nick_exists($second)) {
6163 1         9 $first = $self->state_user_server($second);
6164             }
6165 6         165 my $query;
6166             my $target;
6167 6 50       89 $query = $first if !$second;
6168 6 50       29 $query = $second if $second;
6169 6 100 66     54 $target = $first if $second && uc $first ne uc $server;
6170 6 50 66     49 if ($target && !$self->state_peer_exists($target)) {
6171 0         0 push @$ref, ['402', $target];
6172 0         0 last SWITCH;
6173             }
6174 6 100       23 if ($target) {
6175             }
6176             # Okay we got here *phew*
6177 6 50       33 if (!$self->state_nick_exists($query)) {
6178 0         0 push @$ref, ['401', $query];
6179             }
6180             else {
6181 6         41 my $uid = $self->state_user_uid($nick);
6182 6         90 my $who = $self->state_user_uid($query);
6183 6 100       104 if ( $target ) {
6184 1         8 my $tsid = $self->_state_peer_sid($target);
6185 1 50       51 if ( $who =~ m!^$tsid! ) {
6186 1         14 $self->send_output(
6187             {
6188             prefix => $self->state_user_uid($nick),
6189             command => 'WHOIS',
6190             params => [
6191             $tsid,
6192             $query,
6193             ],
6194             },
6195             $self->_state_sid_route($tsid),
6196             );
6197 1         8 last SWITCH;
6198             }
6199             }
6200 5         36 $ref = $self->_daemon_do_whois($uid,$who);
6201 5         28 foreach my $reply ( @$ref ) {
6202 30         54 $reply->{prefix} = $server;
6203 30         63 $reply->{params}[0] = $nick;
6204             }
6205             }
6206             }
6207              
6208 6 50       62 return @$ref if wantarray;
6209 0         0 return $ref;
6210             }
6211              
6212             sub _daemon_peer_whois {
6213 2     2   6 my $self = shift;
6214 2         6 my $peer_id = shift;
6215 2   50     12 my $uid = shift || return;
6216 2         8 my $sid = $self->server_sid();
6217 2         6 my $ref = [ ];
6218 2         8 my ($first, $second) = @_;
6219              
6220 2         9 my $targ = substr $first, 0, 3;
6221             SWITCH: {
6222 2 100       5 if ( $targ !~ m!^$sid! ) {
  2         59  
6223 1         10 $self->send_output(
6224             {
6225             prefix => $uid,
6226             command => 'WHOIS',
6227             params => [
6228             $first,
6229             $second,
6230             ],
6231             },
6232             $self->_state_sid_route($targ),
6233             );
6234 1         5 last SWITCH;
6235             }
6236 1         6 my $who = $self->state_user_uid($second);
6237 1         17 $ref = $self->_daemon_do_whois($uid,$who);
6238             }
6239              
6240 2 50       25 return @$ref if wantarray;
6241 0         0 return $ref;
6242             }
6243              
6244             sub _daemon_do_whois {
6245 6     6   16 my $self = shift;
6246 6   50     31 my $uid = shift || return;
6247 6         27 my $sid = $self->server_sid();
6248 6         21 my $server = $self->server_name();
6249 6         29 my $nicklen = $self->server_config('NICKLEN');
6250 6         49 my $ref = [ ];
6251 6         24 my $query = shift;
6252              
6253 6         25 my $querier = $self->{state}{uids}{$uid};
6254 6         21 my $record = $self->{state}{uids}{$query};
6255              
6256             push @$ref, {
6257             prefix => $sid,
6258             command => '311',
6259             params => [
6260             $uid,
6261             $record->{nick},
6262             $record->{auth}{ident},
6263             $record->{auth}{hostname},
6264             '*',
6265             $record->{ircname},
6266 6         61 ],
6267             };
6268 6         16 my @chans;
6269 6   33     46 my $noshow = ( $record->{umode} =~ m!p! && $querier->{umode} !~ m!o! && $uid ne $query );
6270 6         16 LOOP: for my $chan (keys %{ $record->{chans} }) {
  6         49  
6271 6 50       41 next LOOP if $noshow;
6272 6 50 33     53 if ($self->{state}{chans}{$chan}{mode} =~ /[ps]/
6273             && !defined $self->{state}{chans}{$chan}{users}{$uid}) {
6274 0         0 next LOOP;
6275             }
6276 6         17 my $prefix = '';
6277 6 50       108 $prefix .= '@' if $record->{chans}{$chan} =~ /o/;
6278 6 50       58 $prefix .= '%' if $record->{chans}{$chan} =~ /h/;
6279 6 50       38 $prefix .= '+' if $record->{chans}{$chan} =~ /v/;
6280 6         39 push @chans, $prefix . $self->{state}{chans}{$chan}{name};
6281             }
6282 6 50       32 if (@chans) {
6283 6         16 my $buffer = '';
6284             my $length = length($server) + 3 + $nicklen
6285 6         26 + length($record->{nick}) + 7;
6286              
6287 6         20 LOOP2: for my $chan (@chans) {
6288 6 50       176 if (length(join ' ', $buffer, $chan) + $length > 510) {
6289             push @$ref, {
6290             prefix => $sid,
6291             command => '319',
6292 0         0 params => [$uid, $record->{nick}, $buffer],
6293             };
6294 0         0 $buffer = $chan;
6295 0         0 next LOOP2;
6296             }
6297 6 50       30 if ($buffer) {
6298 0         0 $buffer = join ' ', $buffer, $chan;
6299             }
6300             else {
6301 6         38 $buffer = $chan;
6302             }
6303             }
6304             push @$ref, {
6305             prefix => $sid,
6306             command => '319',
6307 6         57 params => [$uid, $record->{nick}, $buffer],
6308             };
6309             }
6310             # RPL_WHOISSERVER
6311 6   66     47 my $hidden = ( $self->{config}{'hidden_servers'} && ( $querier->{umode} !~ /o/ || $uid ne $query ) );
6312             push @$ref, {
6313             prefix => $sid,
6314             command => '312',
6315             params => [
6316             $uid,
6317             $record->{nick},
6318             ( $hidden ? $self->{config}{'hidden_servers'} : $record->{server} ),
6319 6 100       71 ( $hidden ? $self->server_config('NETWORKDESC') : $self->_state_peer_desc($record->{server}) ),
    100          
6320             ],
6321             };
6322             # RPL_WHOISREGNICK
6323             push @$ref, {
6324             prefix => $sid,
6325             command => '307',
6326             params => [
6327             $uid,
6328             $record->{nick},
6329             'has identified for this nick'
6330             ],
6331 6 50       34 } if $record->{umode} =~ m!r!;
6332             # RPL_WHOISACCOUNT
6333             push @$ref, {
6334             prefix => $sid,
6335             command => '330',
6336             params => [
6337             $uid,
6338             $record->{nick},
6339             $record->{account},
6340             'is logged in as'
6341             ],
6342 6 100       62 } if $record->{account} ne '*';
6343             # RPL_AWAY
6344             push @$ref, {
6345             prefix => $sid,
6346             command => '301',
6347             params => [
6348             $uid,
6349             $record->{nick},
6350             $record->{away},
6351             ],
6352 6 50 66     41 } if $record->{type} eq 'c' && $record->{away};
6353 6 50 33     50 if ($record->{umode} !~ m!H! || $querier->{umode} =~ m!o!) {
6354 6         24 my $operstring;
6355 6 100       32 if ( $record->{svstags}{313} ) {
6356 1         4 $operstring = $record->{svstags}{313}{tagline};
6357             }
6358             else {
6359 5 50       34 $operstring = 'is a Network Service' if $self->_state_sid_serv($record->{sid});
6360 5 100 66     50 $operstring = 'is a Server Administrator' if $record->{umode} =~ m!a! && !$operstring;
6361 5 50 66     119 $operstring = 'is an IRC Operator' if $record->{umode} =~ m!o! && !$operstring;
6362             }
6363             push @$ref, {
6364             prefix => $sid,
6365             command => '313',
6366 6 100       73 params => [$uid, $record->{nick}, $operstring],
6367             } if $operstring;
6368             }
6369 6 50 66     45 if ($record->{type} eq 'c' && ($uid eq $query || $querier->{umode} =~ m!o!) ) {
      100        
6370 2         17 my $umodes = join '', '+', sort split //, $record->{umode};
6371             push @$ref, {
6372             prefix => $sid,
6373             command => '379',
6374             params => [
6375             $uid,
6376             $record->{nick},
6377 2         19 "is using modes $umodes"
6378             ],
6379             };
6380             }
6381 6 100 66     54 if ($record->{type} eq 'c'
      100        
6382             && ($self->server_config('whoisactually')
6383             or $self->{state}{uids}{$uid}{umode} =~ /o/)) {
6384             push @$ref, {
6385             prefix => $sid,
6386             command => '338',
6387             params => [
6388             $uid,
6389             $record->{nick},
6390             join('@', $record->{auth}{ident}, $record->{auth}{realhost}),
6391 1   50     21 ( $record->{ipaddress} || 'fake.hidden' ),
6392             'Actual user@host, actual IP',
6393             ],
6394             };
6395             }
6396 6 100       37 if ($record->{type} eq 'c') {
6397             push @$ref, {
6398             prefix => $sid,
6399             command => '317',
6400             params => [
6401             $uid,
6402             $record->{nick},
6403             time - $record->{idle_time},
6404             $record->{conn_time},
6405             'seconds idle, signon time',
6406             ],
6407 2 0 33     36 } if $record->{umode} !~ m!q! || $querier->{umode} =~ m!o! || $uid eq $query;
      33        
6408             }
6409             push @$ref, {
6410             prefix => $sid,
6411             command => '318',
6412 6         49 params => [$uid, $record->{nick}, 'End of /WHOIS list.'],
6413             };
6414              
6415 6 100 66     62 if ($record->{umode} =~ m!y! && $uid ne $query) {
6416             # Send NOTICE
6417 4         16 my $local = ( $record->{sid} eq $sid );
6418             $self->send_output(
6419             {
6420             prefix => ( $local ? $self->server_name() : $sid ),
6421             command => 'NOTICE',
6422             params => [
6423             ( $local ? $record->{nick} : $record->{uid} ),
6424             sprintf('*** Notice -- %s (%s@%s) [%s] is doing a /whois on you',
6425             $querier->{nick}, $querier->{auth}{ident}, $querier->{auth}{hostname},
6426             $querier->{server},
6427             ),
6428             ],
6429             },
6430             $record->{route_id},
6431 4 50       100 );
    50          
6432             }
6433 6 50       34 return @$ref if wantarray;
6434 6         26 return $ref;
6435             }
6436              
6437             sub _daemon_cmd_whowas {
6438 3     3   9 my $self = shift;
6439 3   50     17 my $nick = shift || return;
6440 3         13 my $server = $self->server_name();
6441 3         18 my $sid = $self->server_sid();
6442 3         14 my $ref = [ ];
6443 3         10 my $args = [@_];
6444 3         9 my $count = @$args;
6445              
6446             SWITCH: {
6447 3 50       8 if (!$args->[0]) {
  3         47  
6448 0         0 push @$ref, ['431'];
6449 0         0 last SWITCH;
6450             }
6451 3 50       22 if (!$self->state_user_is_operator($nick)) {
6452 3         62 my $lastuse = $self->{state}{lastuse}{whowas};
6453 3         11 my $pacewait = $self->{config}{pace_wait};
6454 3 0 33     50 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      33        
6455 0         0 push @$ref, ['263', 'WHOWAS'];
6456 0         0 last SWITCH;
6457             }
6458 3         14 $self->{state}{lastuse}{whowas} = time();
6459             }
6460 3         18 my $query = (split /,/, $args->[0])[0];
6461 3 50       15 if ($args->[2]) {
6462 0         0 my $targ = $self->_state_find_peer($args->[2]);
6463 0 0       0 if (!$targ) {
6464 0         0 push @$ref, [ '402', $args->[2] ];
6465 0         0 last SWITCH;
6466             }
6467 0 0       0 if ($targ !~ m!^$sid!) {
6468 0         0 my $psid = substr $targ, 0, 3;
6469 0         0 $self->send_output(
6470             {
6471             prefix => $self->state_user_uid($nick),
6472             command => 'WHOWAS',
6473             params => [
6474             $args->[0], $args->[1], $targ,
6475             ],
6476             },
6477             $self->_state_sid_route($psid),
6478             );
6479 0         0 last SWITCH;
6480             }
6481             }
6482 3         19 my $uid = $self->state_user_uid($nick);
6483 3         47 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  22         40  
  22         33  
  22         54  
6484 3         26 @{ $self->_daemon_do_whowas($uid,@$args) };
6485             }
6486              
6487 3 50       45 return @$ref if wantarray;
6488 0         0 return $ref;
6489             }
6490              
6491             sub _daemon_peer_whowas {
6492 2     2   6 my $self = shift;
6493 2   50     8 my $peer_id = shift || return;
6494 2   50     9 my $uid = shift || return;
6495 2         8 my $server = $self->server_name();
6496 2         7 my $sid = $self->server_sid();
6497 2         7 my $ref = [ ];
6498 2         6 my ($first, $second, $third) = @_;
6499              
6500 2         8 my $targ = substr $third, 0, 3;
6501             SWITCH: {
6502 2 100       4 if ( $targ !~ m!^$sid! ) {
  2         33  
6503 1         21 $self->send_output(
6504             {
6505             prefix => $uid,
6506             command => 'WHOWAS',
6507             params => [
6508             $first,
6509             $second,
6510             $third,
6511             ],
6512             },
6513             $self->_state_sid_route($targ),
6514             );
6515 1         5 last SWITCH;
6516             }
6517 1         6 $ref = $self->_daemon_do_whowas($uid,$first,$second);
6518             }
6519              
6520 2 50       18 return @$ref if wantarray;
6521 0         0 return $ref;
6522             }
6523              
6524             sub _daemon_do_whowas {
6525 4     4   16 my $self = shift;
6526 4   50     15 my $uid = shift || return;
6527 4         40 my $server = $self->server_name();
6528 4         19 my $sid = $self->server_sid();
6529 4         12 my $ref = [ ];
6530 4         10 my $args = [@_];
6531 4         13 my $query = shift @$args;
6532              
6533             SWITCH: {
6534 4         11 my $is_oper = ( $self->{state}{uids}{$uid}{umode} =~ /o/ );
  4         41  
6535 4         22 my $max = shift @$args;
6536 4 50 33     111 if ( $uid !~ m!^$sid! && ( !$max || $max < 0 || $max > 20 ) ) {
      66        
6537 1         4 $max = 20;
6538             }
6539 4 100       39 if (!$self->{state}{whowas}{uc_irc $query}) {
6540 1         27 push @$ref, {
6541             prefix => $sid,
6542             command => '406',
6543             params => [$uid, $query, 'There was no such nickname'],
6544             };
6545 1         5 last SWITCH;
6546             }
6547 3         51 my $cnt = 0;
6548 3         7 WASNOTWAS: foreach my $was ( @{ $self->{state}{whowas}{uc_irc $query} } ) {
  3         37  
6549             push @$ref, {
6550             prefix => $sid,
6551             command => '314',
6552             params => [
6553             $uid,
6554             $was->{nick}, $was->{user}, $was->{host}, '*',
6555             $was->{ircname},
6556 26         253 ],
6557             };
6558             push @$ref, {
6559             prefix => $sid,
6560             command => '338',
6561             params => [
6562             $uid,
6563             $was->{nick},
6564             join('@', $was->{user}, $was->{real}),
6565             $was->{sock},
6566 26 100       166 'Actual user@host, actual IP',
6567             ],
6568             } if $is_oper;
6569             push @$ref, {
6570             prefix => $sid,
6571             command => '330',
6572             params => [
6573             $uid,
6574             $was->{nick},
6575             $was->{account},
6576             'was logged in as',
6577             ],
6578 26 50       138 } if $was->{account} ne '*';
6579             push @$ref, {
6580             prefix => $sid,
6581             command => '312',
6582             params => [
6583             $uid,
6584             $was->{nick},
6585             ( ( $self->{config}{'hidden_servers'} && !$is_oper )
6586             ? ( $self->{config}{'hidden_servers'}, $self->{config}{NETWORKDESC} ) : $was->{server} ),
6587 26 100 66     1351 strftime("%a %b %e %T %Y", localtime($was->{logoff})),
6588             ],
6589             };
6590 26         89 ++$cnt;
6591 26 100 100     164 last WASNOTWAS if $max && $cnt >= $max;
6592             }
6593             }
6594              
6595 4         34 push @$ref, {
6596             prefix => $sid,
6597             command => '369',
6598             params => [$uid, $query, 'End of WHOWAS'],
6599             };
6600              
6601 4 50       19 return @$ref if wantarray;
6602 4         18 return $ref;
6603             }
6604              
6605             sub _daemon_cmd_who {
6606 6     6   19 my $self = shift;
6607 6   50     24 my $nick = shift || return;
6608 6         22 my ($who, $op_only) = @_;
6609 6         25 my $server = $self->server_name();
6610 6         21 my $ref = [ ];
6611 6         15 my $orig = $who;
6612              
6613             SWITCH: {
6614 6 50       14 if (!$who) {
  6         24  
6615 0         0 push @$ref, ['461', 'WHO'];
6616 0         0 last SWITCH;
6617             }
6618 6 50 33     29 if ($self->state_chan_exists($who)
6619             && $self->state_is_chan_member($nick, $who)) {
6620 6         102 my $uid = $self->state_user_uid($nick);
6621 6         97 my $multiprefix = $self->{state}{uids}{$uid}{caps}{'multi-prefix'};
6622 6         25 my $record = $self->{state}{chans}{uc_irc($who)};
6623 6         130 $who = $record->{name};
6624 6         20 for my $member (keys %{ $record->{users} }) {
  6         36  
6625 15         79 my $rpl_who = {
6626             prefix => $server,
6627             command => '352',
6628             params => [$nick, $who],
6629             };
6630 15         38 my $memrec = $self->{state}{uids}{$member};
6631 15         29 push @{ $rpl_who->{params} }, $memrec->{auth}{ident};
  15         55  
6632 15         22 push @{ $rpl_who->{params} }, $memrec->{auth}{hostname};
  15         43  
6633 15         25 push @{ $rpl_who->{params} }, $memrec->{server};
  15         43  
6634 15         28 push @{ $rpl_who->{params} }, $memrec->{nick};
  15         39  
6635 15 50       43 my $status = ($memrec->{away} ? 'G' : 'H');
6636 15 50       59 $status .= '*' if $memrec->{umode} =~ /o/;
6637             {
6638 15         26 my $stat = $record->{users}{$member};
  15         31  
6639 15 100       42 if ( $stat ) {
6640 6 100       25 if ( !$multiprefix ) {
6641 2 50       25 $stat =~ s![vh]!!g if $stat =~ /o/;
6642 2 50       13 $stat =~ s![v]!!g if $stat =~ /h/;
6643             }
6644             else {
6645 4         10 my $ostat = join '', grep { $stat =~ m!$_! } qw[o h v];
  12         165  
6646 4         12 $stat = $ostat;
6647             }
6648 6         49 $stat =~ tr/ohv/@%+/;
6649 6         74 $status .= $stat;
6650             }
6651             }
6652 15         41 push @{ $rpl_who->{params} }, $status;
  15         48  
6653 15         62 push @{ $rpl_who->{params} }, "$memrec->{hops} "
6654 15         29 . $memrec->{ircname};
6655 15         49 push @$ref, $rpl_who;
6656             }
6657             }
6658 6 50       39 if ($self->state_nick_exists($who)) {
6659 0         0 my $nickrec = $self->{state}{users}{uc_irc($who)};
6660 0         0 $who = $nickrec->{nick};
6661 0         0 my $rpl_who = {
6662             prefix => $server,
6663             command => '352',
6664             params => [$nick, '*'],
6665             };
6666 0         0 push @{ $rpl_who->{params} }, $nickrec->{auth}{ident};
  0         0  
6667 0         0 push @{ $rpl_who->{params} }, $nickrec->{auth}{hostname};
  0         0  
6668 0         0 push @{ $rpl_who->{params} }, $nickrec->{server};
  0         0  
6669 0         0 push @{ $rpl_who->{params} }, $nickrec->{nick};
  0         0  
6670 0 0       0 my $status = ($nickrec->{away} ? 'G' : 'H');
6671 0 0       0 $status .= '*' if $nickrec->{umode} =~ /o/;
6672 0         0 push @{ $rpl_who->{params} }, $status;
  0         0  
6673 0         0 push @{ $rpl_who->{params} }, "$nickrec->{hops} "
6674 0         0 . $nickrec->{ircname};
6675 0         0 push @$ref, $rpl_who;
6676             }
6677 6         50 push @$ref, {
6678             prefix => $server,
6679             command => '315',
6680             params => [$nick, $orig, 'End of WHO list'],
6681             };
6682             }
6683              
6684 6 50       70 return @$ref if wantarray;
6685 0         0 return $ref;
6686             }
6687              
6688             sub _daemon_cmd_mode {
6689 54     54   172 my $self = shift;
6690 54   50     246 my $nick = shift || return;
6691 54         139 my $chan = shift;
6692 54         189 my $server = $self->server_name();
6693 54         224 my $sid = $self->server_sid();
6694 54         236 my $maxmodes = $self->server_config('MODES');
6695 54         168 my $ref = [ ];
6696 54         255 my $args = [@_];
6697 54         187 my $count = @$args;
6698              
6699             SWITCH: {
6700 54 50       143 if (!$self->state_chan_exists($chan)) {
  54         354  
6701 0         0 push @$ref, ['403', $chan];
6702 0         0 last SWITCH;
6703             }
6704              
6705 54         308 my $record = $self->{state}{chans}{uc_irc($chan)};
6706 54         724 $chan = $record->{name};
6707              
6708 54 50 66     347 if (!$count && !$self->state_is_chan_member($nick, $chan)) {
6709             push @$ref, {
6710             prefix => $server,
6711             command => '324',
6712 0         0 params => [$nick, $chan, '+' . $record->{mode}],
6713             colonify => 0,
6714             };
6715             push @$ref, {
6716             prefix => $server,
6717             command => '329',
6718 0         0 params => [$nick, $chan, $record->{ts}],
6719             colonify => 0,
6720             };
6721 0         0 last SWITCH;
6722             }
6723 54 100       438 if (!$count) {
6724             push @$ref, {
6725             prefix => $server,
6726             command => '324',
6727             params => [
6728             $nick,
6729             $chan,
6730             '+' . $record->{mode},
6731             ($record->{ckey} || ()),
6732 13   33     232 ($record->{climit} || ()),
      33        
6733             ],
6734             colonify => 0,
6735             };
6736             push @$ref, {
6737             prefix => $server,
6738             command => '329',
6739 13         99 params => [$nick, $chan, $record->{ts}],
6740             colonify => 0,
6741             };
6742 13         50 last SWITCH;
6743             }
6744              
6745 41         122 my $unknown = 0;
6746 41         107 my $notop = 0;
6747 41         111 my $notoper = 0;
6748 41         291 my $nick_is_op = $self->state_is_chan_op($nick, $chan);
6749 41         833 my $nick_is_hop = $self->state_is_chan_hop($nick, $chan);
6750 41         336 my $nick_is_oper = $self->state_user_is_operator($nick);
6751 41   100     766 my $no_see_bans = ( $record->{mode} =~ /u/ && !( $nick_is_op || $nick_is_hop ) );
6752 41         145 my $mode_u_set = ( $record->{mode} =~ /u/ );
6753 41         179 my $reply;
6754 41         0 my @reply_args; my %subs;
6755 41         285 my $parsed_mode = parse_mode_line(@$args);
6756 41         3031 my $mode_count = 0;
6757              
6758 41         102 while (my $mode = shift @{ $parsed_mode->{modes} }) {
  101         408  
6759 60 50       321 if ($mode !~ /[CceIbkMNRSTLOlimnpstohuv]/) {
6760 0 0       0 push @$ref, [
6761             '472',
6762             (split //, $mode)[1],
6763             $chan,
6764             ] if !$unknown;
6765 0         0 $unknown++;
6766 0         0 next;
6767             }
6768              
6769 60         160 my $arg;
6770 60 100       329 if ($mode =~ /^(\+[ohvklbIe]|-[ohvbIe])/) {
6771 45         114 $arg = shift @{ $parsed_mode->{args} };
  45         140  
6772             }
6773 60 100 100     307 if ($mode =~ /[-+]b/ && !defined $arg) {
6774             push @$ref, {
6775             prefix => $server,
6776             command => '367',
6777             params => [
6778             $nick,
6779             $chan,
6780 0         0 @{ $record->{bans}{$_} },
6781             ]
6782 2         7 } for grep { !$no_see_bans } keys %{ $record->{bans} };
  2         12  
  2         20  
6783 2         14 push @$ref, {
6784             prefix => $server,
6785             command => '368',
6786             params => [$nick, $chan, 'End of Channel Ban List'],
6787             };
6788 2         6 next;
6789             }
6790 58 100 100     342 if ($mode =~ m![OL]! && !$nick_is_oper) {
6791 1 50       7 push @$ref, ['481'] if !$notoper;
6792 1         4 $notoper++;
6793 1         4 next;
6794             }
6795 57 0 33     186 if (!$nick_is_op && !$nick_is_hop && $mode !~ m![OL]!) {
      0        
6796 0 0       0 push @$ref, ['482', $chan] if !$notop;
6797 0         0 $notop++;
6798 0         0 next;
6799             }
6800 57 50 33     262 if ($mode =~ /[-+]I/ && !defined $arg) {
6801             push @$ref, {
6802             prefix => $server,
6803             command => '346',
6804             params => [
6805             $nick,
6806             $chan,
6807 0         0 @{ $record->{invex}{$_} },
6808             ],
6809 0         0 } for grep { !$no_see_bans } keys %{ $record->{invex} };
  0         0  
  0         0  
6810 0         0 push @$ref, {
6811             prefix => $server,
6812             command => '347',
6813             params => [$nick, $chan, 'End of Channel Invite List']
6814             };
6815 0         0 next;
6816             }
6817 57 50 33     304 if ($mode =~ /[-+]e/ && !defined $arg) {
6818             push @$ref, {
6819             prefix => $server,
6820             command => '348',
6821 0         0 params => [$nick, $chan, @{ $record->{excepts}{$_} } ]
6822 0         0 } for grep { !$no_see_bans } keys %{ $record->{excepts} };
  0         0  
  0         0  
6823 0         0 push @$ref, {
6824             prefix => $server,
6825             command => '349',
6826             params => [
6827             $nick,
6828             $chan,
6829             'End of Channel Exception List',
6830             ],
6831             };
6832 0         0 next;
6833             }
6834 57 0 33     228 if (!$nick_is_op && $nick_is_hop && $mode =~ /[op]/) {
      33        
6835 0 0       0 push @$ref, ['482', $chan] if !$notop;
6836 0         0 $notop++;
6837 0         0 next;
6838             }
6839 57 0 33     272 if (!$nick_is_op && $nick_is_hop && $record->{mode} =~ /p/
      33        
      0        
6840             && $mode =~ /h/) {
6841 0 0       0 push @$ref, ['482', $chan] if !$notop;
6842 0         0 $notop++;
6843 0         0 next;
6844             }
6845 57 50 66     591 if (($mode =~ /^[-+][ohv]/ || $mode =~ /^\+[lk]/)
      66        
6846             && !defined $arg) {
6847 0         0 next;
6848             }
6849 57 50 66     395 if ($mode =~ /^[-+][ohv]/ && !$self->state_nick_exists($arg)) {
6850 0 0       0 next if ++$mode_count > $maxmodes;
6851 0         0 push @$ref, ['401', $arg];
6852 0         0 next;
6853             }
6854 57 50 66     368 if ($mode =~ /^[-+][ohv]/
6855             && !$self->state_is_chan_member($arg, $chan)) {
6856 0 0       0 next if ++$mode_count > $maxmodes;
6857 0         0 push @$ref, ['441', $chan, $self->state_user_nick($arg)];
6858 0         0 next;
6859             }
6860 57 100       966 if (my ($flag, $char) = $mode =~ /^([-+])([ohv])/ ) {
6861 42 50       193 next if ++$mode_count > $maxmodes;
6862              
6863 42 100 66     303 if ($flag eq '+'
6864             && $record->{users}{$self->state_user_uid($arg)} !~ /$char/) {
6865             # Update user and chan record
6866 30         1008 $arg = $self->state_user_uid($arg);
6867             $record->{users}{$arg} = join('', sort
6868 30         660 split //, $record->{users}{$arg} . $char);
6869             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
6870 30         222 = $record->{users}{$arg};
6871 30         378 $reply .= $mode;
6872 30         130 my $anick = $self->state_user_nick($arg);
6873 30         112 $subs{$anick} = $arg;
6874 30         84 push @reply_args, $anick;
6875             }
6876              
6877 42 50 33     537 if ($flag eq '-' && $record->{users}{uc_irc($arg)}
6878             =~ /$char/) {
6879             # Update user and chan record
6880 0         0 $arg = $self->state_user_uid($arg);
6881 0         0 $record->{users}{$arg} =~ s/$char//g;
6882             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
6883 0         0 = $record->{users}{$arg};
6884 0         0 $reply .= $mode;
6885 0         0 my $anick = $self->state_user_nick($arg);
6886 0         0 $subs{$anick} = $arg;
6887 0         0 push @reply_args, $anick;
6888             }
6889 42         143 next;
6890             }
6891 15 0 33     83 if ($mode eq '+l' && $arg =~ /^\d+$/ && $arg > 0) {
      33        
6892 0 0       0 next if ++$mode_count > $maxmodes;
6893 0         0 $reply .= $mode;
6894 0         0 push @reply_args, $arg;
6895 0 0       0 if ($record->{mode} !~ /l/) {
6896             $record->{mode} = join('', sort
6897 0         0 split //, $record->{mode} . 'l');
6898             }
6899 0         0 $record->{climit} = $arg;
6900 0         0 next;
6901             }
6902 15 50 33     62 if ($mode eq '-l' && $record->{mode} =~ /l/) {
6903 0         0 $record->{mode} =~ s/l//g;
6904 0         0 delete $record->{climit};
6905 0         0 $reply .= $mode;
6906 0         0 next;
6907             }
6908 15 50 33     126 if ($mode eq '+k' && $arg) {
6909 0 0       0 next if ++$mode_count > $maxmodes;
6910 0         0 $reply .= $mode;
6911 0         0 push @reply_args, $arg;
6912 0 0       0 if ($record->{mode} !~ /k/) {
6913             $record->{mode} = join('', sort
6914 0         0 split //, $record->{mode} . 'k');
6915             }
6916 0         0 $record->{ckey} = $arg;
6917 0         0 next;
6918             }
6919 15 50 33     55 if ($mode eq '-k' && $record->{mode} =~ /k/) {
6920 0         0 $reply .= $mode;
6921 0         0 push @reply_args, '*';
6922 0         0 $record->{mode} =~ s/k//g;
6923 0         0 delete $record->{ckey};
6924 0         0 next;
6925             }
6926             # Bans
6927 15 50       88 my $maxbans = ( $record->{mode} =~ m!L! ? $self->{config}{max_bans_large} : $self->{config}{MAXBANS} );
6928 15 100       64 if (my ($flag) = $mode =~ /([-+])b/) {
6929 1 50       5 next if ++$mode_count > $maxmodes;
6930 1         6 my $mask = normalize_mask($arg);
6931 1         42 my $umask = uc_irc $mask;
6932 1 50 33     31 if ($flag eq '+' && !$record->{bans}{$umask}) {
6933 1 50       3 if ( keys %{ $record->{bans} } >= $maxbans ) {
  1         7  
6934 0         0 push @$ref, [ '478', $record->{name}, 'b' ];
6935 0         0 next;
6936             }
6937 1         6 $record->{bans}{$umask}
6938             = [$mask, $self->state_user_full($nick), time];
6939 1         3 $reply .= $mode;
6940 1         3 push @reply_args, $mask;
6941             }
6942 1 0 33     6 if ($flag eq '-' && $record->{bans}{$umask}) {
6943 0         0 delete $record->{bans}{$umask};
6944 0         0 $reply .= $mode;
6945 0         0 push @reply_args, $mask;
6946             }
6947 1         4 next;
6948             }
6949             # Invex
6950 14 50       56 if (my ($flag) = $mode =~ /([-+])I/) {
6951 0 0       0 next if ++$mode_count > $maxmodes;
6952 0         0 my $mask = normalize_mask( $arg );
6953 0         0 my $umask = uc_irc $mask;
6954              
6955 0 0 0     0 if ($flag eq '+' && !$record->{invex}{$umask}) {
6956 0 0       0 if ( keys %{ $record->{invex} } >= $maxbans ) {
  0         0  
6957 0         0 push @$ref, [ '478', $record->{name}, 'I' ];
6958 0         0 next;
6959             }
6960 0         0 $record->{invex}{$umask}
6961             = [$mask, $self->state_user_full($nick), time];
6962 0         0 $reply .= $mode;
6963 0         0 push @reply_args, $mask;
6964             }
6965 0 0 0     0 if ($flag eq '-' && $record->{invex}{$umask}) {
6966 0         0 delete $record->{invex}{$umask};
6967 0         0 $reply .= $mode;
6968 0         0 push @reply_args, $mask;
6969             }
6970 0         0 next;
6971             }
6972             # Exceptions
6973 14 50       53 if (my ($flag) = $mode =~ /([-+])e/) {
6974 0 0       0 next if ++$mode_count > $maxmodes;
6975 0         0 my $mask = normalize_mask($arg);
6976 0         0 my $umask = uc_irc($mask);
6977              
6978 0 0 0     0 if ($flag eq '+' && !$record->{excepts}{$umask}) {
6979 0 0       0 if ( keys %{ $record->{excepts} } >= $maxbans ) {
  0         0  
6980 0         0 push @$ref, [ '478', $record->{name}, 'e' ];
6981 0         0 next;
6982             }
6983 0         0 $record->{excepts}{$umask}
6984             = [$mask, $self->state_user_full($nick), time];
6985 0         0 $reply .= $mode;
6986 0         0 push @reply_args, $mask;
6987             }
6988 0 0 0     0 if ($flag eq '-' && $record->{excepts}{$umask}) {
6989 0         0 delete $record->{excepts}{$umask};
6990 0         0 $reply .= $mode;
6991 0         0 push @reply_args, $mask;
6992             }
6993 0         0 next;
6994             }
6995             # The rest should be argumentless.
6996 14         63 my ($flag, $char) = split //, $mode;
6997 14 100 66     249 if ($flag eq '+' && $record->{mode} !~ /$char/) {
6998 11         40 $reply .= $mode;
6999             $record->{mode} = join('', sort
7000 11         103 split //, $record->{mode} . $char);
7001 11         39 next;
7002             }
7003 3 50 33     75 if ($flag eq '-' && $record->{mode} =~ /$char/) {
7004 3         10 $reply .= $mode;
7005 3         28 $record->{mode} =~ s/$char//g;
7006 3         12 next;
7007             }
7008             } # while
7009              
7010 41 100       211 if ($reply) {
7011 32         194 $reply = unparse_mode_line($reply);
7012             my @reply_args_peer = map {
7013 32 100       1196 ( defined $subs{$_} ? $subs{$_} : $_ )
  31         202  
7014             } @reply_args;
7015             $self->send_output(
7016             {
7017             prefix => $self->state_user_uid($nick),
7018             command => 'TMODE',
7019 32         184 params => [$record->{ts}, $chan, $reply, @reply_args_peer],
7020             colonify => 0,
7021             },
7022             $self->_state_connected_peers(),
7023             );
7024 32         250 my $full = $self->state_user_full($nick);
7025             $self->_send_output_channel_local(
7026             $record->{name},
7027             {
7028             prefix => $full,
7029             command => 'MODE',
7030             colonify => 0,
7031             params => [
7032             $record->{name},
7033 32 100       478 $reply,
7034             @reply_args,
7035             ],
7036             },
7037             '', ( $mode_u_set ? 'oh' : '' ),
7038             );
7039 32 100       268 if ($mode_u_set) {
7040 2         9 my $bparse = parse_mode_line( $reply, @reply_args );
7041 2         96 my $breply; my @breply_args;
7042 2         3 while (my $bmode = shift (@{ $bparse->{modes} })) {
  4         16  
7043 2         5 my $arg;
7044 2 100       10 $arg = shift @{ $bparse->{args} }
  1         3  
7045             if $bmode =~ /^(\+[ohvklbIe]|-[ohvbIe])/;
7046 2 100       7 next if $bmode =~ m!^[+-][beI]$!;
7047 1         3 $breply .= $bmode;
7048 1 50       6 push @breply_args, $arg if $arg;
7049             }
7050 2 100       22 if ($breply) {
7051 1         5 my $parsed_line = unparse_mode_line($breply);
7052             $self->_send_output_channel_local(
7053             $record->{name},
7054             {
7055             prefix => $full,
7056             command => 'MODE',
7057             colonify => 0,
7058             params => [
7059             $record->{name},
7060 1         29 $parsed_line,
7061             @breply_args,
7062             ],
7063             },
7064             '','-oh',
7065             );
7066             }
7067             }
7068             }
7069             } # SWITCH
7070              
7071 54 50       514 return @$ref if wantarray;
7072 0         0 return $ref;
7073             }
7074              
7075             sub _daemon_cmd_join {
7076 117     117   311 my $self = shift;
7077 117   50     427 my $nick = shift || return;
7078 117         379 my $server = $self->server_name();
7079 117         418 my $sid = $self->server_sid();
7080 117         296 my $ref = [ ];
7081 117         354 my $args = [@_];
7082 117         293 my $count = @$args;
7083 117         547 my $route_id = $self->_state_user_route($nick);
7084 117         586 my $uid = $self->state_user_uid($nick);
7085 117         1675 my $unick = uc_irc($nick);
7086              
7087             SWITCH: {
7088 117         1307 my (@channels, @chankeys);
  117         269  
7089 117 50       403 if (!$count) {
7090 0         0 push @$ref, ['461', 'JOIN'];
7091 0         0 last SWITCH;
7092             }
7093              
7094 117         617 @channels = split /,/, $args->[0];
7095 117 50       515 @chankeys = split /,/, $args->[1] if $args->[1];
7096 117         548 my $channel_length = $self->server_config('CHANNELLEN');
7097 117         592 my $nick_is_oper = $self->state_user_is_operator($nick);
7098              
7099 117         1860 LOOP: for my $channel (@channels) {
7100 117         388 my $uchannel = uc_irc($channel);
7101 117 50 33     1695 if ($channel eq '0'
7102             and my @chans = $self->state_user_chans($nick)) {
7103             $self->_send_output_to_client(
7104             $route_id,
7105             (ref $_ eq 'ARRAY' ? @$_ : $_),
7106 0 0       0 ) for map { $self->_daemon_cmd_part($nick, $_) } @chans;
  0         0  
7107 0         0 next LOOP;
7108             }
7109             # Channel isn't valid
7110 117 50 33     571 if (!is_valid_chan_name($channel)
7111             || length $channel > $channel_length) {
7112 0         0 $self->_send_output_to_client(
7113             $route_id,
7114             '403',
7115             $channel,
7116             );
7117 0         0 next LOOP;
7118             }
7119             # Too many channels
7120 117 50 33     6762 if ($self->state_user_chans($nick)
7121             >= $self->server_config('MAXCHANNELS')
7122             && !$nick_is_oper) {
7123 0         0 $self->_send_output_to_client(
7124             $route_id,
7125             '405',
7126             $channel,
7127             );
7128 0         0 next LOOP;
7129             }
7130             # Channel is RESV
7131 117 100       618 if (my $reason = $self->_state_is_resv($channel,$route_id)) {
7132 1 50       7 if ( !$nick_is_oper ) {
7133 1         3 $self->_send_to_realops(
7134             sprintf(
7135             'Forbidding reserved channel %s from user %s',
7136             $channel,
7137             $self->state_user_full($nick),
7138             ),
7139             'Notice',
7140             'j',
7141             );
7142 1         10 $self->_send_output_to_client(
7143             $route_id,
7144             '485',
7145             $channel,
7146             $reason,
7147             );
7148 1         6 next LOOP;
7149             }
7150             }
7151             # Channel doesn't exist
7152 116 100       586 if (!$self->state_chan_exists($channel)) {
7153 56         1316 my $record = {
7154             name => $channel,
7155             ts => time,
7156             mode => 'nt',
7157             users => { $uid => 'o' },
7158             };
7159 56         242 $self->{state}{chans}{$uchannel} = $record;
7160 56         225 $self->{state}{users}{$unick}{chans}{$uchannel} = 'o';
7161 56         275 my @peers = $self->_state_connected_peers();
7162             $self->send_output(
7163             {
7164             prefix => $sid,
7165             command => 'SJOIN',
7166             params => [
7167             $record->{ts},
7168             $channel,
7169             '+' . $record->{mode},
7170 56 50       993 '@' . $uid,
7171             ],
7172             },
7173             @peers,
7174             ) if $channel !~ /^&/;
7175 56         394 my $output = {
7176             prefix => $self->state_user_full($nick),
7177             command => 'JOIN',
7178             params => [$channel],
7179             };
7180 56         357 $self->send_output($output, $route_id);
7181             $self->send_event(
7182             "daemon_join",
7183             $output->{prefix},
7184 56         372 $channel,
7185             );
7186             $self->send_output(
7187             {
7188             prefix => $server,
7189             command => 'MODE',
7190 56         6380 params => [$channel, '+' . $record->{mode}],
7191             },
7192             $route_id,
7193             );
7194             $self->_send_output_to_client(
7195             $route_id,
7196             (ref $_ eq 'ARRAY' ? @$_ : $_),
7197 56 50       479 ) for $self->_daemon_cmd_names($nick, $channel);
7198 56         434 next LOOP;
7199             }
7200             # Numpty user is already on channel
7201 60 50       328 if ($self->state_is_chan_member($nick, $channel)) {
7202 0         0 next LOOP;
7203             }
7204 60         276 my $chanrec = $self->{state}{chans}{$uchannel};
7205 60         150 my $bypass;
7206 60 50 66     235 if ($nick_is_oper && $self->{config}{OPHACKS}) {
7207 0         0 $bypass = 1;
7208             }
7209             # OPER only channel +O
7210 60 50 33     576 if ($chanrec->{mode} =~ /O/ && !$nick_is_oper) {
7211 0         0 push @$ref, ['520',$chanrec->{name}];
7212 0         0 next LOOP;
7213             }
7214 60         293 my $umode = $self->state_user_umode($nick);
7215             # SSL only channel +S
7216 60 100 100     927 if ($chanrec->{mode} =~ /S/ && $umode !~ /S/) {
7217 1         4 push @$ref, ['489',$chanrec->{name}];
7218 1         5 next LOOP;
7219             }
7220             # Registered users only +R
7221 59 100 66     379 if($chanrec->{mode} =~ /R/ && $umode !~ /r/) {
7222 2         11 push @$ref, ['477',$chanrec->{name}];
7223 2         8 next LOOP;
7224             }
7225             # Channel is full
7226 57 50 33     545 if (!$bypass && $chanrec->{mode} =~ /l/
      33        
7227 0         0 && keys %{$chanrec->{users}} >= $chanrec->{climit}) {
7228 0         0 $self->_send_output_to_client($route_id, '471', $channel);
7229 0         0 next LOOP;
7230             }
7231 57         150 my $chankey;
7232 57 50       253 $chankey = shift @chankeys if $chanrec->{mode} =~ /k/;
7233             # Channel +k and no key or invalid key provided
7234 57 0 33     534 if (!$bypass && $chanrec->{mode} =~ /k/
      0        
      33        
7235             && (!$chankey || $chankey ne $chanrec->{ckey})) {
7236 0         0 $self->_send_output_to_client($route_id, '475', $channel);
7237 0         0 next LOOP;
7238             }
7239             # Channel +i and not INVEX
7240 57 100 66     508 if (!$bypass && $chanrec->{mode} =~ /i/
      100        
7241             && !$self->_state_user_invited($nick, $channel)) {
7242 3         23 $self->_send_output_to_client($route_id, '473', $channel);
7243 3         13 next LOOP;
7244             }
7245             # Channel +b and no exception
7246 54 50 33     484 if (!$bypass && $self->_state_user_banned($nick, $channel)) {
7247 0         0 $self->_send_output_to_client($route_id, '474', $channel);
7248 0         0 next LOOP;
7249             }
7250             # Spambot checks
7251 54 100       406 $self->state_check_spambot_warning($nick,$channel) if !$nick_is_oper;
7252 54 100       394 $self->state_check_joinflood_warning($nick,$channel) if !$nick_is_oper;
7253             # JOIN the channel
7254 54         186 delete $self->{state}{users}{$unick}{invites}{$uchannel};
7255 54         191 delete $self->{state}{chans}{$uchannel}{invites}{$uid};
7256             # Add user
7257 54         214 $self->{state}{uids}{$uid}{chans}{$uchannel} = '';
7258 54         177 $self->{state}{chans}{$uchannel}{users}{$uid} = '';
7259             # Send JOIN message to peers and local users.
7260             $self->send_output(
7261             {
7262             prefix => $uid,
7263             command => 'JOIN',
7264 54 50       634 params => [$chanrec->{ts}, $channel, '+'],
7265             },
7266             $self->_state_connected_peers(),
7267             ) if $channel !~ /^&/;
7268              
7269 54         333 my $output = {
7270             prefix => $self->state_user_full($nick),
7271             command => 'JOIN',
7272             params => [$channel],
7273             };
7274             my $extout = {
7275             prefix => $self->state_user_full($nick),
7276             command => 'JOIN',
7277             params => [
7278             $channel,
7279             $self->{state}{uids}{$uid}{account},
7280             $self->{state}{uids}{$uid}{ircname},
7281 54         229 ],
7282             };
7283 54         371 $self->_send_output_to_client($route_id, $output);
7284 54         339 $self->_send_output_channel_local($channel, $output, $route_id, '', '', 'extended-join');
7285 54         261 $self->_send_output_channel_local($channel, $extout, $route_id, '', 'extended-join');
7286              
7287             # Send NAMES and TOPIC to client
7288             $self->_send_output_to_client(
7289             $route_id,
7290             (ref $_ eq 'ARRAY' ? @$_ : $_),
7291 54 50       355 ) for $self->_daemon_cmd_names($nick, $channel);
7292             $self->_send_output_to_client(
7293             $route_id,
7294             (ref $_ eq 'ARRAY' ? @$_ : $_),
7295 54 50       455 ) for $self->_daemon_cmd_topic($nick, $channel);
7296              
7297 54 100       482 if ( $self->{state}{uids}{$uid}{away} ) {
7298 1         11 $self->_state_do_away_notify($uid,$channel,$self->{state}{uids}{$uid}{away});
7299             }
7300             }
7301             }
7302              
7303 117 100       765 return @$ref if wantarray;
7304 1         4 return $ref;
7305             }
7306              
7307             sub _daemon_cmd_part {
7308 8     8   32 my $self = shift;
7309 8   50     43 my $nick = shift || return;
7310 8         23 my $chan = shift;
7311 8         32 my $server = $self->server_name();
7312 8         42 my $ref = [ ];
7313 8         29 my $args = [@_];
7314 8         21 my $count = @$args;
7315              
7316             SWITCH: {
7317 8 50       34 if (!$chan) {
  8         35  
7318 0         0 push @$ref, ['461', 'PART'];
7319 0         0 last SWITCH;
7320             }
7321 8 50       43 if (!$self->state_chan_exists($chan)) {
7322 0         0 push @$ref, ['403', $chan];
7323 0         0 last SWITCH;
7324             }
7325 8 50       49 if (!$self->state_is_chan_member($nick, $chan)) {
7326 0         0 push @$ref, ['442', $chan];
7327 0         0 last SWITCH;
7328             }
7329              
7330 8         144 $chan = $self->_state_chan_name($chan);
7331 8         131 my $uid = $self->state_user_uid($nick);
7332 8         114 my $urec = $self->{state}{uids}{$uid};
7333              
7334 8         21 my $pmsg = $args->[0];
7335 8         30 my $params = [ $chan ];
7336              
7337 8 50 66     70 if ( $pmsg and my $msgtime = $self->{config}{anti_spam_exit_message_time} ) {
7338 0 0       0 $pmsg = '' if time - $urec->{conn_time} < $msgtime;
7339             }
7340              
7341 8 50 66     65 if ( $pmsg && !$self->state_can_send_to_channel($nick,$chan,$pmsg,'PART') ) {
7342 0         0 $pmsg = '';
7343             }
7344              
7345 8 100       72 push @$params, $pmsg if $pmsg;
7346              
7347 8 100       82 $self->state_check_spambot_warning($nick) if $urec->{umode} !~ /o/;
7348              
7349 8         70 $self->send_output(
7350             {
7351             prefix => $uid,
7352             command => 'PART',
7353             params => $params,
7354             },
7355             $self->_state_connected_peers(),
7356             );
7357 8         62 $self->_send_output_channel_local(
7358             $chan,
7359             {
7360             prefix => $self->state_user_full($nick),
7361             command => 'PART',
7362             params => $params,
7363             },
7364             );
7365              
7366 8         65 $chan = uc_irc($chan);
7367 8         125 delete $self->{state}{chans}{$chan}{users}{$uid};
7368 8         29 delete $self->{state}{uids}{$uid}{chans}{$chan};
7369 8 100       21 if (! keys %{ $self->{state}{chans}{$chan}{users} }) {
  8         53  
7370 5         64 delete $self->{state}{chans}{$chan};
7371             }
7372             }
7373              
7374 8 50       59 return @$ref if wantarray;
7375 0         0 return $ref;
7376             }
7377              
7378             sub _daemon_cmd_kick {
7379 7     7   23 my $self = shift;
7380 7   50     25 my $nick = shift || return;
7381 7         25 my $server = $self->server_name();
7382 7         21 my $ref = [ ];
7383 7         23 my $args = [@_];
7384 7         20 my $count = @$args;
7385              
7386             SWITCH: {
7387 7 50 33     18 if (!$count || $count < 2) {
  7         46  
7388 0         0 push @$ref, ['461', 'KICK'];
7389 0         0 last SWITCH;
7390             }
7391 7         31 my $chan = (split /,/, $args->[0])[0];
7392 7         27 my $who = (split /,/, $args->[1])[0];
7393 7 50       26 if (!$self->state_chan_exists($chan)) {
7394 0         0 push @$ref, ['403', $chan];
7395 0         0 last SWITCH;
7396             }
7397 7         26 $chan = $self->_state_chan_name($chan);
7398 7 50 66     110 if (!$self->state_is_chan_op($nick, $chan) && !$self->state_is_chan_hop($nick, $chan)) {
7399 0         0 push @$ref, ['482', $chan];
7400 0         0 last SWITCH;
7401             }
7402 7 50       132 if (!$self->state_nick_exists($who) ) {
7403 0         0 push @$ref, ['401', $who];
7404 0         0 last SWITCH;
7405             }
7406 7         25 $who = $self->state_user_nick($who);
7407 7 100       100 if (!$self->state_is_chan_member($who, $chan)) {
7408 3         14 push @$ref, ['441', $who, $chan];
7409 3         12 last SWITCH;
7410             }
7411 4 50 66     67 if (
      66        
7412             $self->state_is_chan_hop($nick, $chan) &&
7413             !$self->state_is_chan_op($nick, $chan) &&
7414             $self->state_is_chan_op($who, $chan)
7415             ) {
7416 3         86 push @$ref, ['482', $chan];
7417 3         12 last SWITCH;
7418             }
7419 1   33     33 my $comment = $args->[2] || $who;
7420 1         9 my $uid = $self->state_user_uid($nick);
7421 1         24 my $wuid = $self->state_user_uid($who);
7422 1         41 $self->send_output(
7423             {
7424             prefix => $uid,
7425             command => 'KICK',
7426             params => [$chan, $wuid, $comment],
7427             },
7428             $self->_state_connected_peers(),
7429             );
7430 1         13 $self->_send_output_channel_local(
7431             $chan,
7432             {
7433             prefix => $self->state_user_full($nick),
7434             command => 'KICK',
7435             params => [$chan, $who, $comment],
7436             },
7437             );
7438 1         6 $chan = uc_irc($chan);
7439 1         16 delete $self->{state}{chans}{$chan}{users}{$wuid};
7440 1         5 delete $self->{state}{uids}{$wuid}{chans}{$chan};
7441 1 50       2 if (!keys %{ $self->{state}{chans}{$chan}{users} }) {
  1         8  
7442 0         0 delete $self->{state}{chans}{$chan};
7443             }
7444             }
7445              
7446 7 50       74 return @$ref if wantarray;
7447 0         0 return $ref;
7448             }
7449              
7450             sub _daemon_cmd_remove {
7451 3     3   8 my $self = shift;
7452 3   50     10 my $nick = shift || return;
7453 3         7 my $server = $self->server_name();
7454 3         8 my $ref = [ ];
7455 3         9 my $args = [@_];
7456 3         5 my $count = @$args;
7457              
7458             SWITCH: {
7459 3 50 33     7 if (!$count || $count < 2) {
  3         18  
7460 0         0 push @$ref, ['461', 'REMOVE'];
7461 0         0 last SWITCH;
7462             }
7463 3         13 my $chan = (split /,/, $args->[0])[0];
7464 3         9 my $who = (split /,/, $args->[1])[0];
7465 3 50       12 if (!$self->state_chan_exists($chan)) {
7466 0         0 push @$ref, ['403', $chan];
7467 0         0 last SWITCH;
7468             }
7469 3         26 $chan = $self->_state_chan_name($chan);
7470 3 50 66     42 if (!$self->state_is_chan_op($nick, $chan) && !$self->state_is_chan_hop($nick, $chan)) {
7471 0         0 push @$ref, ['482', $chan];
7472 0         0 last SWITCH;
7473             }
7474 3 50       48 if (!$self->state_nick_exists($who) ) {
7475 0         0 push @$ref, ['401', $who];
7476 0         0 last SWITCH;
7477             }
7478 3         12 $who = $self->state_user_nick($who);
7479 3 100       40 if (!$self->state_is_chan_member($who, $chan)) {
7480 1         4 push @$ref, ['441', $who, $chan];
7481 1         3 last SWITCH;
7482             }
7483 2 50 66     29 if (
      66        
7484             $self->state_is_chan_hop($nick, $chan) &&
7485             !$self->state_is_chan_op($nick, $chan) &&
7486             $self->state_is_chan_op($who, $chan)
7487             ) {
7488 1         17 push @$ref, ['482', $chan];
7489 1         4 last SWITCH;
7490             }
7491 1         4 my $comment = "Requested by $nick";
7492 1 50       9 $comment .= qq{ "$args->[2]"} if $args->[2];
7493 1         5 my $uid = $self->state_user_uid($who);
7494 1         20 $self->send_output(
7495             {
7496             prefix => $uid,
7497             command => 'PART',
7498             params => [$chan, $comment],
7499             },
7500             $self->_state_connected_peers(),
7501             );
7502 1         7 $self->_send_output_channel_local(
7503             $chan,
7504             {
7505             prefix => $self->state_user_full($who),
7506             command => 'PART',
7507             params => [$chan, $comment],
7508             },
7509             );
7510 1         5 $chan = uc_irc($chan);
7511 1         15 delete $self->{state}{chans}{$chan}{users}{$uid};
7512 1         4 delete $self->{state}{uids}{$uid}{chans}{$chan};
7513 1 50       3 if (! keys %{ $self->{state}{chans}{$chan}{users} }) {
  1         7  
7514 0         0 delete $self->{state}{chans}{$chan};
7515             }
7516             }
7517              
7518 3 50       19 return @$ref if wantarray;
7519 0         0 return $ref;
7520             }
7521              
7522             sub _daemon_cmd_invite {
7523 0     0   0 my $self = shift;
7524 0   0     0 my $nick = shift || return;
7525 0         0 my $server = $self->server_name();
7526 0         0 my $sid = $self->server_sid();
7527 0         0 my $ref = [ ];
7528 0         0 my $args = [@_];
7529 0         0 my $count = @$args;
7530              
7531             SWITCH: {
7532 0 0 0     0 if (!$count || $count < 2) {
  0         0  
7533 0         0 push @$ref, ['461', 'INVITE'];
7534 0         0 last SWITCH;
7535             }
7536 0         0 my ($who, $chan) = @$args;
7537 0 0       0 if (!$self->state_nick_exists($who)) {
7538 0         0 push @$ref, ['401', $who];
7539 0         0 last SWITCH;
7540             }
7541 0         0 $who = $self->state_user_nick($who);
7542 0 0       0 if (!$self->state_chan_exists($chan)) {
7543 0         0 push @$ref, ['403', $chan];
7544 0         0 last SWITCH;
7545             }
7546 0         0 $chan = $self->_state_chan_name($chan);
7547 0 0       0 if (!$self->state_is_chan_member($nick, $chan)) {
7548 0         0 push @$ref, ['442', $chan];
7549 0         0 last SWITCH;
7550             }
7551 0 0       0 if ($self->state_is_chan_member($who, $chan)) {
7552 0         0 push @$ref, ['443', $who, $chan];
7553 0         0 last SWITCH;
7554             }
7555 0 0 0     0 if ($self->state_chan_mode_set($chan, 'i')
      0        
7556             && ( !$self->state_is_chan_op($nick, $chan)
7557             || !$self->state_is_chan_hop($nick, $chan) ) ) {
7558 0         0 push @$ref, ['482', $chan];
7559 0         0 last SWITCH;
7560             }
7561 0         0 my $local; my $invite_only;
7562 0         0 my $wuid = $self->state_user_uid($who);
7563 0         0 my $settime = time;
7564             # Only store the INVITE if the channel is invite-only
7565 0 0       0 if ($self->state_chan_mode_set($chan, 'i')) {
7566 0         0 $self->{state}{chans}{uc_irc $chan}{invites}{$wuid} = $settime;
7567 0 0       0 if ($self->_state_is_local_uid($wuid)) {
7568 0         0 my $record = $self->{state}{uids}{$wuid};
7569 0         0 $record->{invites}{uc_irc($chan)} = $settime;
7570 0         0 $local = 1;
7571             }
7572 0         0 $invite_only = 1;
7573             }
7574 0         0 my $invite;
7575             {
7576 0         0 my $route_id = $self->_state_uid_route($wuid);
  0         0  
7577 0         0 $invite = {
7578             prefix => $self->state_user_full($nick),
7579             command => 'INVITE',
7580             params => [$who, $chan],
7581             colonify => 0,
7582             };
7583 0 0       0 if ($route_id eq 'spoofed') {
    0          
7584             $self->send_event(
7585             "daemon_invite",
7586             $invite->{prefix},
7587 0         0 @{ $invite->{params} }
  0         0  
7588             );
7589             }
7590             elsif ( $local ) {
7591 0         0 $self->send_output($invite, $route_id);
7592             }
7593             }
7594             # Send INVITE to all connected peers
7595             $self->send_output(
7596             {
7597 0         0 prefix => $self->state_user_uid($nick),
7598             command => 'INVITE',
7599             params => [ $wuid, $chan, $self->_state_chan_timestamp($chan) ],
7600             colonify => 0,
7601             },
7602             $self->_state_connected_peers(),
7603             );
7604 0         0 push @$ref, {
7605             prefix => $server,
7606             command => '341',
7607             params => [$chan, $who],
7608             };
7609             # Send NOTICE to local channel +oh users or invite-notify if applicable
7610 0 0       0 if ( $invite_only ) {
7611 0         0 my $notice = {
7612             prefix => $server,
7613             command => 'NOTICE',
7614             params => [
7615             $chan,
7616             sprintf(
7617             "%s is inviting %s to %s.",
7618             $nick,
7619             $who,
7620             $chan,
7621             ),
7622             ],
7623             };
7624 0         0 $self->_send_output_channel_local($chan,$notice,'','oh','','invite-notify'); # Traditional NOTICE
7625 0         0 $self->_send_output_channel_local($chan,$invite,'','oh','invite-notify',''); # invite-notify extension
7626             }
7627 0         0 my $away = $self->{state}{uids}{$wuid}{away};
7628 0 0       0 if (defined $away) {
7629 0         0 push @$ref, {
7630             prefix => $server,
7631             command => '301',
7632             params => [$nick, $who, $away],
7633             };
7634             }
7635             }
7636              
7637 0 0       0 return @$ref if wantarray;
7638 0         0 return $ref;
7639             }
7640              
7641             sub _daemon_cmd_umode {
7642 231     231   755 my $self = shift;
7643 231   50     959 my $nick = shift || return;
7644 231         813 my $args = [ @_ ];
7645 231         708 my $count = @$args;
7646 231         907 my $server = $self->server_name();
7647 231         789 my $ref = [ ];
7648 231         1176 my $record = $self->{state}{users}{uc_irc($nick)};
7649              
7650 231 100       3739 if (!$count) {
7651             push @$ref, {
7652             prefix => $server,
7653             command => '221',
7654 2         23 params => [$nick, '+' . $record->{umode}],
7655             };
7656             }
7657             else {
7658 229         979 my $modestring = join('', @$args);
7659 229         1083 $modestring =~ s/\s+//g;
7660 229         924 my $cnt += $modestring =~ s/[^a-zA-Z+-]+//g;
7661 229         921 $cnt += $modestring =~ s/[^DFGHRSWXabcdefgijklnopqrsuwy+-]+//g;
7662              
7663             # These can only be set by servers/services
7664 229         722 $modestring =~ s/[SWr]+//g;
7665              
7666             # These can only be set by an OPER
7667 229 50       1448 $cnt += $modestring =~ s/[FHXabcdefjklnsuy]+//g if $record->{umode} !~ /o/;
7668              
7669 229 100       939 push @$ref, ['501'] if $cnt;
7670              
7671 229         1450 my $umode = unparse_mode_line($modestring);
7672 229         7864 my $peer_ignore;
7673 229         1212 my $parsed_mode = parse_mode_line($umode);
7674 229         21001 my $route_id = $self->_state_user_route($nick);
7675 229         758 my $previous = $record->{umode};
7676              
7677 229         584 while (my $mode = shift @{ $parsed_mode->{modes} }) {
  457         2049  
7678 228 50       1012 next if $mode eq '+o';
7679 228         1171 my ($action, $char) = split //, $mode;
7680 228 50 33     3822 if ($action eq '+' && $record->{umode} !~ /$char/) {
7681 228         937 $record->{umode} .= $char;
7682 228 100       1029 if ($char eq 'i') {
7683 227         807 $self->{state}{stats}{invisible}++;
7684 227         823 $peer_ignore = delete $record->{_ignore_i_umode};
7685             }
7686 228 50       1010 if ($char eq 'w') {
7687 0         0 $self->{state}{wallops}{$route_id} = time;
7688             }
7689 228 50       1101 if ($char eq 'l') {
7690 0         0 $self->{state}{locops}{$route_id} = time;
7691             }
7692             }
7693 228 50 33     1535 if ($action eq '-' && $record->{umode} =~ /$char/) {
7694 0         0 $record->{umode} =~ s/$char//g;
7695 0 0       0 $self->{state}{stats}{invisible}-- if $char eq 'i';
7696              
7697 0 0       0 if ($char eq 'o') {
7698 0         0 $self->{state}{stats}{ops_online}--;
7699 0         0 delete $self->{state}{localops}{$route_id};
7700 0         0 $self->antiflood( $route_id, 1);
7701 0         0 delete $record->{svstags}{313};
7702             }
7703 0 0       0 if ($char eq 'w') {
7704 0         0 delete $self->{state}{wallops}{$route_id};
7705             }
7706 0 0       0 if ($char eq 'l') {
7707 0         0 delete $self->{state}{locops}{$route_id};
7708             }
7709             }
7710             }
7711              
7712 229         2004 $record->{umode} = join '', sort split //, $record->{umode};
7713 229         1609 my $set = gen_mode_change($previous, $record->{umode});
7714 229 100       17753 if ($set) {
7715 228         1403 my $full = $self->state_user_full($nick);
7716             $self->send_output(
7717             {
7718             prefix => $record->{uid},
7719             command => 'MODE',
7720 228 100       1117 params => [$record->{uid}, $set],
7721             },
7722             $self->_state_connected_peers(),
7723             ) if !$peer_ignore;
7724 228         1866 my $hashref = {
7725             prefix => $full,
7726             command => 'MODE',
7727             params => [$nick, $set],
7728             };
7729 228 100       1089 $self->send_event(
7730             "daemon_umode",
7731             $full,
7732             $set,
7733             ) if !$peer_ignore;
7734 228         1263 push @$ref, $hashref;
7735             }
7736             }
7737              
7738 231 50       2666 return @$ref if wantarray;
7739 0         0 return $ref;
7740             }
7741              
7742             sub _daemon_cmd_topic {
7743 60     60   147 my $self = shift;
7744 60   50     243 my $nick = shift || return;
7745 60         225 my $server = $self->server_name();
7746 60         161 my $ref = [ ];
7747 60         179 my $args = [@_];
7748 60         186 my $count = @$args;
7749              
7750             SWITCH:{
7751 60 50       135 if (!$count) {
  60         260  
7752 0         0 push @$ref, ['461', 'TOPIC'];
7753 0         0 last SWITCH;
7754             }
7755 60 50       266 if (!$self->state_chan_exists($args->[0])) {
7756 0         0 push @$ref, ['403', $args->[0]];
7757 0         0 last SWITCH;
7758             }
7759 60 50 33     331 if ($self->state_chan_mode_set($args->[0], 's')
7760             && !$self->state_is_chan_member($nick, $args->[0])) {
7761 0         0 push @$ref, ['442', $args->[0]];
7762 0         0 last SWITCH;
7763             }
7764 60         252 my $chan_name = $self->_state_chan_name($args->[0]);
7765 60 50 66     1104 if ($count == 1
7766             and my $topic = $self->state_chan_topic($args->[0])) {
7767 0         0 push @$ref, {
7768             prefix => $server,
7769             command => '332',
7770             params => [$nick, $chan_name, $topic->[0]],
7771             };
7772             push @$ref, {
7773             prefix => $server,
7774             command => '333',
7775 0         0 params => [$nick, $chan_name, @{ $topic }[1..2]],
  0         0  
7776             };
7777 0         0 last SWITCH;
7778             }
7779 60 100       255 if ($count == 1) {
7780 57         381 push @$ref, {
7781             prefix => $server,
7782             command => '331',
7783             params => [$nick, $chan_name, 'No topic is set'],
7784             };
7785 57         194 last SWITCH;
7786             }
7787 3 50       12 if (!$self->state_is_chan_member($nick, $args->[0])) {
7788 0         0 push @$ref, ['442', $args->[0]];
7789 0         0 last SWITCH;
7790             }
7791 3 50 33     34 if ($self->state_chan_mode_set($args->[0], 't')
7792             && !$self->state_is_chan_op($nick, $args->[0])) {
7793 0         0 push @$ref, ['482', $args->[0]];
7794 0         0 last SWITCH;
7795             }
7796 3         43 my $record = $self->{state}{chans}{uc_irc($args->[0])};
7797 3         63 my $topic_length = $self->server_config('TOPICLEN');
7798 3 50       12 if (length $args->[0] > $topic_length) {
7799 0         0 $args->[1] = substr $args->[0], 0, $topic_length;
7800             }
7801 3 100       12 if ($args->[1] eq '') {
7802 1         5 delete $record->{topic};
7803             }
7804             else {
7805             $record->{topic} = [
7806 2         10 $args->[1],
7807             $self->state_user_full($nick),
7808             time,
7809             ];
7810             }
7811 3         14 $self->send_output(
7812             {
7813             prefix => $self->state_user_uid($nick),
7814             command => 'TOPIC',
7815             params => [$chan_name, $args->[1]],
7816             },
7817             $self->_state_connected_peers(),
7818             );
7819              
7820 3         15 $self->_send_output_channel_local(
7821             $args->[0],
7822             {
7823             prefix => $self->state_user_full($nick),
7824             command => 'TOPIC',
7825             params => [$chan_name, $args->[1]],
7826             },
7827             );
7828             }
7829              
7830 60 50       703 return @$ref if wantarray;
7831 0         0 return $ref;
7832             }
7833              
7834             sub _daemon_cmd_map {
7835 2     2   6 my $self = shift;
7836 2   50     10 my $nick = shift || return;
7837 2         6 my $server = $self->server_name();
7838 2         6 my $sid = $self->server_sid();
7839 2         6 my $ref = [ ];
7840              
7841             SWITCH: {
7842 2 50       4 if (!$self->state_user_is_operator($nick)) {
  2         10  
7843 2         33 my $lastuse = $self->{state}{lastuse}{map};
7844 2         5 my $pacewait = $self->{config}{pace_wait};
7845 2 0 33     8 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      33        
7846 0         0 push @$ref, ['263', 'MAP'];
7847 0         0 last SWITCH;
7848             }
7849 2         8 $self->{state}{lastuse}{map} = time();
7850             }
7851              
7852 2         9 my $full = $self->state_user_full($nick);
7853 2         28 my $msg = sprintf('MAP requested by %s (%s) [%s]',
7854             $nick, (split /!/,$full)[1], $server,
7855             );
7856              
7857 2         11 $self->_send_to_realops( $msg, 'Notice', 'y' );
7858              
7859 2         13 push @$ref, $_ for
7860             $self->_state_do_map( $nick, $sid, 0 );
7861              
7862 2         12 push @$ref, {
7863             prefix => $server,
7864             command => '017',
7865             params => [
7866             $nick,
7867             'End of /MAP',
7868             ],
7869             };
7870             }
7871              
7872 2 50       22 return @$ref if wantarray;
7873 0         0 return $ref;
7874             }
7875              
7876             sub _daemon_cmd_links {
7877 7     7   12 my $self = shift;
7878 7   50     17 my $nick = shift || return;
7879 7         17 my $server = $self->server_name();
7880 7         18 my $sid = $self->server_sid();
7881 7         17 my $args = [ @_ ];
7882 7         14 my $count = @$args;
7883 7         10 my $ref = [ ];
7884              
7885             SWITCH:{
7886 7         13 my $target;
  7         10  
7887 7 100 100     28 if ($count > 1 && !$self->state_peer_exists( $args->[0] )) {
7888 1         5 push @$ref, ['402', $args->[0]];
7889 1         4 last SWITCH;
7890             }
7891 6         14 my $lastuse = $self->{state}{lastuse}{links};
7892 6         13 my $pacewait = $self->{config}{pace_wait};
7893 6 100 100     32 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      66        
7894 1         4 push @$ref, ['263', 'LINKS'];
7895 1         4 last SWITCH;
7896             }
7897 5         13 $self->{state}{lastuse}{links} = time();
7898 5 100       11 if ( $count > 1 ) {
7899 1         3 $target = shift @$args;
7900             }
7901 5 100 66     31 if ($target && uc $server ne uc $target) {
7902 1         5 $self->send_output(
7903             {
7904             prefix => $self->state_user_uid($nick),
7905             command => 'LINKS',
7906             params => [
7907             $self->_state_peer_sid($target),
7908             $args->[0],
7909             ],
7910             },
7911             $self->_state_peer_route($target)
7912             );
7913 1         4 last SWITCH;
7914             }
7915              
7916             $self->_send_to_realops(
7917 4         19 sprintf(
7918             'LINKS requested by %s (%s) [%s]',
7919             $nick, (split /!/,$self->state_user_full($nick))[1], $server,
7920             ), qw[Notice y],
7921             );
7922              
7923 4   100     20 my $mask = shift @$args || '*';
7924              
7925 4         10 push @$ref, $_ for
7926 4         16 @{ $self->_daemon_do_links($nick,$server,$mask) };
7927             }
7928              
7929 7 50       48 return @$ref if wantarray;
7930 0         0 return $ref;
7931             }
7932              
7933             sub _daemon_do_links {
7934 5     5   10 my $self = shift;
7935 5   50     16 my $client = shift || return;
7936 5   50     27 my $prefix = shift || return;
7937 5   50     17 my $mask = shift || return;
7938 5         25 my $sid = $self->server_sid();
7939 5         15 my $server = $self->server_name();
7940 5         11 my $ref = [ ];
7941              
7942 5         22 for ($self->_state_sid_links($sid, $prefix, $client, $mask)) {
7943 13         27 push @$ref, $_;
7944             }
7945 5 100       18 push @$ref, {
7946             prefix => $prefix,
7947             command => '364',
7948             params => [
7949             $client,
7950             $server,
7951             $server,
7952             join( ' ', '0', $self->server_config('serverdesc'))
7953             ],
7954             } if matches_mask($mask, $server);
7955 5         59 push @$ref, {
7956             prefix => $prefix,
7957             command => '365',
7958             params => [$client, $mask, 'End of /LINKS list.'],
7959             };
7960              
7961 5 50       13 return @$ref if wantarray;
7962 5         28 return $ref;
7963             }
7964              
7965             sub _daemon_cmd_knock {
7966 7     7   18 my $self = shift;
7967 7   50     27 my $nick = shift || return;
7968 7         19 my $server = $self->server_name();
7969 7         21 my $sid = $self->server_sid();
7970 7         20 my $args = [ @_ ];
7971 7         16 my $count = @$args;
7972 7         18 my $ref = [ ];
7973              
7974             SWITCH:{
7975 7 50       12 if (!$count) {
  7         23  
7976 0         0 push @$ref, ['461', 'KNOCK'];
7977 0         0 last SWITCH;
7978             }
7979 7         15 my $channel = shift @$args;
7980 7 50       23 if ( !$self->state_chan_exists($channel) ) {
7981 0         0 push @$ref, ['401', $channel];
7982 0         0 last SWITCH;
7983             }
7984 7 50       25 if ( $self->state_is_chan_member($nick,$channel) ) {
7985 0         0 push @$ref, ['714', $channel];
7986 0         0 last SWITCH;
7987             }
7988 7         24 my $chanrec = $self->{state}{chans}{uc_irc $channel};
7989 7 50 66     118 if ( !( $chanrec->{mode} =~ /i/ || $chanrec->{ckey} || ($chanrec->{mode} =~ /l/
      33        
      33        
7990 1         8 && keys %{$chanrec->{users}} >= $chanrec->{climit}) ) ) {
7991 1         4 push @$ref, ['713', $channel];
7992 1         3 last SWITCH;
7993             }
7994 6 50 33     37 if ( $chanrec->{mode} =~ /p/ || $self->_state_user_banned($nick,$channel) ) {
7995 0         0 push @$ref, ['404', $channel];
7996 0         0 next SWITCH;
7997             }
7998              
7999 6         19 my $uid = $self->state_user_uid($nick);
8000 6         76 my $rec = $self->{state}{uids}{$uid};
8001              
8002 6 100       18 if ( !$rec->{last_knock} ) {
8003 3         11 $rec->{knock_count} = 0;
8004             }
8005 6 50 66     34 if ( $rec->{last_knock} && ( $rec->{last_knock} + $self->{config}{knock_client_time} ) < time() ) {
8006 0         0 $rec->{knock_count} = 0;
8007             }
8008 6 100 100     48 if ( $rec->{knock_count} && $rec->{knock_count} > $self->{config}{knock_client_count} ) {
8009 1         5 push @$ref, ['712', $channel,'user'];
8010 1         4 last SWITCH;
8011             }
8012 5 100 66     177 if ( $chanrec->{last_knock} && ( $chanrec->{last_knock} + $self->{config}{knock_delay_channel} ) > time() ) {
8013 1         4 push @$ref, ['712', $channel,'channel'];
8014 1         4 last SWITCH;
8015             }
8016              
8017 4         15 $rec->{last_knock} = time();
8018 4         10 $rec->{knock_count}++;
8019              
8020 4         13 push @$ref, ['711', $channel]; # KNOCK Delivered
8021              
8022 4         17 $chanrec->{last_knock} = time();
8023              
8024             $self->_send_output_channel_local(
8025             $channel,
8026             {
8027             prefix => $server,
8028             command => 'NOTICE',
8029             params => [
8030             $chanrec->{name},
8031             sprintf("KNOCK: %s (%s [%s] has asked for an invite)",
8032 4         20 $chanrec->{name}, split /!/, $rec->{full}->() ),
8033             ],
8034             },
8035             '', 'oh',
8036             );
8037             $self->send_output(
8038             {
8039             prefix => $uid,
8040             command => 'KNOCK',
8041             colonify => 0,
8042             params => [ $chanrec->{name} ],
8043             },
8044 4         35 grep { $self->_state_peer_capab($_,'KNOCK') }
  8         23  
8045             $self->_state_connected_peers(),
8046             );
8047             }
8048              
8049 7 50       61 return @$ref if wantarray;
8050 0         0 return $ref;
8051             }
8052              
8053             sub _daemon_peer_certfp {
8054 0     0   0 my $self = shift;
8055 0   0     0 my $peer_id = shift || return;
8056 0   0     0 my $prefix = shift || return;
8057 0         0 my $ref = [ ];
8058 0         0 my $args = [@_];
8059              
8060             SWITCH: {
8061 0 0       0 if ($prefix !~ $uid_re) {
  0         0  
8062 0         0 last SWITCH;
8063             }
8064 0 0       0 if(!$args->[0]) {
8065 0         0 last SWITCH;
8066             }
8067 0         0 my $uid = $self->state_user_uid($prefix);
8068 0 0       0 last SWITCH if !$uid;
8069 0         0 $self->{state}{uids}{$uid}{certfp} = $args->[0];
8070             $self->send_output(
8071             {
8072             prefix => $prefix,,
8073             command => 'CERTFP',
8074             colonify => 0,
8075             params => $args,
8076             },
8077 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
8078             );
8079             }
8080              
8081 0 0       0 return @$ref if wantarray;
8082 0         0 return $ref;
8083             }
8084              
8085             sub _daemon_peer_knock {
8086 1     1   3 my $self = shift;
8087 1   50     5 my $peer_id = shift || return;
8088 1   50     5 my $prefix = shift || return;
8089 1         4 my $sid = $self->server_sid();
8090 1         3 my $ref = [ ];
8091 1         3 my $args = [ @_ ];
8092 1         2 my $count = @$args;
8093              
8094             SWITCH: {
8095 1 50       3 if (!$count) {
  1         4  
8096 0         0 last SWITCH;
8097             }
8098 1         3 my $channel = shift @$args;
8099 1 50       3 if ( !$self->state_chan_exists($channel) ) {
8100 0         0 last SWITCH;
8101             }
8102 1         6 my $chanrec = $self->{state}{chans}{uc_irc $channel};
8103 1         15 $chanrec->{last_knock} = time();
8104             $self->_send_output_channel_local(
8105             $channel,
8106             {
8107             prefix => $self->server_name(),
8108             command => 'NOTICE',
8109             params => [
8110             $chanrec->{name},
8111             sprintf("KNOCK: %s (%s [%s] has asked for an invite)",
8112 1         4 $chanrec->{name}, split /!/, $self->state_user_full($prefix) ),
8113             ],
8114             },
8115             '', 'oh',
8116             );
8117             $self->send_output(
8118             {
8119             prefix => $prefix,,
8120             command => 'KNOCK',
8121             colonify => 0,
8122             params => [ $chanrec->{name} ],
8123             },
8124 1 100       12 grep { $_ ne $peer_id && $self->_state_peer_capab($_,'KNOCK') }
  2         12  
8125             $self->_state_connected_peers(),
8126             );
8127             }
8128              
8129 1 50       6 return @$ref if wantarray;
8130 1         2 return $ref;
8131             }
8132              
8133             sub _daemon_peer_squit {
8134 228     228   586 my $self = shift;
8135 228   50     1005 my $peer_id = shift || return;
8136 228         911 my $sid = $self->server_sid();
8137 228         604 my $ref = [ ];
8138 228         715 my $args = [ @_ ];
8139 228         570 my $count = @$args;
8140 228 50       1195 return if !$self->state_sid_exists($args->[0]);
8141              
8142             SWITCH: {
8143 228 50       530 if ($peer_id ne $self->_state_sid_route($args->[0])) {
  228         1015  
8144 0         0 $self->send_output(
8145             {
8146             command => 'SQUIT',
8147             params => $args,
8148             },
8149             $self->_state_sid_route($args->[0]),
8150             );
8151 0         0 last SWITCH;
8152             }
8153 228 50       823 if ($peer_id eq $self->_state_sid_route($args->[0])) {
8154             $self->send_output(
8155             {
8156             command => 'SQUIT',
8157             params => $args,
8158             },
8159 228         1534 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  340         1814  
8160             );
8161 228         932 my $qsid = $args->[0];
8162 228         2370 my $qpeer = $self->_state_sid_name($qsid);
8163 228         1538 $self->send_event("daemon_squit", $qpeer, $args->[1]);
8164             my $quit_msg = join ' ',
8165 228         26942 $self->{state}{sids}{$qsid}{peer}, $qpeer;
8166              
8167 228 100       1211 if ($sid eq $self->{state}{sids}{$qsid}{psid}) {
8168 227         1831 my $stats = $self->{state}{conns}{$peer_id}{stats}->stats();
8169             $self->_send_to_realops(
8170             sprintf(
8171             '%s was connected for %s. %s/%s sendK/recvK.',
8172 227         2570 $qpeer, _duration(time() - $self->{state}{sids}{$qsid}{conn_time}),
8173             ( $stats->[0] >> 10 ), ( $stats->[1] >> 10 ),
8174             ), qw[Notice e],
8175             );
8176             }
8177             else {
8178             $self->_send_to_realops(
8179             sprintf(
8180             'Server %s split from %s',
8181             $qpeer, $self->{state}{sids}{$qsid}{peer},
8182 1         13 ), qw[Notice e],
8183             );
8184             }
8185 228         1418 for my $uid ($self->_state_server_squit($qsid)) {
8186 518         2376 my $output = {
8187             prefix => $self->state_user_full($uid),
8188             command => 'QUIT',
8189             params => [$quit_msg],
8190             };
8191 518         1331 my $common = { };
8192 518         1112 for my $uchan ( keys %{ $self->{state}{uids}{$uid}{chans} } ) {
  518         3931  
8193 1989         6778 delete $self->{state}{chans}{$uchan}{users}{$uid};
8194 1989         2722 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  1989         21849  
8195 124668 100       275131 next if $user !~ m!^$sid!;
8196 5         19 $common->{$user} = $self->_state_uid_route($user);
8197             }
8198 1989 100       6989 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  1989         5474  
8199 57         641 delete $self->{state}{chans}{$uchan};
8200             }
8201             }
8202 518         3955 $self->send_output($output, values %$common);
8203             $self->send_event(
8204             "daemon_quit",
8205             $output->{prefix},
8206 518         2748 $output->{params}[0],
8207             );
8208 518         77006 my $record = delete $self->{state}{uids}{$uid};
8209 518         2561 my $nick = uc_irc $record->{nick};
8210 518         8406 delete $self->{state}{users}{$nick};
8211             # WATCH LOGOFF
8212 518 50       2046 if ( defined $self->{state}{watches}{$nick} ) {
8213 0         0 my $laston = time();
8214 0         0 $self->{state}{watches}{$nick}{laston} = $laston;
8215 0         0 foreach my $wuid ( keys %{ $self->{state}{watches}{$nick}{uids} } ) {
  0         0  
8216 0 0       0 next if !defined $self->{state}{uids}{$wuid};
8217 0         0 my $wrec = $self->{state}{uids}{$wuid};
8218             $self->send_output(
8219             {
8220             prefix => $record->{server},
8221             command => '601',
8222             params => [
8223             $wrec->{nick},
8224             $record->{nick},
8225             $record->{auth}{ident},
8226             $record->{auth}{hostname},
8227             $laston,
8228             'logged offline',
8229             ],
8230             },
8231             $wrec->{route_id},
8232 0         0 );
8233             }
8234             }
8235 518 100       2419 if ($record->{umode} =~ /o/) {
8236 215         704 $self->{state}{stats}{ops_online}--;
8237             }
8238 518 50       2105 if ($record->{umode} =~ /i/) {
8239 518         1343 $self->{state}{stats}{invisible}--;
8240             }
8241 518         8706 unshift @{ $self->{state}{whowas}{$nick} }, {
8242             logoff => time(),
8243             account => $record->{account},
8244             nick => $record->{nick},
8245             user => $record->{auth}{ident},
8246             host => $record->{auth}{hostname},
8247             real => $record->{auth}{realhost},
8248             sock => $record->{ipaddress},
8249             ircname => $record->{ircname},
8250             server => $record->{server},
8251 518         961 };
8252             }
8253 228         908 last SWITCH;
8254             }
8255             }
8256              
8257 228 50       998 return @$ref if wantarray;
8258 228         1337 return $ref;
8259             }
8260              
8261             sub _daemon_peer_resv {
8262 2     2   5 my $self = shift;
8263 2   50     11 my $peer_id = shift || return;
8264 2   50     9 my $uid = shift || return;
8265 2         9 my $server = $self->server_name();
8266 2         9 my $sid = $self->server_sid();
8267 2         9 my $ref = [ ];
8268 2         7 my $args = [ @_ ];
8269 2         6 my $count = @$args;
8270              
8271             SWITCH: {
8272 2 50 33     5 if (!$count || $count < 3) {
  2         18  
8273 0         0 last SWITCH;
8274             }
8275 2         10 my ($peermask,$duration,$mask,$reason) = @$args;
8276 2 50       40 $reason = '' if !$reason;
8277 2         6 my $us = 0;
8278             {
8279 2         5 my %targpeers;
  2         5  
8280 2         8 my $sids = $self->{state}{sids};
8281 2         4 foreach my $psid ( keys %{ $sids } ) {
  2         13  
8282 8 50       32 if (matches_mask($peermask, $sids->{$psid}{name})) {
8283 8 100       380 if ($sid eq $psid) {
8284 2         7 $us = 1;
8285             }
8286             else {
8287 6         21 $targpeers{ $sids->{$psid}{route_id} }++;
8288             }
8289             }
8290             }
8291 2         8 delete $targpeers{$peer_id};
8292             $self->send_output(
8293             {
8294             prefix => $uid,
8295             command => 'RESV',
8296             params => [
8297             $peermask,
8298             $duration,
8299             $mask,
8300             $reason,
8301             ],
8302             },
8303 2         18 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         11  
8304             );
8305             }
8306              
8307 2 50       12 last SWITCH if !$us;
8308              
8309 2 50       8 if ( !$reason ) {
8310 0   0     0 $reason = shift @$args || '';
8311             }
8312              
8313 2 50       13 if ( $self->_state_have_resv($mask) ) {
8314 0         0 push @$ref, {
8315             prefix => $sid,
8316             command => 'NOTICE',
8317             params => [ $uid, "A RESV has already been placed on: $mask" ],
8318             };
8319 0         0 last SWITCH;
8320             }
8321              
8322 2         14 my $full = $self->state_user_full($uid);
8323              
8324 2 50       18 last SWITCH if !$self->_state_add_drkx_line( 'resv', $full, time(), $server,
8325             $duration, $mask, $reason );
8326 2         11 my $minutes = $duration / 60;
8327              
8328 2         13 $self->send_event(
8329             "daemon_resv",
8330             $full,
8331             $mask,
8332             $minutes,
8333             $reason,
8334             );
8335              
8336 2 50       246 my $temp = $duration ? "temporary $minutes min. " : '';
8337              
8338 2         10 my $reply_notice = "Added ${temp}RESV [$mask]";
8339 2         10 my $locop_notice = "$full added ${temp}RESV for [$mask] [$reason]";
8340              
8341 2         11 push @$ref, {
8342             prefix => $sid,
8343             command => 'NOTICE',
8344             params => [ $uid, $reply_notice ],
8345             };
8346              
8347 2         13 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
8348             }
8349              
8350 2 50       17 return @$ref if wantarray;
8351 0         0 return $ref;
8352             }
8353              
8354             sub _daemon_peer_unresv {
8355 1     1   3 my $self = shift;
8356 1   50     6 my $peer_id = shift || return;
8357 1   50     5 my $uid = shift || return;
8358 1         6 my $server = $self->server_name();
8359 1         4 my $sid = $self->server_sid();
8360 1         3 my $ref = [ ];
8361 1         4 my $args = [ @_ ];
8362 1         3 my $count = @$args;
8363              
8364              
8365             SWITCH: {
8366 1 50 33     3 if (!$count || $count < 2) {
  1         9  
8367 0         0 last SWITCH;
8368             }
8369 1         4 my ($peermask,$unmask) = @$args;
8370 1         3 my $us = 0;
8371             {
8372 1         2 my %targpeers;
  1         2  
8373 1         5 my $sids = $self->{state}{sids};
8374 1         3 foreach my $psid ( keys %{ $sids } ) {
  1         6  
8375 4 50       19 if (matches_mask($peermask, $sids->{$psid}{name})) {
8376 4 100       202 if ($sid eq $psid) {
8377 1         4 $us = 1;
8378             }
8379             else {
8380 3         12 $targpeers{ $sids->{$psid}{route_id} }++;
8381             }
8382             }
8383             }
8384 1         4 delete $targpeers{$peer_id};
8385             $self->send_output(
8386             {
8387             prefix => $uid,
8388             command => 'UNRESV',
8389             params => [
8390             $peermask,
8391             $unmask,
8392             ],
8393             colonify => 0,
8394             },
8395 1         12 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  1         7  
8396             );
8397             }
8398              
8399 1 50       7 last SWITCH if !$us;
8400              
8401 1         9 my $result = $self->_state_del_drkx_line( 'resv', $unmask );
8402              
8403 1         7 my $full = $self->state_user_full($uid);
8404              
8405 1 50       5 if ( !$result ) {
8406 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $uid, "No RESV for [$unmask] found" ] };
8407 0         0 last SWITCH;
8408             }
8409              
8410             $self->send_event(
8411 1         6 "daemon_unresv",
8412             $full,
8413             $unmask,
8414             );
8415              
8416 1         120 push @$ref, {
8417             prefix => $sid,
8418             command => 'NOTICE',
8419             params => [ $uid, "RESV for [$unmask] is removed" ],
8420             };
8421              
8422 1         9 $self->_send_to_realops( "$full has removed the RESV for: [$unmask]", 'Notice', 's' );
8423              
8424             }
8425              
8426 1 50       9 return @$ref if wantarray;
8427 0         0 return $ref;
8428             }
8429              
8430             sub _daemon_peer_xline {
8431 2     2   7 my $self = shift;
8432 2   50     8 my $peer_id = shift || return;
8433 2   50     9 my $uid = shift || return;
8434 2         11 my $server = $self->server_name();
8435 2         8 my $sid = $self->server_sid();
8436 2         5 my $ref = [ ];
8437 2         5 my $args = [ @_ ];
8438 2         6 my $count = @$args;
8439              
8440             SWITCH: {
8441 2 50 33     5 if (!$count || $count < 3) {
  2         26  
8442 0         0 last SWITCH;
8443             }
8444 2         20 my ($peermask,$duration,$mask,$reason) = @$args;
8445 2 50       8 $reason = '' if !$reason;
8446 2         6 my $us = 0;
8447             {
8448 2         5 my %targpeers;
  2         5  
8449 2         6 my $sids = $self->{state}{sids};
8450 2         5 foreach my $psid ( keys %{ $sids } ) {
  2         11  
8451 8 50       31 if (matches_mask($peermask, $sids->{$psid}{name})) {
8452 8 100       339 if ($sid eq $psid) {
8453 2         7 $us = 1;
8454             }
8455             else {
8456 6         21 $targpeers{ $sids->{$psid}{route_id} }++;
8457             }
8458             }
8459             }
8460 2         8 delete $targpeers{$peer_id};
8461             $self->send_output(
8462             {
8463             prefix => $uid,
8464             command => 'XLINE',
8465             params => [
8466             $peermask,
8467             $duration,
8468             $mask,
8469             $reason,
8470             ],
8471             },
8472 2         15 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         11  
8473             );
8474             }
8475              
8476 2 50       11 last SWITCH if !$us;
8477              
8478 2 50       7 if ( !$reason ) {
8479 0   0     0 $reason = shift @$args || '';
8480             }
8481              
8482 2         10 my $full = $self->state_user_full($uid);
8483              
8484 2 50       14 last SWITCH if !$self->_state_add_drkx_line( 'xline', $full, time(), $server,
8485             $duration, $mask, $reason );
8486 2         8 my $minutes = $duration / 60;
8487              
8488 2         11 $self->send_event(
8489             "daemon_xline",
8490             $full,
8491             $mask,
8492             $minutes,
8493             $reason,
8494             );
8495              
8496 2 50       335 my $temp = $duration ? "temporary $minutes min. " : '';
8497              
8498 2         18 my $reply_notice = "Added ${temp}X-Line [$mask]";
8499 2         12 my $locop_notice = "$full added ${temp}X-Line for [$mask] [$reason]";
8500              
8501 2         11 push @$ref, {
8502             prefix => $sid,
8503             command => 'NOTICE',
8504             params => [ $uid, $reply_notice ],
8505             };
8506              
8507 2         13 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
8508              
8509 2         13 $self->_state_do_local_users_match_xline($mask,$reason);
8510             }
8511              
8512 2 50       16 return @$ref if wantarray;
8513 0         0 return $ref;
8514             }
8515              
8516             sub _daemon_peer_unxline {
8517 1     1   3 my $self = shift;
8518 1   50     3 my $peer_id = shift || return;
8519 1   50     4 my $uid = shift || return;
8520 1         3 my $server = $self->server_name();
8521 1         2 my $sid = $self->server_sid();
8522 1         3 my $ref = [ ];
8523 1         3 my $args = [ @_ ];
8524 1         2 my $count = @$args;
8525              
8526              
8527             SWITCH: {
8528 1 50 33     2 if (!$count || $count < 2) {
  1         6  
8529 0         0 last SWITCH;
8530             }
8531 1         3 my ($peermask,$unmask) = @$args;
8532 1         2 my $us = 0;
8533             {
8534 1         1 my %targpeers;
  1         2  
8535 1         2 my $sids = $self->{state}{sids};
8536 1         2 foreach my $psid ( keys %{ $sids } ) {
  1         3  
8537 4 50       12 if (matches_mask($peermask, $sids->{$psid}{name})) {
8538 4 100       131 if ($sid eq $psid) {
8539 1         3 $us = 1;
8540             }
8541             else {
8542 3         8 $targpeers{ $sids->{$psid}{route_id} }++;
8543             }
8544             }
8545             }
8546 1         2 delete $targpeers{$peer_id};
8547             $self->send_output(
8548             {
8549             prefix => $uid,
8550             command => 'UNXLINE',
8551             params => [
8552             $peermask,
8553             $unmask,
8554             ],
8555             colonify => 0,
8556             },
8557 1         8 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  1         3  
8558             );
8559             }
8560              
8561 1 50       4 last SWITCH if !$us;
8562              
8563 1         4 my $result = $self->_state_del_drkx_line( 'xline', $unmask );
8564              
8565 1         3 my $full = $self->state_user_full($uid);
8566              
8567 1 50       4 if ( !$result ) {
8568 0         0 push @$ref, { prefix => $server, command => 'NOTICE', params => [ $uid, "No X-Line for [$unmask] found" ] };
8569 0         0 last SWITCH;
8570             }
8571              
8572             $self->send_event(
8573 1         5 "daemon_unxline",
8574             $full,
8575             $unmask,
8576             );
8577              
8578 1         86 push @$ref, {
8579             prefix => $sid,
8580             command => 'NOTICE',
8581             params => [ $uid, "X-Line for [$unmask] is removed" ],
8582             };
8583              
8584 1         5 $self->_send_to_realops( "$full has removed the X-Line for: [$unmask]", 'Notice', 's' );
8585              
8586             }
8587              
8588 1 50       6 return @$ref if wantarray;
8589 0         0 return $ref;
8590             }
8591              
8592             sub _daemon_peer_dline {
8593 2     2   6 my $self = shift;
8594 2   50     10 my $peer_id = shift || return;
8595 2   50     9 my $uid = shift || return;
8596 2         7 my $server = $self->server_name();
8597 2         6 my $sid = $self->server_sid();
8598 2         6 my $ref = [ ];
8599 2         6 my $args = [ @_ ];
8600 2         6 my $count = @$args;
8601              
8602             SWITCH: {
8603 2 50 33     5 if (!$count || $count < 3) {
  2         16  
8604 0         0 last SWITCH;
8605             }
8606 2         8 my ($peermask,$duration,$netmask,$reason) = @$args;
8607 2 50       6 $reason = '' if !$reason;
8608 2         5 my $us = 0;
8609             {
8610 2         4 my %targpeers;
  2         4  
8611 2         8 my $sids = $self->{state}{sids};
8612 2         5 foreach my $psid ( keys %{ $sids } ) {
  2         11  
8613 8 50       30 if (matches_mask($peermask, $sids->{$psid}{name})) {
8614 8 100       372 if ($sid eq $psid) {
8615 2         8 $us = 1;
8616             }
8617             else {
8618 6         21 $targpeers{ $sids->{$psid}{route_id} }++;
8619             }
8620             }
8621             }
8622 2         7 delete $targpeers{$peer_id};
8623             $self->send_output(
8624             {
8625             prefix => $uid,
8626             command => 'DLINE',
8627             params => [
8628             $peermask,
8629             $duration,
8630             $netmask,
8631             $reason,
8632             ],
8633             },
8634 2         17 grep { $self->_state_peer_capab($_, 'DLN') } keys %targpeers,
  2         12  
8635             );
8636             }
8637              
8638 2 50       11 last SWITCH if !$us;
8639              
8640 2         13 $netmask = Net::CIDR::cidrvalidate($netmask);
8641              
8642 2 50       1296 last SWITCH if !$netmask;
8643              
8644 2         22 my $full = $self->state_user_full($uid);
8645              
8646 2         9 my $minutes = $duration / 60;
8647              
8648 2 50       29 last SWITCH if !$self->_state_add_drkx_line( 'dline',
8649             $full, time, $server, $duration,
8650             $netmask, $reason );
8651              
8652 2         152 $self->send_event(
8653             "daemon_dline",
8654             $full,
8655             $netmask,
8656             $minutes,
8657             $reason,
8658             );
8659              
8660 2         242 $self->add_denial( $netmask, 'You have been D-lined.' );
8661              
8662 2 50       31 my $temp = $duration ? "temporary $minutes min. " : '';
8663              
8664 2         9 my $reply_notice = "Added ${temp}D-Line [$netmask]";
8665 2         10 my $locop_notice = "$full added ${temp}D-Line for [$netmask] [$reason]";
8666              
8667 2         12 push @$ref, {
8668             prefix => $sid,
8669             command => 'NOTICE',
8670             params => [ $uid, $reply_notice ],
8671             };
8672              
8673 2         10 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
8674              
8675 2         12 $self->_state_do_local_users_match_dline($netmask,$reason);
8676             }
8677              
8678 2 50       17 return @$ref if wantarray;
8679 0         0 return $ref;
8680             }
8681              
8682             sub _daemon_peer_undline {
8683 1     1   3 my $self = shift;
8684 1   50     4 my $peer_id = shift || return;
8685 1   50     5 my $uid = shift || return;
8686 1         3 my $server = $self->server_name();
8687 1         4 my $sid = $self->server_sid();
8688 1         3 my $ref = [ ];
8689 1         4 my $args = [ @_ ];
8690 1         3 my $count = @$args;
8691              
8692              
8693             SWITCH: {
8694 1 50 33     2 if (!$count || $count < 2) {
  1         7  
8695 0         0 last SWITCH;
8696             }
8697 1         4 my ($peermask,$unmask) = @$args;
8698 1         2 my $us = 0;
8699             {
8700 1         2 my %targpeers;
  1         1  
8701 1         4 my $sids = $self->{state}{sids};
8702 1         2 foreach my $psid ( keys %{ $sids } ) {
  1         5  
8703 4 50       12 if (matches_mask($peermask, $sids->{$psid}{name})) {
8704 4 100       145 if ($sid eq $psid) {
8705 1         2 $us = 1;
8706             }
8707             else {
8708 3         11 $targpeers{ $sids->{$psid}{route_id} }++;
8709             }
8710             }
8711             }
8712 1         4 delete $targpeers{$peer_id};
8713             $self->send_output(
8714             {
8715             prefix => $uid,
8716             command => 'UNDLINE',
8717             params => [
8718             $peermask,
8719             $unmask,
8720             ],
8721             colonify => 0,
8722             },
8723 1         8 grep { $self->_state_peer_capab($_, 'UNDLN') } keys %targpeers,
  1         4  
8724             );
8725             }
8726              
8727 1 50       5 last SWITCH if !$us;
8728              
8729 1         6 my $result = $self->_state_del_drkx_line( 'dline', $unmask );
8730              
8731 1         4 my $full = $self->state_user_full($uid);
8732              
8733 1 50       5 if ( !$result ) {
8734 0         0 push @$ref, { prefix => $sid, command => 'NOTICE', params => [ $uid, "No D-Line for [$unmask] found" ] };
8735 0         0 last SWITCH;
8736             }
8737              
8738             $self->send_event(
8739 1         6 "daemon_undline",
8740             $full,
8741             $unmask,
8742             );
8743              
8744 1         107 $self->del_denial( $unmask );
8745              
8746 1         7 push @$ref, {
8747             prefix => $sid,
8748             command => 'NOTICE',
8749             params => [ $uid, "D-Line for [$unmask] is removed" ],
8750             };
8751              
8752 1         5 $self->_send_to_realops( "$full has removed the D-Line for: [$unmask]", 'Notice', 's' );
8753              
8754             }
8755              
8756 1 50       6 return @$ref if wantarray;
8757 0         0 return $ref;
8758             }
8759              
8760             sub _daemon_peer_encap {
8761 2     2   7 my $self = shift;
8762 2   50     9 my $peer_id = shift || return;
8763 2   50     8 my $prefix = shift || return;
8764 2         11 my $server = $self->server_name();
8765 2         7 my $ref = [ ];
8766 2         7 my $args = [ @_ ];
8767 2         6 my $count = @$args;
8768              
8769             SWITCH: {
8770 2 50       5 if (!$count) {
  2         8  
8771 0         0 last SWITCH;
8772             }
8773 2         6 my $target = $args->[0];
8774 2         7 my $us = 0;
8775 2         7 my $ucserver = uc $server;
8776 2         6 my %targets;
8777              
8778 2         6 for my $peer (keys %{ $self->{state}{peers} }) {
  2         15  
8779 8 50       32 if (matches_mask($target, $peer)) {
8780 8 100       404 if ($ucserver eq $peer) {
8781 2         17 $us = 1;
8782             }
8783             else {
8784 6         23 $targets{$self->_state_peer_route($peer)}++;
8785             }
8786             }
8787             }
8788 2         9 delete $targets{$peer_id};
8789             $self->send_output(
8790             {
8791             prefix => $prefix,
8792             command => 'ENCAP',
8793             params => $args,
8794             colonify => 1,
8795             },
8796 2         16 grep { $self->_state_peer_capab($_, 'ENCAP') } keys %targets,
  2         13  
8797             );
8798              
8799 2 50       13 last SWITCH if !$us;
8800              
8801 2   33     15 $self->send_event(
8802             'daemon_encap',
8803             ( $self->_state_sid_name($prefix) || $self->state_user_full($prefix) ),
8804             @$args,
8805             );
8806              
8807             # Add ENCAP subcommand handling here if required.
8808             }
8809              
8810 2 50       218 return @$ref if wantarray;
8811 2         7 return $ref;
8812             }
8813              
8814             sub _daemon_peer_kline {
8815 2     2   6 my $self = shift;
8816 2   50     8 my $peer_id = shift || return;
8817 2   50     9 my $uid = shift || return;
8818 2         9 my $server = $self->server_name();
8819 2         5 my $ref = [ ];
8820 2         8 my $args = [ @_ ];
8821 2         5 my $count = @$args;
8822              
8823             SWITCH: {
8824 2 50 33     4 if (!$count || $count < 5) {
  2         16  
8825 0         0 last SWITCH;
8826             }
8827 2         12 my $full = $self->state_user_full($uid);
8828 2         9 my $target = $args->[0];
8829 2         8 my $us = 0;
8830 2         8 my $ucserver = uc $server;
8831 2         4 my %targets;
8832              
8833 2         6 for my $peer (keys %{ $self->{state}{peers} }) {
  2         12  
8834 8 50       27 if (matches_mask($target, $peer)) {
8835 8 100       353 if ($ucserver eq $peer) {
8836 2         9 $us = 1;
8837             }
8838             else {
8839 6         20 $targets{$self->_state_peer_route($peer)}++;
8840             }
8841             }
8842             }
8843 2         7 delete $targets{$peer_id};
8844             $self->send_output(
8845             {
8846             prefix => $uid,
8847             command => 'KLINE',
8848             params => $args,
8849             colonify => 0,
8850             },
8851 2         17 grep { $self->_state_peer_capab($_, 'KLN') } keys %targets,
  2         9  
8852             );
8853              
8854 2 50       9 last SWITCH if !$us;
8855              
8856 2 50       13 last SWITCH if !$self->_state_add_drkx_line( 'kline', $full, time(), @$args );
8857              
8858 2         20 my $minutes = $args->[1] / 60;
8859 2         6 $args->[1] = $minutes;
8860              
8861 2         13 $self->send_event("daemon_kline", $full, @$args);
8862              
8863 2 50       262 my $temp = $minutes ? "temporary $minutes min. " : '';
8864              
8865 2         25 my $reply_notice = sprintf('Added %sK-Line [%s@%s]', $temp, $args->[2], $args->[3]);
8866 2         13 my $locop_notice = sprintf('%s added %sK-Line for [%s@%s] [%s]',
8867             $full, $temp, $args->[2], $args->[3], $args->[4] );
8868              
8869 2         11 push @$ref, {
8870             prefix => $self->server_sid(),
8871             command => 'NOTICE',
8872             params => [ $uid, $reply_notice ],
8873             };
8874              
8875 2         12 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
8876              
8877 2         15 $self->_state_do_local_users_match_kline($args->[2], $args->[3], $args->[4]);
8878             }
8879              
8880 2 50       18 return @$ref if wantarray;
8881 0         0 return $ref;
8882             }
8883              
8884             sub _daemon_peer_unkline {
8885 1     1   3 my $self = shift;
8886 1   50     5 my $peer_id = shift || return;
8887 1   50     5 my $uid = shift || return;
8888 1         3 my $server = $self->server_name();
8889 1         3 my $ref = [ ];
8890 1         4 my $args = [ @_ ];
8891 1         2 my $count = @$args;
8892              
8893             # :klanker UNKLINE logserv.gumbynet.org.uk * moos.loud.me.uk
8894             SWITCH: {
8895 1 50 33     2 if (!$count || $count < 3) {
  1         8  
8896 0         0 last SWITCH;
8897             }
8898 1         4 my $full = $self->state_user_full($uid);
8899 1         3 my $target = $args->[0];
8900 1         4 my $us = 0;
8901 1         4 my $ucserver = uc $server;
8902 1         2 my %targets;
8903              
8904 1         3 for my $peer (keys %{ $self->{state}{peers} }) {
  1         6  
8905 4 50       11 if (matches_mask($target, $peer)) {
8906 4 100       183 if ($ucserver eq $peer) {
8907 1         3 $us = 1;
8908             }
8909             else {
8910 3         9 $targets{$self->_state_peer_route($peer)}++;
8911             }
8912             }
8913             }
8914 1         4 delete $targets{$peer_id};
8915             $self->send_output(
8916             {
8917             prefix => $uid,
8918             command => 'UNKLINE',
8919             params => $args,
8920             colonify => 0,
8921             },
8922 1         7 grep { $self->_state_peer_capab($_, 'UNKLN') } keys %targets,
  1         5  
8923             );
8924              
8925 1 50       5 last SWITCH if !$us;
8926              
8927 1         6 my $result = $self->_state_del_drkx_line( 'kline', $args->[1], $args->[2] );
8928              
8929 1         4 my $sid = $self->server_sid();
8930              
8931 1         6 my $unmask = join '@', $args->[1], $args->[2];
8932              
8933 1 50       3 if ( !$result ) {
8934 0         0 push @$ref, { prefix => $sid, command => 'NOTICE', params => [ $uid, "No K-Line for [$unmask] found" ] };
8935 0         0 last SWITCH;
8936             }
8937              
8938 1         6 $self->send_event("daemon_unkline", $full, @$args);
8939              
8940 1         105 push @$ref, {
8941             prefix => $sid,
8942             command => 'NOTICE',
8943             params => [ $uid, "K-Line for [$unmask] is removed" ],
8944             };
8945              
8946 1         7 $self->_send_to_realops( "$full has removed the K-Line for: [$unmask]", 'Notice', 's' );
8947             }
8948              
8949 1 50       8 return @$ref if wantarray;
8950 0         0 return $ref;
8951             }
8952              
8953             sub _daemon_peer_wallops {
8954 0     0   0 my $self = shift;
8955 0   0     0 my $peer_id = shift || return;
8956 0   0     0 my $prefix = shift || return;
8957 0         0 my $ref = [ ];
8958 0         0 my $args = [ @_ ];
8959 0         0 my $count = @$args;
8960              
8961             SWITCH: {
8962 0         0 $self->send_output(
8963             {
8964             prefix => $prefix,
8965             command => 'WALLOPS',
8966             params => [$args->[0]],
8967             },
8968 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
8969             );
8970             # Prefix can either be SID or UID
8971 0         0 my $full = $self->_state_sid_name( $prefix );
8972 0 0       0 $full = $self->state_user_full( $prefix ) if !$full;
8973              
8974             $self->send_output(
8975             {
8976             prefix => $full,
8977             command => 'WALLOPS',
8978             params => [$args->[0]],
8979             },
8980 0         0 keys %{ $self->{state}{wallops} },
  0         0  
8981             );
8982 0         0 $self->send_event("daemon_wallops", $full, $args->[0]);
8983             }
8984              
8985 0 0       0 return @$ref if wantarray;
8986 0         0 return $ref;
8987             }
8988              
8989             sub _daemon_peer_globops {
8990 0     0   0 my $self = shift;
8991 0   0     0 my $peer_id = shift || return;
8992 0   0     0 my $prefix = shift || return;
8993 0         0 my $ref = [ ];
8994 0         0 my $args = [ @_ ];
8995 0         0 my $count = @$args;
8996              
8997             SWITCH: {
8998             # Hot potato
8999 0         0 $self->send_output(
9000             {
9001             prefix => $prefix,
9002             command => 'GLOBOPS',
9003             params => [$args->[0]],
9004             },
9005 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
9006             );
9007             # Prefix can either be SID or UID
9008 0         0 my $full = $self->_state_sid_name( $prefix );
9009 0 0       0 $full = $self->state_user_nick( $prefix ) if !$full;
9010              
9011 0         0 my $msg = "from $full: " . $args->[0];
9012              
9013 0         0 $self->_send_to_realops(
9014             $msg, 'globops', 's',
9015             );
9016              
9017 0         0 $self->send_event("daemon_globops", $full, $args->[0]);
9018             }
9019              
9020 0 0       0 return @$ref if wantarray;
9021 0         0 return $ref;
9022             }
9023              
9024             sub _daemon_peer_eob {
9025 385     385   889 my $self = shift;
9026 385   50     1283 my $peer_id = shift || return;
9027 385   50     1197 my $peer = shift || return;
9028 385         1023 my $ref = [ ];
9029 385 100       1561 if ($self->{state}{conns}{$peer_id}{sid} eq $peer) {
9030 256         806 my $crec = $self->{state}{conns}{$peer_id};
9031             $self->_send_to_realops(
9032             sprintf(
9033             'End of burst from %s (%u seconds)',
9034 256         2238 $crec->{name}, ( time() - $crec->{conn_time} ),
9035             ),
9036             'Notice',
9037             's',
9038             );
9039             }
9040 385         1994 $self->send_event('daemon_eob', $self->{state}{sids}{$peer}{name}, $peer);
9041 385 50       47060 return @$ref if wantarray;
9042 385         985 return $ref;
9043             }
9044              
9045             sub _daemon_peer_kill {
9046 5     5   13 my $self = shift;
9047 5   50     21 my $peer_id = shift || return;
9048 5   50     18 my $killer = shift || return;
9049 5         14 my $server = $self->server_name();
9050 5         11 my $ref = [ ];
9051 5         12 my $args = [ @_ ];
9052 5         13 my $count = @$args;
9053              
9054             SWITCH: {
9055 5 50       8 if ($self->state_sid_exists($args->[0])) {
  5         31  
9056 0         0 last SWITCH;
9057             }
9058 5 50       22 if (!$self->state_uid_exists($args->[0])) {
9059 5         14 last SWITCH;
9060             }
9061              
9062 0         0 my $target = $args->[0];
9063 0         0 my $comment = $args->[1];
9064 0 0       0 if ($self->_state_is_local_uid($target)) {
9065 0         0 my $route_id = $self->_state_uid_route($target);
9066             $self->send_output(
9067             {
9068             prefix => $killer,
9069             command => 'KILL',
9070             params => [
9071             $target,
9072             join('!', $server, $comment),
9073             ],
9074 0         0 }, grep { $_ ne $peer_id } $self->_state_connected_peers()
  0         0  
9075             );
9076              
9077 0   0     0 $self->send_output(
9078             {
9079             prefix => ( $self->_state_sid_name($killer) || $self->state_user_full($killer) ),
9080             command => 'KILL',
9081             params => [
9082             $target,
9083             join('!', $server, $comment),
9084             ],
9085             },
9086             $route_id,
9087             );
9088              
9089 0 0       0 if ($route_id eq 'spoofed') {
9090 0         0 $self->call(
9091             'del_spoofed_nick',
9092             $target,
9093             "Killed ($comment)",
9094             );
9095             }
9096             else {
9097 0         0 $self->{state}{conns}{$route_id}{killed} = 1;
9098 0         0 $self->_terminate_conn_error(
9099             $route_id,
9100             "Killed ($comment)",
9101             );
9102             }
9103             }
9104             else {
9105 0         0 $self->{state}{uids}{$target}{killed} = 1;
9106             $self->send_output(
9107             {
9108             prefix => $killer,
9109             command => 'KILL',
9110             params => [$target, join('!', $server, $comment)],
9111             },
9112 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
9113             );
9114             $self->send_output(
9115 0         0 @{ $self->_daemon_peer_quit(
  0         0  
9116             $target, "Killed ($killer ($comment))" ) },
9117             );
9118             }
9119             }
9120              
9121 5 50       17 return @$ref if wantarray;
9122 5         14 return $ref;
9123             }
9124              
9125             sub _daemon_peer_svinfo {
9126 257     257   685 my $self = shift;
9127 257   50     1077 my $peer_id = shift || return;
9128 257         644 my $ref = [ ];
9129 257         971 my $args = [ @_ ];
9130 257         661 my $count = @$args;
9131             # SVINFO 6 6 0 :1525185763
9132 257 100 66     2020 if ( !( $args->[0] eq '6' && $args->[1] eq '6' ) ) {
9133 1         5 $self->_terminate_conn_error($peer_id, 'Incompatible TS version');
9134 1         3 return;
9135             }
9136 256         889 $self->{state}{conns}{$peer_id}{svinfo} = $args;
9137 256 50       1021 return @$ref if wantarray;
9138 256         688 return $ref;
9139             }
9140              
9141             sub _daemon_peer_ping {
9142 252     252   611 my $self = shift;
9143 252   50     1090 my $peer_id = shift || return;
9144 252         884 my $server = $self->server_name();
9145 252         875 my $sid = $self->server_sid();
9146 252         670 my $ref = [ ];
9147 252         627 my $prefix = shift;
9148 252         744 my $args = [ @_ ];
9149 252         712 my $count = @$args;
9150              
9151             SWITCH: {
9152 252 50       509 if (!$count) {
  252         1142  
9153 0         0 last SWITCH;
9154             }
9155 252 100 66     1600 if ($count >= 2 && $sid ne $args->[1]) {
9156 2 50       11 if ( $self->state_sid_exists($args->[1]) ) {
9157 2         21 $self->send_output(
9158             {
9159             prefix => $prefix,
9160             command => 'PING',
9161             params => $args,
9162             },
9163             $self->_state_sid_route($args->[1]),
9164             );
9165 2         8 last SWITCH;
9166             }
9167 0 0       0 if ( $self->state_uid_exists($args->[1]) ) {
9168 0         0 my $route_id = $self->_state_uid_route($args->[1]);
9169 0 0       0 if ( $args->[1] =~ m!^$sid! ) {
9170 0         0 $self->send_output(
9171             {
9172             prefix => $self->_state_sid_name($prefix),
9173             command => 'PING',
9174             params => [ $args->[0], $self->state_user_nick($args->[1]) ],
9175             },
9176             $route_id,
9177             );
9178             }
9179             else {
9180 0         0 $self->send_output(
9181             {
9182             prefix => $prefix,
9183             command => 'PING',
9184             params => $args,
9185             },
9186             $route_id,
9187             );
9188             }
9189             }
9190 0         0 last SWITCH;
9191             }
9192             $self->send_output(
9193             {
9194 250         2069 prefix => $sid,
9195             command => 'PONG',
9196             params => [$server, $args->[0]],
9197             },
9198             $peer_id,
9199             );
9200             }
9201              
9202 252 50       1312 return @$ref if wantarray;
9203 252         716 return $ref;
9204             }
9205              
9206             sub _daemon_peer_pong {
9207 3     3   9 my $self = shift;
9208 3   50     14 my $peer_id = shift || return;
9209 3         46 my $server = $self->server_name();
9210 3         11 my $sid = $self->server_sid();
9211 3         9 my $ref = [ ];
9212 3         10 my $prefix = shift;
9213 3         8 my $args = [ @_ ];
9214 3         9 my $count = @$args;
9215              
9216             SWITCH: {
9217 3 50       6 if (!$count) {
  3         11  
9218 0         0 last SWITCH;
9219             }
9220 3 50 33     25 if ($count >= 2 && uc $sid ne $args->[1]) {
9221 3 50       17 if ( $self->state_sid_exists($args->[1]) ) {
9222 0         0 $self->send_output(
9223             {
9224             prefix => $prefix,
9225             command => 'PONG',
9226             params => $args,
9227             },
9228             $self->_state_sid_route($args->[1]),
9229             );
9230 0         0 last SWITCH;
9231             }
9232 3 50       16 if ( $self->state_uid_exists($args->[1]) ) {
9233 3         16 my $route_id = $self->_state_uid_route($args->[1]);
9234 3 100       69 if ( $args->[1] =~ m!^$sid! ) {
9235 1         7 $self->send_output(
9236             {
9237             prefix => $self->_state_sid_name($prefix),
9238             command => 'PONG',
9239             params => [ $args->[0], $self->state_user_nick($args->[1]) ],
9240             },
9241             $route_id,
9242             );
9243             }
9244             else {
9245 2         20 $self->send_output(
9246             {
9247             prefix => $prefix,
9248             command => 'PONG',
9249             params => $args,
9250             },
9251             $route_id,
9252             );
9253             }
9254 3         16 last SWITCH;
9255             }
9256             }
9257 0         0 delete $self->{state}{conns}{$peer_id}{pinged};
9258             }
9259              
9260 3 50       12 return @$ref if wantarray;
9261 3         10 return $ref;
9262             }
9263              
9264             sub _daemon_peer_sid {
9265 131     131   396 my $self = shift;
9266 131   50     680 my $peer_id = shift || return;
9267 131   50     609 my $prefix = shift || return;
9268 131         627 my $server = $self->server_name();
9269 131         402 my $ref = [ ];
9270 131         503 my $args = [ @_ ];
9271 131         435 my $count = @$args;
9272 131         486 my $peer = $self->{state}{conns}{$peer_id}{name};
9273              
9274             # 0 1 2 3
9275             # :8H8 SID rhyg.dummy.net 2 0FU :ircd-hybrid test server
9276             # :0FU SID llestr.dummy.net 3 7UP :ircd-hybrid test server
9277              
9278             SWITCH: {
9279 131 50 33     344 if (!$count || $count < 2) {
  131         1190  
9280 0         0 last SWITCH;
9281             }
9282 131 50       2036 if ($args->[0] !~ $host_re) {
9283             $self->_send_to_realops(
9284             sprintf(
9285             'Link %s[unknown@%s] introduced server with bogus server name %s',
9286 0         0 $peer->{name}, $peer->{socket}[0], $args->[0],
9287             ), 'Notice', 's',
9288             );
9289 0         0 $self->_terminate_conn_error($peer_id, 'Bogus server name introduced');
9290 0         0 last SWITCH;
9291             }
9292 131 50       1088 if ($args->[2] !~ $sid_re) {
9293             $self->_send_to_realops(
9294             sprintf(
9295             'Link %s[unknown@%s] introduced server with bogus server ID %s',
9296 0         0 $peer->{name}, $peer->{socket}[0], $args->[2],
9297             ), 'Notice', 's',
9298             );
9299 0         0 $self->_terminate_conn_error($peer_id, 'Bogus server ID introduced');
9300 0         0 last SWITCH;
9301             }
9302 131 100       826 if ($self->state_sid_exists($args->[2])) {
9303 1         3 my $prec = $self->{state}{conns}{$peer_id};
9304             $self->_send_to_realops(
9305             sprintf(
9306             'Link %s[unknown@%s] cancelled, server ID %s already exists',
9307 1         17 $prec->{name}, $prec->{socket}[0], $args->[2],
9308             ), 'Notice', 's',
9309             );
9310 1         7 $self->_terminate_conn_error($peer_id, 'Link cancelled, server ID already exists');
9311 1         4 last SWITCH;
9312             }
9313 130 100       614 if ($self->state_peer_exists($args->[0])) {
9314 1         4 my $prec = $self->{state}{conns}{$peer_id};
9315             $self->_send_to_realops(
9316             sprintf(
9317             'Link %s[unknown@%s] cancelled, server %s already exists',
9318 1         18 $prec->{name}, $prec->{socket}[0], $args->[0],
9319             ), 'Notice', 's',
9320             );
9321 1         7 $self->_terminate_conn_error($peer_id, 'Server exists');
9322 1         4 last SWITCH;
9323             }
9324 129   50     1345 my $record = {
9325             name => $args->[0],
9326             hops => $args->[1],
9327             sid => $args->[2],
9328             desc => ( $args->[3] || '' ),
9329             route_id => $peer_id,
9330             type => 'r',
9331             psid => $prefix,
9332             peer => $self->_state_sid_name( $prefix ),
9333             peers => { },
9334             users => { },
9335             };
9336 129 100 66     1522 if ( $record->{desc} && $record->{desc} =~ m!^\(H\) ! ) {
9337 1         3 $record->{hidden} = 1;
9338 1         5 $record->{desc} =~ s!^\(H\) !!;
9339             }
9340 129         781 $self->{state}{sids}{ $prefix }{sids}{ $record->{sid} } = $record;
9341 129         492 $self->{state}{sids}{ $record->{sid} } = $record;
9342 129         501 my $uname = uc $record->{name};
9343 129 100       626 $record->{serv} = 1 if $self->{state}{services}{$uname};
9344 129         513 $self->{state}{peers}{$uname} = $record;
9345 129         634 $self->{state}{peers}{ uc $record->{peer} }{peers}{$uname} = $record;
9346             $self->send_output(
9347             {
9348             prefix => $prefix,
9349             command => 'SID',
9350             params => [
9351             $record->{name},
9352             $record->{hops} + 1,
9353             $record->{sid},
9354             ( $record->{hidden} ? '(H) ' : '' ) .
9355             $record->{desc},
9356             ],
9357             },
9358 129 100       1948 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  174         1109  
9359             );
9360             $self->_send_to_realops(
9361             sprintf(
9362             'Server %s being introduced by %s',
9363             $record->{name}, $record->{peer},
9364 129         1501 ),
9365             'Notice',
9366             'e',
9367             );
9368             $self->send_event(
9369             'daemon_sid',
9370             $record->{name},
9371             $prefix,
9372             $record->{hops},
9373             $record->{sid},
9374             $record->{desc},
9375 129         783 );
9376             $self->send_event(
9377             'daemon_server',
9378             $record->{name},
9379             $prefix,
9380             $record->{hops},
9381             $record->{desc},
9382 129         16364 );
9383             }
9384 131 50       15597 return @$ref if wantarray;
9385 131         504 return $ref;
9386             }
9387              
9388             sub _daemon_peer_quit {
9389 4     4   12 my $self = shift;
9390 4   50     16 my $uid = shift || return;
9391 4   50     14 my $qmsg = shift || 'Client Quit';
9392 4         10 my $conn_id = shift;
9393 4         8 my $ref = [ ];
9394 4         14 my $sid = $self->server_sid();
9395              
9396 4         12 my $record = delete $self->{state}{uids}{$uid};
9397 4 100       23 return $ref if !$record;
9398 2         9 my $full = $record->{full}->();
9399 2         13 my $nick = uc_irc($record->{nick});
9400 2         34 delete $self->{state}{users}{$nick};
9401 2         10 delete $self->{state}{sids}{ $record->{sid} }{users}{$nick};
9402 2         6 delete $self->{state}{sids}{ $record->{sid} }{uids}{$uid};
9403             $self->send_output(
9404             {
9405             prefix => $uid,
9406             command => 'QUIT',
9407             params => [$qmsg],
9408             },
9409 4 50       45 grep { !$conn_id || $_ ne $conn_id }
9410             $self->_state_connected_peers(),
9411 2 50       17 ) if !$record->{killed};
9412              
9413 2         13 push @$ref, {
9414             prefix => $full,
9415             command => 'QUIT',
9416             params => [$qmsg],
9417             };
9418              
9419             $self->_send_to_realops(
9420             sprintf(
9421             'Client exiting at %s: %s (%s@%s) [%s] [%s]',
9422             $record->{server}, $record->{nick}, $record->{auth}{ident},
9423 2         25 $record->{auth}{realhost}, $record->{ipaddress}, $qmsg,
9424             ),
9425             'Notice', 'F',
9426             );
9427              
9428 2         7 $self->send_event("daemon_quit", $full, $qmsg);
9429              
9430             # Remove for peoples accept lists
9431             delete $self->{state}{users}{$_}{accepts}{uc_irc($nick)}
9432 2         180 for keys %{ $record->{accepts} };
  2         15  
9433              
9434             # WATCH LOGOFF
9435 2 100       8 if ( defined $self->{state}{watches}{$nick} ) {
9436 1         3 my $laston = time();
9437 1         3 $self->{state}{watches}{$nick}{laston} = $laston;
9438 1         2 foreach my $wuid ( keys %{ $self->{state}{watches}{$nick}{uids} } ) {
  1         5  
9439 1 50       5 next if !defined $self->{state}{uids}{$wuid};
9440 1         2 my $wrec = $self->{state}{uids}{$wuid};
9441             $self->send_output(
9442             {
9443             prefix => $record->{server},
9444             command => '601',
9445             params => [
9446             $wrec->{nick},
9447             $record->{nick},
9448             $record->{auth}{ident},
9449             $record->{auth}{hostname},
9450             $laston,
9451             'logged offline',
9452             ],
9453             },
9454             $wrec->{route_id},
9455 1         8 );
9456             }
9457             }
9458             # Okay, all 'local' users who share a common channel with user.
9459 2         6 my $common = { };
9460 2         4 for my $uchan (keys %{ $record->{chans} }) {
  2         6  
9461 0         0 delete $self->{state}{chans}{$uchan}{users}{$uid};
9462 0         0 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  0         0  
9463 0 0       0 next if $user !~ m!^$sid!;
9464 0         0 $common->{$user} = $self->_state_uid_route($user);
9465             }
9466 0 0       0 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  0         0  
9467 0         0 delete $self->{state}{chans}{$uchan};
9468             }
9469             }
9470              
9471 2         6 push @$ref, $common->{$_} for keys %$common;
9472 2 50       8 $self->{state}{stats}{ops_online}-- if $record->{umode} =~ /o/;
9473 2 50       24 $self->{state}{stats}{invisible}-- if $record->{umode} =~ /i/;
9474 2         9 delete $self->{state}{peers}{uc $record->{server}}{users}{$nick};
9475 2         28 unshift @{ $self->{state}{whowas}{$nick} }, {
9476             logoff => time(),
9477             account => $record->{account},
9478             nick => $record->{nick},
9479             user => $record->{auth}{ident},
9480             host => $record->{auth}{hostname},
9481             real => $record->{auth}{realhost},
9482             sock => $record->{ipaddress},
9483             ircname => $record->{ircname},
9484             server => $record->{server},
9485 2         6 };
9486 2 50       6 return @$ref if wantarray;
9487 2         13 return $ref;
9488             }
9489              
9490             sub _daemon_peer_uid {
9491 554     554   1149 my $self = shift;
9492 554   50     1697 my $peer_id = shift || return;
9493 554         1092 my $prefix = shift;
9494 554         1455 my $server = $self->server_name();
9495 554         1366 my $mysid = $self->server_sid();
9496 554         1207 my $ref = [ ];
9497 554         2341 my $args = [ @_ ];
9498 554         1128 my $count = @$args;
9499 554   66     1695 my $rhost = ( $self->_state_our_capab('RHOST')
9500             && $self->_state_peer_capab( $peer_id, 'RHOST') );
9501              
9502              
9503             SWITCH: {
9504 554 50 33     1016 if (!$count || $count < 9) {
  554         2501  
9505 0         0 $self->_terminate_conn_error(
9506             $peer_id,
9507             'Not enough arguments to server command.',
9508             );
9509 0         0 last SWITCH;
9510             }
9511 554 100       1943 if ( $self->state_nick_exists( $args->[0] ) ) {
9512 12         60 my $unick = uc_irc($args->[0]);
9513 12         201 my $exist = $self->{state}{users}{ $unick };
9514 12         72 my $userhost = ( split /!/, $self->state_user_full($args->[0]) )[1];
9515 12         41 my $incoming = join '@', @{ $args }[4..5];
  12         46  
9516             # Received TS < Existing TS
9517 12 100       72 if ( $args->[2] < $exist->{ts} ) {
9518             # If userhosts different, collide existing user
9519 5 100       22 if ( $incoming ne $userhost ) {
9520             # Send KILL for existing user UID to all servers
9521 4         25 $exist->{nick_collision} = 1;
9522 4         26 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision' );
9523             }
9524             # If userhosts same, collide new user
9525             else {
9526             # Send KILL for new user UID back to sending peer
9527 1         9 $self->send_output(
9528             {
9529             prefix => $mysid,
9530             command => 'KILL',
9531             params => [$args->[7+$rhost], 'Nick Collision'],
9532             },
9533             $peer_id,
9534             );
9535 1         4 last SWITCH;
9536             }
9537             }
9538             # Received TS == Existing TS
9539 11 100       47 if ( $args->[2] == $exist->{ts} ) {
9540             # Collide both
9541 1         3 $exist->{nick_collision} = 1;
9542 1         8 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision', $peer_id);
9543 1         8 $self->send_output(
9544             {
9545             prefix => $mysid,
9546             command => 'KILL',
9547             params => [$args->[7+$rhost], 'Nick Collision'],
9548             },
9549             $peer_id,
9550             );
9551 1         5 last SWITCH;
9552             }
9553             # Received TS > Existing TS
9554 10 100       62 if ( $args->[2] > $exist->{ts} ) {
9555             # If userhosts same, collide existing user
9556 6 100       43 if ( $incoming eq $userhost ) {
9557             # Send KILL for existing user UID to all servers
9558 1         4 $exist->{nick_collision} = 1;
9559 1         7 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision' );
9560             }
9561             # If userhosts different, collide new user, drop message
9562             else {
9563             # Send KILL for new user UID back to sending peer
9564 5         52 $self->send_output(
9565             {
9566             prefix => $mysid,
9567             command => 'KILL',
9568             params => [$args->[7+$rhost], 'Nick Collision'],
9569             },
9570             $peer_id,
9571             );
9572 5         22 last SWITCH;
9573             }
9574             }
9575             #last SWITCH;
9576             }
9577              
9578             # check if we have RHOST set and they do, if so then there will be 11 args not 10
9579              
9580 547   50     1802 my $record = {
9581             server => $self->_state_sid_name( $prefix ),
9582             type => 'r',
9583             route_id => $peer_id,
9584             sid => $prefix,
9585             nick => $args->[0],
9586             hops => $args->[1],
9587             ts => $args->[2],
9588             umode => $args->[3],
9589             auth => {
9590             ident => $args->[4],
9591             hostname => $args->[5],
9592             },
9593             ipaddress => $args->[6+$rhost],
9594             uid => $args->[7+$rhost],
9595             account => $args->[8+$rhost],
9596             ircname => ( $args->[9+$rhost] || '' ),
9597             };
9598              
9599             $record->{full} = sub {
9600             return sprintf('%s!%s@%s',
9601             $record->{nick},
9602             $record->{auth}{ident},
9603 2554     2554   21926 $record->{auth}{hostname});
9604 547         3535 };
9605              
9606 547 100       1606 if ( $rhost ) {
9607 3         12 $record->{auth}{realhost} = $args->[6];
9608             }
9609             else {
9610 544         1528 $record->{auth}{realhost} = $record->{auth}{hostname};
9611             }
9612              
9613 547         1757 my $unick = uc_irc( $args->[0] );
9614              
9615 547         7504 $self->{state}{users}{ $unick } = $record;
9616 547         1846 $self->{state}{uids}{ $record->{uid} } = $record;
9617 547 100       2577 $self->{state}{stats}{ops_online}++ if $record->{umode} =~ /o/;
9618 547 50       2213 $self->{state}{stats}{invisible}++ if $record->{umode} =~ /i/;
9619 547         1578 $self->{state}{sids}{$prefix}{users}{$unick} = $record;
9620 547         1651 $self->{state}{sids}{$prefix}{uids}{ $record->{uid} } = $record;
9621 547         2036 $self->_state_update_stats();
9622              
9623 547 100       1797 if ( defined $self->{state}{watches}{$unick} ) {
9624 1         2 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         7  
9625 1 50       4 next if !defined $self->{state}{uids}{$wuid};
9626 1         3 my $wrec = $self->{state}{uids}{$wuid};
9627             $self->send_output(
9628             {
9629             prefix => $server,
9630             command => '600',
9631             params => [
9632             $wrec->{nick},
9633             $record->{nick},
9634             $record->{auth}{ident},
9635             $record->{auth}{hostname},
9636             $record->{ts},
9637             'logged online',
9638             ],
9639             },
9640             $wrec->{route_id},
9641 1         11 );
9642             }
9643             }
9644              
9645             $self->send_output(
9646             {
9647             prefix => $prefix,
9648             command => 'UID',
9649             params => $args,
9650             },
9651 547         3032 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  813         3450  
9652             );
9653              
9654             $self->_send_to_realops(
9655             sprintf(
9656             'Client connecting at %s: %s (%s@%s) [%s] [%s] <%s>',
9657             $record->{server}, $record->{nick}, $record->{auth}{ident},
9658             $record->{auth}{realhost}, $record->{ipaddress},
9659             $record->{ircname}, $record->{uid},
9660 547         5579 ),
9661             'Notice', 'F',
9662             );
9663              
9664 547         2198 $self->send_event('daemon_uid', $prefix, @$args);
9665 547   50     78145 $self->send_event('daemon_nick', @{ $args }[0..5], $record->{server}, ( $args->[9+$rhost] || '' ) );
  547         2914  
9666              
9667             }
9668              
9669 554 50       73206 return @$ref if wantarray;
9670 554         1808 return $ref;
9671             }
9672              
9673             sub _daemon_peer_nick {
9674 2     2   6 my $self = shift;
9675 2   50     7 my $peer_id = shift || return;
9676 2         5 my $prefix = shift;
9677 2         5 my $mysid = $self->server_sid();
9678 2         5 my $ref = [ ];
9679 2         6 my $args = [ @_ ];
9680 2         4 my $count = @$args;
9681 2         7 my $peer = $self->{state}{conns}{$peer_id}{name};
9682 2         9 my $nicklen = $self->server_config('NICKLEN');
9683              
9684             SWITCH: {
9685 2 50 33     5 if (!$count || $count < 2) {
  2         11  
9686 0         0 last SWITCH;
9687             }
9688 2 50       10 if ( !$self->state_uid_exists( $prefix ) ) {
9689 0         0 last SWITCH;
9690             }
9691 2         6 my $newts = $args->[1];
9692 2 50 33     9 if ( $self->state_nick_exists($args->[0]) && $prefix ne $self->state_user_uid($args->[0]) ) {
9693 0         0 my $unick = uc_irc($args->[0]);
9694 0         0 my $exist = $self->{state}{users}{ $unick };
9695 0         0 my $userhost = ( split /!/, $self->state_user_full($args->[0]) )[1];
9696 0         0 my $incoming = ( split /!/, $self->state_user_full($prefix) )[1];
9697             # Received TS < Existing TS
9698 0 0       0 if ( $newts < $exist->{ts} ) {
9699             # If userhosts different, collide existing user
9700 0 0       0 if ( $incoming ne $userhost ) {
9701             # Send KILL for existing user UID to all servers
9702 0         0 $exist->{nick_collision} = 1;
9703 0         0 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision' );
9704             }
9705             # If userhosts same, collide new user
9706             else {
9707             # Send KILL for new user UID back to sending peer
9708 0         0 $self->send_output(
9709             {
9710             prefix => $mysid,
9711             command => 'KILL',
9712             params => [$prefix, 'Nick Collision'],
9713             },
9714             $peer_id,
9715             );
9716 0         0 last SWITCH;
9717             }
9718             }
9719             # Received TS == Existing TS
9720 0 0       0 if ( $args->[2] == $exist->{ts} ) {
9721             # Collide both
9722 0         0 $exist->{nick_collision} = 1;
9723 0         0 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision', $peer_id);
9724 0         0 $self->send_output(
9725             {
9726             prefix => $mysid,
9727             command => 'KILL',
9728             params => [$prefix, 'Nick Collision'],
9729             },
9730             $peer_id,
9731             );
9732 0         0 last SWITCH;
9733             }
9734             # Received TS > Existing TS
9735 0 0       0 if ( $newts > $exist->{ts} ) {
9736             # If userhosts same, collide existing user
9737 0 0       0 if ( $incoming eq $userhost ) {
9738             # Send KILL for existing user UID to all servers
9739 0         0 $exist->{nick_collision} = 1;
9740 0         0 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision' );
9741             }
9742             # If userhosts different, collide new user, drop message
9743             else {
9744             # Send KILL for new user UID back to sending peer
9745 0         0 $self->send_output(
9746             {
9747             prefix => $mysid,
9748             command => 'KILL',
9749             params => [$prefix, 'Nick Collision'],
9750             },
9751             $peer_id,
9752             );
9753 0         0 last SWITCH;
9754             }
9755             }
9756             #last SWITCH;
9757             }
9758              
9759 2         6 my $new = $args->[0];
9760 2         6 my $unew = uc_irc($new);
9761 2   33     24 my $ts = $args->[1] || time;
9762 2         5 my $record = $self->{state}{uids}{$prefix};
9763 2         6 my $unick = uc_irc($record->{nick});
9764 2         21 my $sid = $record->{sid};
9765 2         5 my $full = $record->{full}->();
9766              
9767 2 50       8 if ($unick eq $unew) {
9768 0         0 $record->{nick} = $new;
9769 0         0 $record->{ts} = $ts;
9770             }
9771             else {
9772 2         4 my $nick = $record->{nick};
9773 2         4 $record->{nick} = $new;
9774 2         29 $record->{ts} = $ts;
9775             # Remove from peoples accept lists
9776             # WATCH OFF
9777 2 100       9 if ( defined $self->{state}{watches}{$unick} ) {
9778 1         2 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         5  
9779 1 50       5 next if !defined $self->{state}{uids}{$wuid};
9780 1         3 my $wrec = $self->{state}{uids}{$wuid};
9781 1         2 my $laston = time();
9782 1         3 $self->{state}{watches}{$unick}{laston} = $laston;
9783             $self->send_output(
9784             {
9785             prefix => $record->{server},
9786             command => '605',
9787             params => [
9788             $wrec->{nick},
9789             $nick,
9790             $record->{auth}{ident},
9791             $record->{auth}{hostname},
9792             $laston,
9793             'is offline',
9794             ],
9795             },
9796             $wrec->{route_id},
9797 1         10 );
9798             }
9799             }
9800 2 100       7 if ( defined $self->{state}{watches}{$unew} ) {
9801 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$unew}{uids} } ) {
  1         7  
9802 1 50       4 next if !defined $self->{state}{uids}{$wuid};
9803 1         2 my $wrec = $self->{state}{uids}{$wuid};
9804             $self->send_output(
9805             {
9806             prefix => $record->{server},
9807             command => '604',
9808             params => [
9809             $wrec->{nick},
9810             $record->{nick},
9811             $record->{auth}{ident},
9812             $record->{auth}{hostname},
9813             $record->{ts},
9814             'is online',
9815             ],
9816             },
9817             $wrec->{route_id},
9818 1         13 );
9819             }
9820             }
9821             delete $self->{state}{users}{$_}{accepts}{$unick}
9822 2         3 for keys %{ $record->{accepts} };
  2         8  
9823 2         7 delete $record->{accepts};
9824 2         4 delete $self->{state}{users}{$unick};
9825 2         6 $self->{state}{users}{$unew} = $record;
9826 2         8 delete $self->{state}{sids}{$sid}{users}{$unick};
9827 2         6 $self->{state}{sids}{$sid}{users}{$unew} = $record;
9828 2 50       7 if ( $record->{umode} =~ /r/ ) {
9829 0         0 $record->{umode} =~ s/r//g;
9830             }
9831 2         29 unshift @{ $self->{state}{whowas}{$unick} }, {
9832             logoff => time(),
9833             account => $record->{account},
9834             nick => $nick,
9835             user => $record->{auth}{ident},
9836             host => $record->{auth}{hostname},
9837             real => $record->{auth}{realhost},
9838             sock => $record->{ipaddress},
9839             ircname => $record->{ircname},
9840             server => $record->{server},
9841 2         4 };
9842             }
9843 2         5 my $common = { };
9844 2         4 for my $chan (keys %{ $record->{chans} }) {
  2         8  
9845 0         0 for my $user ( keys %{ $self->{state}{chans}{uc_irc $chan}{users} } ) {
  0         0  
9846 0 0       0 next if $user !~ m!^$mysid!;
9847 0         0 $common->{$user} = $self->_state_uid_route($user);
9848             }
9849             }
9850             {
9851 2         3 my ($nick,$userhost) = split /!/, $full;
  2         8  
9852 2         25 $self->_send_to_realops(
9853             sprintf(
9854             'Nick change: From %s to %s [%s]',
9855             $nick, $new, $userhost,
9856             ),
9857             'Notice',
9858             'n',
9859             );
9860             }
9861             $self->send_output(
9862             {
9863             prefix => $prefix,
9864             command => 'NICK',
9865             params => $args,
9866             },
9867 2         12 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  4         20  
9868             );
9869             $self->send_output(
9870             {
9871             prefix => $full,
9872             command => 'NICK',
9873             params => [$new],
9874             },
9875 2         10 map{ $common->{$_} } keys %{ $common },
  0         0  
  2         9  
9876             );
9877 2         9 $self->send_event("daemon_nick", $full, $new);
9878             }
9879              
9880 2 50       206 return @$ref if wantarray;
9881 2         5 return $ref;
9882             }
9883              
9884             sub _daemon_peer_part {
9885 1     1   4 my $self = shift;
9886 1   50     4 my $peer_id = shift || return;
9887 1   50     4 my $uid = shift || return;
9888 1         3 my $chan = shift;
9889 1         2 my $ref = [ ];
9890 1         3 my $args = [ @_ ];
9891 1         2 my $count = @$args;
9892              
9893             SWITCH: {
9894 1 50       1 if (!$chan) {
  1         5  
9895 0         0 last SWITCH;
9896             }
9897 1 50       4 if (!$self->state_chan_exists($chan)) {
9898 0         0 last SWITCH;
9899             }
9900 1 50       6 if (!$self->state_uid_chan_member($uid, $chan)) {
9901 0         0 last SWITCH;
9902             }
9903             $self->send_output(
9904             {
9905             prefix => $uid,
9906             command => 'PART',
9907             params => [$chan, ($args->[0] || '')],
9908             },
9909 1   50     21 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  2         8  
9910             );
9911 1   50     40 $self->_send_output_channel_local(
9912             $chan, {
9913             prefix => $self->state_user_full($uid),
9914             command => 'PART',
9915             params => [$chan, ($args->[0] || '')],
9916             },
9917             );
9918 1         5 my $uchan = uc_irc($chan);
9919 1         14 delete $self->{state}{chans}{$uchan}{users}{$uid};
9920 1         4 delete $self->{state}{uids}{$uid}{chans}{$uchan};
9921 1 50       2 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  1         5  
9922 0         0 delete $self->{state}{chans}{$uchan};
9923             }
9924             }
9925              
9926 1 50       3 return @$ref if wantarray;
9927 1         3 return $ref;
9928             }
9929              
9930             sub _daemon_peer_kick {
9931 1     1   3 my $self = shift;
9932 1   50     5 my $peer_id = shift || return;
9933 1   50     5 my $uid = shift || return;
9934 1         3 my $ref = [ ];
9935 1         3 my $args = [ @_ ];
9936 1         3 my $count = @$args;
9937              
9938             SWITCH: {
9939 1 50 33     16 if (!$count || $count < 2) {
  1         11  
9940 0         0 last SWITCH;
9941             }
9942 1         7 my $chan = (split /,/, $args->[0])[0];
9943 1         7 my $wuid = (split /,/, $args->[1])[0];
9944 1 50       6 if (!$self->state_chan_exists($chan)) {
9945 0         0 last SWITCH;
9946             }
9947 1 50       7 if ( !$self->state_uid_exists($wuid)) {
9948 0         0 last SWITCH;
9949             }
9950 1 50       23 if (!$self->state_uid_chan_member($wuid, $chan)) {
9951 0         0 last SWITCH;
9952             }
9953 1         18 my $who = $self->state_user_nick($wuid);
9954 1   33     5 my $comment = $args->[2] || $who;
9955             $self->send_output(
9956             {
9957             prefix => $uid,
9958             command => 'KICK',
9959             params => [$chan, $wuid, $comment],
9960             },
9961 1         22 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  2         12  
9962             );
9963 1         9 $self->_send_output_channel_local(
9964             $chan, {
9965             prefix => $self->state_user_full($uid),
9966             command => 'KICK',
9967             params => [$chan, $who, $comment],
9968             },
9969             );
9970 1         6 my $uchan = uc_irc($chan);
9971 1         16 delete $self->{state}{chans}{$uchan}{users}{$wuid};
9972 1         26 delete $self->{state}{uids}{$wuid}{chans}{$uchan};
9973 1 50       3 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  1         7  
9974 0         0 delete $self->{state}{chans}{$uchan};
9975             }
9976             }
9977              
9978 1 50       5 return @$ref if wantarray;
9979 1         4 return $ref;
9980             }
9981              
9982             sub _daemon_peer_sjoin {
9983 125     125   315 my $self = shift;
9984 125         257 my $peer_id = shift;
9985 125         544 $self->_daemon_do_joins( $peer_id, 'SJOIN', @_ );
9986             }
9987              
9988             sub _daemon_peer_join {
9989 1     1   2 my $self = shift;
9990 1         3 my $peer_id = shift;
9991 1         6 $self->_daemon_do_joins( $peer_id, 'JOIN', @_ );
9992             }
9993              
9994             sub _daemon_do_joins {
9995 126     126   314 my $self = shift;
9996 126   50     481 my $peer_id = shift || return;
9997 126         282 my $cmd = shift;
9998 126         286 my $prefix = shift;
9999 126         295 my $ref = [ ];
10000 126         414 my $args = [ @_ ];
10001 126         321 my $count = @$args;
10002 126         420 my $server = $self->server_name();
10003              
10004             # We have to handle either SJOIN or JOIN
10005             # : SJOIN + :
10006             # : JOIN +
10007              
10008             SWITCH: {
10009 126 50 33     259 if ($cmd eq 'SJOIN' && ( !$count || $count < 4) ) {
  126   66     1062  
10010 0         0 last SWITCH;
10011             }
10012 126 50 33     437 if ($cmd eq 'JOIN' && ( !$count || $count < 3) ) {
      66        
10013 0         0 last SWITCH;
10014             }
10015 126         316 my $ts = $args->[0];
10016 126         268 my $chan = $args->[1];
10017 126         223 my $uids;
10018 126 100       422 if ( $cmd eq 'JOIN' ) {
10019 1         3 $uids = $prefix;
10020             }
10021             else {
10022 125         244 $uids = pop @{ $args };
  125         281  
10023             }
10024 126 100       492 if (!$self->state_chan_exists($chan)) {
10025 50         1026 my $chanrec = { name => $chan, ts => $ts };
10026 50         472 my @args = @{ $args }[2..$#{ $args }];
  50         151  
  50         126  
10027 50         121 my $cmode = shift @args;
10028 50         231 $cmode =~ s/^\+//g;
10029 50         180 $chanrec->{mode} = $cmode;
10030 50         221 for my $mode (split //, $cmode) {
10031 108         181 my $arg;
10032 108 100       308 $arg = shift @args if $mode =~ /[lk]/;
10033 108 100       241 $chanrec->{climit} = $arg if $mode eq 'l';
10034 108 50       309 $chanrec->{ckey} = $arg if $mode eq 'k';
10035             }
10036 50         143 push @$args, $uids;
10037 50         222 my $uchan = uc_irc($chanrec->{name});
10038 50         989 for my $uid (split /\s+/, $uids) {
10039 733         1277 my $umode = '';
10040 733 100       2118 $umode .= 'o' if $uid =~ s/\@//g;
10041 733 50       1478 $umode .= 'h' if $uid =~ s/\%//g;
10042 733 50       1454 $umode .= 'v' if $uid =~ s/\+//g;
10043 733         2056 $chanrec->{users}{$uid} = $umode;
10044 733         2610 $self->{state}{uids}{$uid}{chans}{$uchan} = $umode;
10045              
10046 733         1801 $self->send_event(
10047             'daemon_join',
10048             $self->state_user_full($uid),
10049             $chan,
10050             );
10051 733 100       109344 $self->send_event(
10052             'daemon_mode',
10053             $server,
10054             $chan,
10055             '+' . $umode,
10056             $self->state_user_nick($uid),
10057             ) if $umode;
10058             }
10059 50         2650 $self->{state}{chans}{$uchan} = $chanrec;
10060             $self->send_output(
10061             {
10062             prefix => $prefix,
10063             command => $cmd,
10064             params => $args,
10065             },
10066 50         333 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  53         355  
10067             );
10068 50         256 last SWITCH;
10069             }
10070              
10071             # :8H8 SJOIN 1526826863 #ooby +cmntlk 699 secret :@7UPAAAAAA
10072              
10073 76         264 my $chanrec = $self->{state}{chans}{uc_irc($chan)};
10074 76         1010 my @local_users; my @local_extjoin; my @local_nextjoin;
  76         0  
10075             {
10076 76         178 my @tmp_users =
10077 3266         5958 grep { $self->_state_is_local_uid($_) }
10078 76         161 keys %{ $chanrec->{users} };
  76         1366  
10079              
10080 0         0 @local_extjoin = map { $self->_state_uid_route($_) }
10081 76         415 grep { $self->{state}{uids}{$_}{caps}{'extended-join'} }
  24         93  
10082             @tmp_users;
10083              
10084 24         97 @local_nextjoin = map { $self->_state_uid_route($_) }
10085 76         190 grep { !$self->{state}{uids}{$_}{caps}{'extended-join'} }
  24         86  
10086             @tmp_users;
10087              
10088 76         287 @local_users = ( @local_extjoin, @local_nextjoin );
10089              
10090             }
10091             # If the TS received is lower than our TS of the channel a TS6 server must
10092             # remove status modes (+ov etc) and channel modes (+nt etc). If the
10093             # originating server is TS6 capable (ie, it has a SID), the server must
10094             # also remove any ban modes (+b etc). The new modes and statuses are then
10095             # accepted.
10096              
10097 76 100       585 if ( $ts < $chanrec->{ts} ) {
    100          
10098 4         12 my @deop;
10099             my @deop_list;
10100 4         10 my $common = { };
10101              
10102             # Remove all +ovh
10103 4         11 for my $user (keys %{ $chanrec->{users} }) {
  4         17  
10104 7 100       32 $common->{$user} = $self->_state_uid_route($user)
10105             if $self->_state_is_local_uid($user);
10106 7 100       29 next if !$chanrec->{users}{$user};
10107 4         11 my $current = $chanrec->{users}{$user};
10108 4         17 my $proper = $self->state_user_nick($user);
10109 4         13 $chanrec->{users}{$user} = '';
10110 4         22 $self->{state}{uids}{$user}{chans}{uc_irc($chanrec->{name})} = '';
10111 4         59 push @deop, "-$current";
10112 4         43 push @deop_list, $proper for split //, $current;
10113             }
10114              
10115 4 50 33     44 if (keys %$common && @deop) {
10116             $self->send_event(
10117             "daemon_mode",
10118             $server,
10119             $chanrec->{name},
10120 4         34 unparse_mode_line(join '', @deop),
10121             @deop_list,
10122             );
10123 4         654 my @output_modes;
10124 4         15 my $length = length($server) + 4
10125             + length($chan) + 4;
10126 4         14 my @buffer = ('', '');
10127 4         20 for my $deop (@deop) {
10128 4         10 my $arg = shift @deop_list;
10129 4         20 my $mode_line = unparse_mode_line($buffer[0].$deop);
10130 4 50       148 if (length(join ' ', $mode_line, $buffer[1],
10131             $arg) + $length > 510) {
10132             push @output_modes, {
10133             prefix => $server,
10134             command => 'MODE',
10135             colonify => 0,
10136             params => [
10137             $chanrec->{name},
10138 0         0 $buffer[0],
10139             split /\s+/,
10140             $buffer[1],
10141             ],
10142             };
10143 0         0 $buffer[0] = $deop;
10144 0         0 $buffer[1] = $arg;
10145 0         0 next;
10146             }
10147 4         14 $buffer[0] = $mode_line;
10148 4 50       16 if ($buffer[1]) {
10149 0         0 $buffer[1] = join ' ', $buffer[1], $arg;
10150             }
10151             else {
10152 4         14 $buffer[1] = $arg;
10153             }
10154             }
10155             push @output_modes, {
10156             prefix => $server,
10157             command => 'MODE',
10158             colonify => 0,
10159             params => [
10160             $chanrec->{name},
10161 4         46 $buffer[0],
10162             split /\s+/, $buffer[1],
10163             ],
10164             };
10165             $self->send_output($_, values %$common)
10166 4         48 for @output_modes;
10167             }
10168              
10169             # Remove all +beI modes
10170 4 50       20 if ( $cmd eq 'SJOIN' ) {
10171 4         32 my $tmap = { bans => 'b', excepts => 'e', invex => 'I' };
10172 4         13 my @types; my @mask_list;
10173 4         13 foreach my $type ( qw[bans excepts invex] ) {
10174 12 100       46 next if !$chanrec->{$type};
10175 9         16 foreach my $umask ( keys %{ $chanrec->{$type} } ) {
  9         23  
10176 0         0 my $rec = delete $chanrec->{$type}{$umask};
10177 0         0 push @types, '-' . $tmap->{$type};
10178 0         0 push @mask_list, $rec->[0];
10179             }
10180             }
10181             $self->send_event(
10182             "daemon_mode",
10183             $server,
10184             $chanrec->{name},
10185 4         28 unparse_mode_line(join '', @types),
10186             @mask_list,
10187             );
10188 4 50 33     532 if ( @local_users && @types ) {
10189 0         0 my @output_modes;
10190 0         0 my $length = length($server) + 4
10191             + length($chan) + 4;
10192 0         0 my @buffer = ('', '');
10193 0         0 for my $type (@types) {
10194 0         0 my $arg = shift @mask_list;
10195 0         0 my $mode_line = unparse_mode_line($buffer[0].$type);
10196 0 0       0 if (length(join ' ', $mode_line, $buffer[1],
10197             $arg) + $length > 510) {
10198             push @output_modes, {
10199             prefix => $server,
10200             command => 'MODE',
10201             colonify => 0,
10202             params => [
10203             $chanrec->{name},
10204 0         0 $buffer[0],
10205             split /\s+/,
10206             $buffer[1],
10207             ],
10208             };
10209 0         0 $buffer[0] = $type;
10210 0         0 $buffer[1] = $arg;
10211 0         0 next;
10212             }
10213 0         0 $buffer[0] = $mode_line;
10214 0 0       0 if ($buffer[1]) {
10215 0         0 $buffer[1] = join ' ', $buffer[1], $arg;
10216             }
10217             else {
10218 0         0 $buffer[1] = $arg;
10219             }
10220             }
10221             push @output_modes, {
10222             prefix => $server,
10223             command => 'MODE',
10224             colonify => 0,
10225             params => [
10226             $chanrec->{name},
10227 0         0 $buffer[0],
10228             split /\s+/, $buffer[1],
10229             ],
10230             };
10231             $self->send_output($_, @local_users)
10232 0         0 for @output_modes;
10233             }
10234             }
10235              
10236             # Remove TOPIC
10237 4 100       21 if ( $chanrec->{topic} ) {
10238 1         3 delete $chanrec->{topic};
10239 1         6 $self->send_output(
10240             {
10241             prefix => $server,
10242             command => 'TOPIC',
10243             params => [$chan, ''],
10244             },
10245             @local_users,
10246             );
10247             }
10248             # Set TS to incoming TS and send NOTICE
10249             $self->send_output(
10250             {
10251             prefix => $server,
10252             command => 'NOTICE',
10253             params => [
10254             $chanrec->{name},
10255             "*** Notice -- TS for " . $chanrec->{name}
10256             . " changed from " . $chanrec->{ts}
10257 4         69 . " to $ts",
10258             ],
10259             },
10260             @local_users,
10261             );
10262 4         14 $chanrec->{ts} = $ts;
10263             # Remove invites
10264 4   50     36 my $invites = delete $chanrec->{invites} || {};
10265 4         10 foreach my $invite ( keys %{ $invites } ) {
  4         14  
10266 0 0       0 next unless $self->state_uid_exists( $invite );
10267 0 0       0 next unless $self->_state_is_local_uid( $invite );
10268 0         0 delete $self->{state}{uids}{$invite}{invites}{uc_irc $chanrec->{name}};
10269             }
10270             # Remove channel modes and apply incoming modes
10271 4         14 my $origmode = $chanrec->{mode};
10272 4         11 my @args = @{ $args }[2..$#{ $args }];
  4         15  
  4         19  
10273 4         11 my $chanmode = shift @args;
10274 4         10 my $reply = '';
10275 4         10 my @reply_args;
10276 4         27 for my $mode (grep { $_ ne '+' } split //, $chanmode) {
  12         33  
10277 8         16 my $arg;
10278 8 50       33 $arg = shift @args if $mode =~ /[lk]/;
10279 8 50 0     216 if ($mode eq 'l' && ($chanrec->{mode} !~ /l/
    50 33        
    50 0        
      33        
10280             || $arg ne $chanrec->{climit})) {
10281 0         0 $reply .= '+' . $mode;
10282 0         0 push @reply_args, $arg;
10283 0 0       0 if ($chanrec->{mode} !~ /$mode/) {
10284 0         0 $chanrec->{mode} .= $mode;
10285             }
10286             $chanrec->{mode} = join '', sort split //,
10287 0         0 $chanrec->{mode};
10288 0         0 $chanrec->{climit} = $arg;
10289             }
10290             elsif ($mode eq 'k' && ($chanrec->{mode} !~ /k/
10291             || $arg ne $chanrec->{ckey})) {
10292 0         0 $reply .= '+' . $mode;
10293 0         0 push @reply_args, $arg;
10294 0 0       0 if ($chanrec->{mode} !~ /$mode/) {
10295 0         0 $chanrec->{mode} .= $mode;
10296             }
10297             $chanrec->{mode} = join '', sort split //,
10298 0         0 $chanrec->{mode};
10299 0         0 $chanrec->{ckey} = $arg;
10300             }
10301             elsif ($chanrec->{mode} !~ /$mode/) {
10302 0         0 $reply .= '+' . $mode;
10303             $chanrec->{mode} = join '', sort split //,
10304 0         0 $chanrec->{mode};
10305             }
10306             }
10307 4   50     37 $origmode = join '', grep { $chanmode !~ /$_/ }
  8         75  
10308             split //, ($origmode || '');
10309 4 50       20 $chanrec->{mode} =~ s/[$origmode]//g if $origmode;
10310 4 50       113 $reply = '-' . $origmode . $reply if $origmode;
10311 4 50 33     34 if ($origmode && $origmode =~ /k/) {
10312 0         0 unshift @reply_args, '*';
10313 0         0 delete $chanrec->{ckey};
10314             }
10315 4 50 33     17 if ($origmode and $origmode =~ /l/) {
10316 0         0 delete $chanrec->{climit};
10317             }
10318             $self->send_output(
10319             {
10320             prefix => $server,
10321             command => 'MODE',
10322             colonify => 0,
10323             params => [
10324             $chanrec->{name},
10325 4 50       26 unparse_mode_line($reply),
10326             @reply_args,
10327             ],
10328             },
10329             @local_users,
10330             ) if $reply;
10331             # Take incomers and announce +ovh
10332             # Actually do it later
10333             }
10334              
10335             # If the TS received is equal to our TS of the channel the server should keep
10336             # its current modes and accept the received modes and statuses.
10337              
10338             elsif ( $ts == $chanrec->{ts} ) {
10339             # Have to merge chanmodes
10340 67         237 my $origmode = $chanrec->{mode};
10341 67         164 my @args = @{ $args }[2..$#{ $args }];
  67         208  
  67         191  
10342 67         179 my $chanmode = shift @args;
10343 67         182 my $reply = '';
10344 67         132 my @reply_args;
10345 67         330 for my $mode (grep { $_ ne '+' } split //, $chanmode) {
  206         572  
10346 139         273 my $arg;
10347 139 100       443 $arg = shift @args if $mode =~ /[lk]/;
10348 139 50 33     2872 if ($mode eq 'l' && ($chanrec->{mode} !~ /l/
    50 66        
    50 0        
      33        
10349             || $arg > $chanrec->{climit})) {
10350 0         0 $reply .= '+' . $mode;
10351 0         0 push @reply_args, $arg;
10352 0 0       0 if ($chanrec->{mode} !~ /$mode/) {
10353 0         0 $chanrec->{mode} .= $mode;
10354             }
10355             $chanrec->{mode} = join '', sort split //,
10356 0         0 $chanrec->{mode};
10357 0         0 $chanrec->{climit} = $arg;
10358             }
10359             elsif ($mode eq 'k' && ($chanrec->{mode} !~ /k/
10360             || ($arg cmp $chanrec->{ckey}) > 0 )) {
10361 0         0 $reply .= '+' . $mode;
10362 0         0 push @reply_args, $arg;
10363 0 0       0 if ($chanrec->{mode} !~ /$mode/) {
10364 0         0 $chanrec->{mode} .= $mode;
10365             }
10366             $chanrec->{mode} = join '', sort split //,
10367 0         0 $chanrec->{mode};
10368 0         0 $chanrec->{ckey} = $arg;
10369             }
10370             elsif ($chanrec->{mode} !~ /$mode/) {
10371 0         0 $reply .= '+' . $mode;
10372             $chanrec->{mode} = join '', sort split //,
10373 0         0 $chanrec->{mode};
10374             }
10375             }
10376             $self->send_output(
10377             {
10378             prefix => $server,
10379             command => 'MODE',
10380             colonify => 0,
10381             params => [
10382             $chanrec->{name},
10383 67 50       290 unparse_mode_line($reply),
10384             @reply_args,
10385             ],
10386             },
10387             @local_users,
10388             ) if $reply;
10389             }
10390              
10391             # If the TS received is higher than our TS of the channel the server should keep
10392             # its current modes and ignore the received modes and statuses. Any statuses
10393             # given in the received message will be removed.
10394              
10395             else {
10396 5         44 $uids = join ' ', map { my $s = $_; $s =~ s/[@%+]//g; $s; }
  5         14  
  5         25  
  5         23  
10397             split /\s+/, $uids;
10398             }
10399             # Send it on
10400             $self->send_output(
10401             {
10402             prefix => $prefix,
10403             command => $cmd,
10404             params => [ @$args, $uids ]
10405             },
10406 76         961 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  130         689  
10407             );
10408             # Joins and modes for new arrivals
10409 76         436 my $uchan = uc_irc($chanrec->{name});
10410 76         1511 my $modes;
10411             my @aways;
10412 76         0 my @mode_parms;
10413 76         980 for my $uid (split /\s+/, $uids) {
10414 1273         2258 my $umode = '';
10415 1273         1943 my @op_list;
10416 1273 100       3591 $umode .= 'o' if $uid =~ s/\@//g;
10417 1273 50       2581 $umode .= 'h' if $uid =~ s/\%//g;
10418 1273 50       2525 $umode .= 'v' if $uid =~ s/\+//g;
10419 1273 100       3643 next if !defined $self->{state}{uids}{$uid};
10420 1258         4876 $chanrec->{users}{$uid} = $umode;
10421 1258         4298 $self->{state}{uids}{$uid}{chans}{$uchan} = $umode;
10422 1258         3213 push @op_list, $self->state_user_nick($uid) for split //, $umode;
10423 1258         3101 my $full = $self->state_user_full($uid);
10424 1258 100       3036 if ( @local_nextjoin ) {
10425             my $output = {
10426             prefix => $full,
10427             command => 'JOIN',
10428 20         96 params => [$chanrec->{name}],
10429             };
10430 20         87 $self->send_output($output, @local_nextjoin);
10431             }
10432 1258 50       2466 if ( @local_extjoin ) {
10433             my $extout = {
10434             prefix => $full,
10435             command => 'JOIN',
10436             params => [
10437             $chanrec->{name},
10438             $self->{state}{uids}{$uid}{account},
10439             $self->{state}{uids}{$uid}{ircname},
10440 0         0 ],
10441             };
10442 0         0 $self->send_output($extout, @local_extjoin);
10443             }
10444             $self->send_event(
10445             "daemon_join",
10446             $full,
10447             $chanrec->{name},
10448 1258         4492 );
10449 1258 100       193390 if ($umode) {
10450 19         59 $modes .= $umode;
10451 19         58 push @mode_parms, @op_list;
10452             }
10453 1258 100       4441 if ( $self->{state}{uids}{$uid}{away} ) {
10454 2         16 push @aways, { uid => $uid, msg => $self->{state}{uids}{$uid}{away} };
10455             }
10456             }
10457 76 100       474 if ($modes) {
10458             $self->send_event(
10459             "daemon_mode",
10460             $server,
10461             $chanrec->{name},
10462 19         152 '+' . $modes,
10463             @mode_parms,
10464             );
10465 19         2273 my @output_modes;
10466 19         64 my $length = length($server) + 4 + length($chan) + 4;
10467 19         66 my @buffer = ('+', '');
10468 19         87 for my $umode (split //, $modes) {
10469 19         44 my $arg = shift @mode_parms;
10470 19 50       137 if (length(join ' ', @buffer, $arg) + $length > 510) {
10471             push @output_modes, {
10472             prefix => $server,
10473             command => 'MODE',
10474             colonify => 0,
10475             params => [
10476             $chanrec->{name},
10477 0         0 $buffer[0],
10478             split /\s+/,
10479             $buffer[1],
10480             ],
10481             };
10482 0         0 $buffer[0] = "+$umode";
10483 0         0 $buffer[1] = $arg;
10484 0         0 next;
10485             }
10486 19         55 $buffer[0] .= $umode;
10487 19 50       91 if ($buffer[1]) {
10488 0         0 $buffer[1] = join ' ', $buffer[1], $arg;
10489             }
10490             else {
10491 19         70 $buffer[1] = $arg;
10492             }
10493             }
10494             push @output_modes, {
10495             prefix => $server,
10496             command => 'MODE',
10497             colonify => 0,
10498             params => [
10499             $chanrec->{name},
10500 19         227 $buffer[0],
10501             split /\s+/,
10502             $buffer[1],
10503             ],
10504             };
10505             $self->send_output($_, @local_users)
10506 19         140 for @output_modes;
10507             }
10508 76 100       355 if ( @aways ) {
10509             $self->_state_do_away_notify($_->{uid},$chanrec->{name},$_->{msg})
10510 2         12 for @aways;
10511             }
10512             }
10513              
10514 126 50       402 return @$ref if wantarray;
10515 126         499 return $ref;
10516             }
10517              
10518             sub _daemon_peer_tmode {
10519 0     0   0 my $self = shift;
10520 0   0     0 my $peer_id = shift || return;
10521 0   0     0 my $uid = shift || return;
10522 0         0 my $ts = shift;
10523 0         0 my $chan = shift;
10524 0         0 my $server = $self->server_name();
10525 0         0 my $sid = $self->server_sid();
10526 0         0 my $ref = [ ];
10527 0         0 my $args = [ @_ ];
10528 0         0 my $count = scalar @$args;
10529              
10530             SWITCH: {
10531 0 0       0 if (!$self->state_chan_exists($chan)) {
  0         0  
10532 0         0 last SWITCH;
10533             }
10534 0         0 my $record = $self->{state}{chans}{uc_irc($chan)};
10535 0 0       0 if ( $ts > $record->{ts} ) {
10536 0         0 last SWITCH;
10537             }
10538 0         0 $chan = $record->{name};
10539 0         0 my $mode_u_set = ( $record->{mode} =~ /u/ );
10540 0         0 my $full;
10541 0 0       0 $full = $self->state_user_full($uid)
10542             if $self->state_uid_exists($uid);
10543 0         0 my $reply;
10544 0         0 my @reply_args; my %subs;
10545 0         0 my $parsed_mode = parse_mode_line(@$args);
10546              
10547 0         0 while (my $mode = shift (@{ $parsed_mode->{modes} })) {
  0         0  
10548 0         0 my $arg;
10549 0 0       0 $arg = shift @{ $parsed_mode->{args} }
  0         0  
10550             if $mode =~ /^(\+[ohvklbIe]|-[ohvbIe])/;
10551 0 0       0 if (my ($flag,$char) = $mode =~ /^(\+|-)([ohv])/) {
10552 0 0 0     0 if ($flag eq '+'
10553             && $record->{users}{uc_irc($arg)} !~ /$char/) {
10554             # Update user and chan record
10555             $record->{users}{$arg} = join('', sort split //,
10556 0         0 $record->{users}{$arg} . $char);
10557             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
10558 0         0 = $record->{users}{$arg};
10559 0         0 $reply .= "+$char";
10560 0         0 $subs{$arg} = $self->state_user_nick($arg);
10561 0         0 push @reply_args, $arg;
10562             }
10563 0 0 0     0 if ($flag eq '-' && $record->{users}{uc_irc($arg)}
10564             =~ /$char/) {
10565             # Update user and chan record
10566 0         0 $record->{users}{$arg} =~ s/$char//g;
10567             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
10568 0         0 = $record->{users}{$arg};
10569 0         0 $reply .= "-$char";
10570 0         0 $subs{$arg} = $self->state_user_nick($arg);
10571 0         0 push @reply_args, $arg;
10572             }
10573 0         0 next;
10574             }
10575 0 0 0     0 if ($mode eq '+l' && $arg =~ /^\d+$/ && $arg > 0) {
      0        
10576             $record->{mode} = join('', sort split //,
10577 0 0       0 $record->{mode} . 'l' ) if $record->{mode} !~ /l/;
10578 0         0 $record->{climit} = $arg;
10579 0         0 $reply .= '+l';
10580 0         0 push @reply_args, $arg;
10581 0         0 next;
10582             }
10583 0 0 0     0 if ($mode eq '-l' && $record->{mode} =~ /l/) {
10584 0         0 $record->{mode} =~ s/l//g;
10585 0         0 delete $record->{climit};
10586 0         0 $reply .= '-l';
10587 0         0 next;
10588             }
10589 0 0 0     0 if ($mode eq '+k' && $arg) {
10590             $record->{mode} = join('', sort split //,
10591 0 0       0 $record->{mode} . 'k') if $record->{mode} !~ /k/;
10592 0         0 $record->{ckey} = $arg;
10593 0         0 $reply .= '+k';
10594 0         0 push @reply_args, $arg;
10595 0         0 next;
10596             }
10597 0 0 0     0 if ($mode eq '-k' && $record->{mode} =~ /k/) {
10598 0         0 $record->{mode} =~ s/k//g;
10599 0         0 delete $record->{ckey};
10600 0         0 $reply .= '-k';
10601 0         0 next;
10602             }
10603             # Bans
10604 0 0       0 if (my ($flag) = $mode =~ /(\+|-)b/) {
10605 0         0 my $mask = normalize_mask($arg);
10606 0         0 my $umask = uc_irc($mask);
10607 0 0 0     0 if ($flag eq '+' && !$record->{bans}{$umask} ) {
10608 0   0     0 $record->{bans}{$umask}
10609             = [$mask, ($full || $server), time];
10610 0         0 $reply .= '+b';
10611 0         0 push @reply_args, $mask;
10612             }
10613 0 0 0     0 if ($flag eq '-' && $record->{bans}{$umask}) {
10614 0         0 delete $record->{bans}{$umask};
10615 0         0 $reply .= '-b';
10616 0         0 push @reply_args, $mask;
10617             }
10618 0         0 next;
10619             }
10620             # Invex
10621 0 0       0 if (my ($flag) = $mode =~ /(\+|-)I/) {
10622 0         0 my $mask = normalize_mask($arg);
10623 0         0 my $umask = uc_irc($mask);
10624 0 0 0     0 if ($flag eq '+' && !$record->{invex}{$umask}) {
10625 0   0     0 $record->{invex}{$umask}
10626             = [$mask, ($full || $server), time];
10627 0         0 $reply .= '+I';
10628 0         0 push @reply_args, $mask;
10629             }
10630 0 0 0     0 if ($flag eq '-' && $record->{invex}{$umask}) {
10631 0         0 delete $record->{invex}{$umask};
10632 0         0 $reply .= '-I';
10633 0         0 push @reply_args, $mask;
10634             }
10635 0         0 next;
10636             }
10637             # Exceptions
10638 0 0       0 if (my ($flag) = $mode =~ /(\+|-)e/) {
10639 0         0 my $mask = normalize_mask($arg);
10640 0         0 my $umask = uc_irc($mask);
10641 0 0 0     0 if ($flag eq '+' && !$record->{excepts}{$umask}) {
10642 0   0     0 $record->{excepts}{$umask}
10643             = [$mask, ($full || $server), time];
10644 0         0 $reply .= '+e';
10645 0         0 push @reply_args, $mask;
10646             }
10647 0 0 0     0 if ($flag eq '-' && $record->{excepts}{$umask}) {
10648 0         0 delete $record->{excepts}{$umask};
10649 0         0 $reply .= '-e';
10650 0         0 push @reply_args, $mask;
10651             }
10652 0         0 next;
10653             }
10654             # The rest should be argumentless.
10655 0         0 my ($flag, $char) = split //, $mode;
10656 0 0 0     0 if ( $flag eq '+' && $record->{mode} !~ /$char/) {
10657             $record->{mode} = join('', sort split //,
10658 0         0 $record->{mode} . $char);
10659 0         0 $reply .= "+$char";
10660 0         0 next;
10661             }
10662 0 0 0     0 if ($flag eq '-' && $record->{mode} =~ /$char/) {
10663 0         0 $record->{mode} =~ s/$char//g;
10664 0         0 $reply .= "-$char";
10665 0         0 next;
10666             }
10667             } # while
10668              
10669 0         0 unshift @$args, $record->{name};
10670 0 0       0 if ($reply) {
10671 0         0 my $parsed_line = unparse_mode_line($reply);
10672             $self->send_output(
10673             {
10674             prefix => $uid,
10675             command => 'TMODE',
10676             colonify => 0,
10677             params => [
10678             $record->{name},
10679             $parsed_line,
10680             @reply_args,
10681             ],
10682             },
10683 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
10684             );
10685             my @reply_args_chan = map {
10686 0 0       0 ( defined $subs{$_} ? $subs{$_} : $_ )
  0         0  
10687             } @reply_args;
10688              
10689             $self->send_event(
10690             "daemon_mode",
10691             ($full || $server),
10692             $record->{name},
10693 0   0     0 $parsed_line,
10694             @reply_args_chan,
10695             );
10696              
10697             $self->_send_output_channel_local(
10698             $record->{name},
10699             {
10700             prefix => ($full || $server),
10701             command => 'MODE',
10702             colonify => 0,
10703             params => [
10704             $record->{name},
10705 0 0 0     0 $parsed_line,
10706             @reply_args_chan,
10707             ],
10708             },
10709             '',
10710             ( $mode_u_set ? 'oh' : '' ),
10711             );
10712 0 0       0 if ($mode_u_set) {
10713 0         0 my $bparse = parse_mode_line( join ' ', $parsed_line, @reply_args_chan );
10714 0         0 my $breply; my @breply_args;
10715 0         0 while (my $bmode = shift (@{ $bparse->{modes} })) {
  0         0  
10716 0         0 my $arg;
10717 0 0       0 $arg = shift @{ $bparse->{args} }
  0         0  
10718             if $bmode =~ /^(\+[ohvklbIe]|-[ohvbIe])/;
10719 0 0       0 next if $bmode =~ m!^[+-][beI]$!;
10720 0         0 $breply .= $bmode;
10721 0         0 push @breply_args, $arg;
10722             }
10723 0 0       0 if ($breply) {
10724 0         0 $parsed_line = unparse_mode_line($breply);
10725             $self->_send_output_channel_local(
10726             $record->{name},
10727             {
10728             prefix => ($full || $server),
10729             command => 'MODE',
10730             colonify => 0,
10731             params => [
10732             $record->{name},
10733 0   0     0 $parsed_line,
10734             @breply_args,
10735             ],
10736             },
10737             '','-oh',
10738             );
10739             }
10740             }
10741             }
10742             } # SWITCH
10743              
10744 0 0       0 return @$ref if wantarray;
10745 0         0 return $ref;
10746             }
10747              
10748             # : BMASK :
10749             sub _daemon_peer_bmask {
10750 72     72   121 my $self = shift;
10751 72   50     201 my $peer_id = shift || return;
10752 72   50     166 my $prefix = shift || return;
10753 72         163 my $ref = [ ];
10754 72         254 my $args = [ @_ ];
10755 72         134 my $count = scalar @$args;
10756 72         293 my %map = qw(b bans e excepts I invex);
10757              
10758             SWITCH: {
10759 72 50 33     110 if ( !$count || $count < 4 ) {
  72         298  
10760 0         0 last SWITCH;
10761             }
10762 72         163 my ($ts,$chan,$trype,$masks) = @$args;
10763 72 50       206 if ( !$self->state_chan_exists($chan) ) {
10764 0         0 last SWITCH;
10765             }
10766 72         185 my $chanrec = $self->{state}{chans}{uc_irc($chan)};
10767             # Simple TS rules apply
10768 72 100       881 if ( $ts > $chanrec->{ts} ) {
10769             # Drop MODE
10770 6         10 last SWITCH;
10771             }
10772             $self->send_output(
10773             {
10774             prefix => $prefix,
10775             command => 'BMASK',
10776             params => $args,
10777             },
10778 66         286 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  102         358  
10779             );
10780 66         260 my $mode_u_set = ( $chanrec->{mode} =~ /u/ );
10781 66         147 my $sid = $self->server_sid();
10782 66         196 my $server = $self->server_name();
10783 72         191 my @local_users = map { $self->_state_uid_route( $_ ) }
10784 72 50       247 grep { !$mode_u_set || $chanrec->{users}{$_} =~ /[oh]/ }
10785 66         105 grep { $_ =~ m!^$sid! } keys %{ $chanrec->{users} };
  174         700  
  66         182  
10786 66         593 my @mask_list = split m!\s+!, $masks;
10787 66         123 my @marsk_list;
10788 66         132 foreach my $marsk ( @mask_list ) {
10789 636         1277 my $mask = normalize_mask($marsk);
10790 636         14543 my $umask = uc_irc($mask);
10791 636 100       7873 next if $chanrec->{ $map{ $trype } }{$umask};
10792 309         1036 $chanrec->{ $map{ $trype } }{$umask} =
10793             [ $mask, $server, time() ];
10794 309         744 push @marsk_list, $marsk;
10795             }
10796             # Only bother with the next bit if we have local users on the channel
10797             # OR masks to announce
10798 66 100 66     269 if ( !@local_users || !@marsk_list ) {
10799 33         157 last SWITCH;
10800             }
10801 33         61 my @types;
10802 33         218 push @types, "+$trype" for @marsk_list;
10803 33         56 my @output_modes;
10804 33         73 my $length = length($server) + 4
10805             + length($chan) + 4;
10806 33         75 my @buffer = ('', '');
10807 33         68 for my $type (@types) {
10808 309         497 my $arg = shift @marsk_list;
10809 309         804 my $mode_line = unparse_mode_line($buffer[0].$type);
10810 309 100       12249 if (length(join ' ', $mode_line, $buffer[1],
10811             $arg) + $length > 510) {
10812             push @output_modes, {
10813             prefix => $server,
10814             command => 'MODE',
10815             colonify => 0,
10816             params => [
10817             $chanrec->{name},
10818 8         120 $buffer[0],
10819             split /\s+/,
10820             $buffer[1],
10821             ],
10822             };
10823 8         25 $buffer[0] = $type;
10824 8         16 $buffer[1] = $arg;
10825 8         19 next;
10826             }
10827 301         519 $buffer[0] = $mode_line;
10828 301 100       529 if ($buffer[1]) {
10829 268         738 $buffer[1] = join ' ', $buffer[1], $arg;
10830             }
10831             else {
10832 33         65 $buffer[1] = $arg;
10833             }
10834             }
10835             push @output_modes, {
10836             prefix => $server,
10837             command => 'MODE',
10838             colonify => 0,
10839             params => [
10840             $chanrec->{name},
10841 33         357 $buffer[0],
10842             split /\s+/, $buffer[1],
10843             ],
10844             };
10845             $self->send_output($_, @local_users)
10846 33         169 for @output_modes;
10847             }
10848              
10849 72 50       192 return @$ref if wantarray;
10850 72         243 return $ref;
10851             }
10852              
10853             sub _daemon_peer_tburst {
10854 10     10   23 my $self = shift;
10855 10   50     39 my $peer_id = shift || return;
10856 10   50     38 my $prefix = shift || return;
10857 10         34 my $ref = [ ];
10858 10         119 my $args = [ @_ ];
10859 10         34 my $count = @$args;
10860              
10861             # :8H8 TBURST 1525787545 #dummynet 1526409011 llestr!bingos@staff.gumbynet.org.uk :this is dummynet, foo
10862              
10863             SWITCH: {
10864 10 50       20 if ( !$self->state_chan_exists( $args->[1] ) ) {
  10         41  
10865 0         0 last SWITCH;
10866             }
10867 10         37 my ($chants,$chan,$topicts,$who,$what) = @$args;
10868 10         18 my $accept;
10869 10         28 my $uchan = uc_irc $chan;
10870 10         118 my $chanrec = $self->{state}{chans}{$uchan};
10871 10 50       65 if ( $chants < $chanrec->{ts} ) {
    50          
10872 0         0 $accept = 1;
10873             }
10874             elsif ( $chants == $chanrec->{ts} ) {
10875 10 100       53 if ( !$chanrec->{topic} ) {
    50          
10876 6         12 $accept = 1;
10877             }
10878             elsif ( $topicts > $chanrec->{topic}[2] ) {
10879 0         0 $accept = 1;
10880             }
10881             }
10882 10 100       26 if ( !$accept ) {
10883 4         14 last SWITCH;
10884             }
10885             $self->send_output(
10886             {
10887             prefix => $prefix,
10888             command => 'TBURST',
10889             params => $args,
10890             },
10891 0         0 grep { $self->_state_peer_capab($_,'TBURST') }
10892 6         38 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  6         47  
10893             );
10894 6   33     42 my $differing = ( !$chanrec->{topic} || $chanrec->{topic}[0] ne $what );
10895 6         38 $chanrec->{topic} = [ $what, $who, $topicts ];
10896 6 50       22 if ( !$differing ) {
10897 0         0 last SWITCH;
10898             }
10899 6   33     37 my $whom = ( $self->{config}{'hidden_servers'} ? $self->server_name() : $self->_state_sid_name( $prefix ) )
10900             || $self->state_user_full( $prefix ) || $self->server_name();
10901 6         56 $self->_send_output_channel_local(
10902             $chan,
10903             {
10904             prefix => $whom,
10905             command => 'TOPIC',
10906             params => [ $chan, $what ],
10907             },
10908             );
10909             }
10910              
10911 10 50       42 return @$ref if wantarray;
10912 10         29 return $ref;
10913             }
10914              
10915             sub _daemon_peer_umode {
10916 0     0   0 my $self = shift;
10917 0   0     0 my $peer_id = shift || return;
10918 0   0     0 my $prefix = shift || return;
10919 0   0     0 my $uid = shift || return;
10920 0         0 my $umode = shift;
10921 0         0 my $ref = [ ];
10922 0         0 my $record = $self->{state}{uids}{$uid};
10923 0         0 my $parsed_mode = parse_mode_line($umode);
10924              
10925 0         0 while (my $mode = shift @{ $parsed_mode->{modes} }) {
  0         0  
10926 0         0 my ($action, $char) = split //, $mode;
10927 0 0 0     0 if ($action eq '+' && $record->{umode} !~ /$char/) {
10928 0         0 $record->{umode} .= $char;
10929 0 0       0 $self->{state}{stats}{invisible}++ if $char eq 'i';
10930 0 0       0 if ($char eq 'o') {
10931 0         0 $self->{state}{stats}{ops_online}++;
10932             }
10933             }
10934 0 0 0     0 if ($action eq '-' && $record->{umode} =~ /$char/) {
10935 0         0 $record->{umode} =~ s/$char//g;
10936 0 0       0 $self->{state}{stats}{invisible}-- if $char eq 'i';
10937 0 0       0 if ($char eq 'o') {
10938 0         0 $self->{state}{stats}{ops_online}--;
10939             }
10940             }
10941             }
10942             $self->send_output(
10943             {
10944             prefix => $prefix,
10945             command => 'MODE',
10946             params => [$uid, $umode],
10947             },
10948 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
10949             );
10950             $self->send_event(
10951             "daemon_umode",
10952 0         0 $record->{full}->(),
10953             $umode,
10954             );
10955              
10956 0 0       0 return @$ref if wantarray;
10957 0         0 return $ref;
10958             }
10959              
10960             sub _daemon_peer_message {
10961 7     7   20 my $self = shift;
10962 7   50     29 my $peer_id = shift || return;
10963 7   50     52 my $uid = shift || return;
10964 7   50     26 my $type = shift || return;
10965 7         15 my $ref = [ ];
10966 7         22 my $args = [ @_ ];
10967 7         17 my $count = @$args;
10968              
10969             SWITCH: {
10970 7         16 my $nick = $self->state_user_nick($uid);
  7         37  
10971 7 50       26 if (!$count) {
10972 0         0 push @$ref, ['461', $type];
10973 0         0 last SWITCH;
10974             }
10975 7 50 33     52 if ($count < 2 || !$args->[1]) {
10976 0         0 push @$ref, ['412'];
10977 0         0 last SWITCH;
10978             }
10979 7         18 my $targets = 0;
10980 7         55 my $max_targets = $self->server_config('MAXTARGETS');
10981 7         35 my $full = $self->state_user_full($uid);
10982 7         40 my $targs = $self->_state_parse_msg_targets($args->[0]);
10983              
10984 7         34 LOOP: for my $target (keys %$targs) {
10985 7         15 my $targ_type = shift @{ $targs->{$target} };
  7         24  
10986 7 50 66     56 if ($targ_type =~ /(server|host)mask/
10987             && !$self->state_user_is_operator($nick)) {
10988 0         0 push @$ref, ['481'];
10989 0         0 next LOOP;
10990             }
10991 7 50 66     45 if ($targ_type =~ /(server|host)mask/
10992             && $targs->{$target}[0] !~ /\./) {
10993 0         0 push @$ref, ['413', $target];
10994 0         0 next LOOP;
10995             }
10996 7 50 66     47 if ($targ_type =~ /(server|host)mask/
10997             && $targs->{$target}[0] =~ /\x2E[^.]*[\x2A\x3F]+[^.]*$/) {
10998 0         0 push @$ref, ['414', $target];
10999 0         0 next LOOP;
11000             }
11001 7 50 33     46 if ($targ_type eq 'channel_ext'
11002             && !$self->state_chan_exists($targs->{$target}[1])) {
11003 0         0 push @$ref, ['401', $targs->{$target}[1]];
11004 0         0 next LOOP;
11005             }
11006 7 50 66     46 if ($targ_type eq 'channel'
11007             && !$self->state_chan_exists($target)) {
11008 0         0 push @$ref, ['401', $target];
11009 0         0 next LOOP;
11010             }
11011 7 50 33     30 if ($targ_type eq 'nick'
11012             && !$self->state_nick_exists($target)) {
11013 0         0 push @$ref, ['401', $target];
11014 0         0 next LOOP;
11015             }
11016 7 50 66     42 if ($targ_type eq 'uid'
11017             && !$self->state_uid_exists($target)) {
11018 0         0 push @$ref, ['401', $target];
11019 0         0 next LOOP;
11020             }
11021 7 100       28 if ($targ_type eq 'uid') {
11022 4         14 $target = $self->state_user_nick($target);
11023             }
11024 7 50 33     31 if ($targ_type eq 'nick_ext'
11025             && !$self->state_peer_exists($targs->{$target}[1])) {
11026 0         0 push @$ref, ['402', $targs->{$target}[1]];
11027 0         0 next LOOP;
11028             }
11029 7         19 $targets++;
11030 7 50       28 if ($targets > $max_targets) {
11031 0         0 push @$ref, ['407', $target];
11032 0         0 last SWITCH;
11033             }
11034             # $$whatever
11035 7 100       26 if ($targ_type eq 'servermask') {
11036 1         3 my $us = 0;
11037 1         2 my %targets;
11038 1         4 my $ucserver = uc $self->server_name();
11039 1         2 for my $peer (keys %{ $self->{state}{peers} }) {
  1         5  
11040 4 100       113 if (matches_mask($targs->{$target}[0], $peer)) {
11041 1 50       76 if ($ucserver eq $peer) {
11042 1         3 $us = 1;
11043             }
11044             else {
11045 0         0 $targets{ $self->_state_peer_route($peer) }++;
11046             }
11047             }
11048             }
11049 1         26 delete $targets{$peer_id};
11050 1         9 $self->send_output(
11051             {
11052             prefix => $uid,
11053             command => $type,
11054             params => [$target, $args->[1]],
11055             },
11056             keys %targets,
11057             );
11058 1 50       4 if ($us) {
11059 1         4 my $local = $self->{state}{peers}{uc $self->server_name()}{users};
11060 1         12 my @local;
11061 1         3 my $spoofed = 0;
11062 1         3 for my $luser (values %$local) {
11063 3 50       9 if ($luser->{route_id} eq 'spoofed') {
11064 0         0 $spoofed = 1;
11065             }
11066             else {
11067 3         6 push @local, $luser->{route_id};
11068             }
11069             }
11070             $self->send_output(
11071             {
11072 1         8 prefix => $full,
11073             command => $type,
11074             params => [$target, $args->[1]],
11075             },
11076             @local,
11077             );
11078 1 50       5 $self->send_event(
11079             "daemon_" . lc $type,
11080             $full,
11081             $target,
11082             $args->[1],
11083             ) if $spoofed;
11084             }
11085 1         5 next LOOP;
11086             }
11087             # $#whatever
11088 6 100       30 if ($targ_type eq 'hostmask') {
11089 1         3 my $spoofed = 0;
11090 1         3 my %targets;
11091             my @local;
11092 1         2 HOST: for my $luser (values %{ $self->{state}{users} }) {
  1         6  
11093             next HOST if !matches_mask(
11094 6 100       92 $targs->{$target}[0], $luser->{auth}{hostname});
11095 3 50       93 if ($luser->{route_id} eq 'spoofed') {
    50          
11096 0         0 $spoofed = 1;
11097             }
11098             elsif ( $luser->{type} eq 'r') {
11099 0         0 $targets{$luser->{route_id}}++;
11100             }
11101             else {
11102 3         7 push @local, $luser->{route_id};
11103             }
11104             }
11105 1         2 delete $targets{$peer_id};
11106 1         10 $self->send_output(
11107             {
11108             prefix => $uid,
11109             command => $type,
11110             params => [$target, $args->[1]],
11111             },
11112             keys %targets,
11113             );
11114 1         7 $self->send_output(
11115             {
11116             prefix => $full,
11117             command => $type,
11118             params => [$target, $args->[1]],
11119             },
11120             @local,
11121             );
11122 1 50       4 $self->send_event(
11123             "daemon_" . lc $type,
11124             $full,
11125             $target,
11126             $args->[1],
11127             ) if $spoofed;
11128 1         5 next LOOP;
11129             }
11130 5 50       18 if ($targ_type eq 'nick_ext') {
11131             $targs->{$target}[1]
11132 0         0 = $self->_state_peer_name($targs->{$target}[1]);
11133 0 0 0     0 if ($targs->{$target}[2]
11134             && !$self->state_user_is_operator($nick)) {
11135 0         0 push @$ref, ['481'];
11136 0         0 next LOOP;
11137             }
11138 0 0       0 if ($targs->{$target}[1] ne $self->server_name()) {
11139             $self->send_output(
11140             {
11141             prefix => $uid,
11142             command => $type,
11143             params => [$target, $args->[1]],
11144             },
11145 0         0 $self->_state_peer_route($targs->{$target}[1]),
11146             );
11147 0         0 next LOOP;
11148             }
11149 0 0       0 if (uc $targs->{$target}[0] eq 'OPERS') {
11150 0 0       0 if (!$self->state_user_is_operator($nick)) {
11151 0         0 push @$ref, ['481'];
11152 0         0 next LOOP;
11153             }
11154             $self->send_output(
11155             {
11156             prefix => $full,
11157             command => $type,
11158             params => [$target, $args->[1]],
11159             },
11160 0         0 keys %{ $self->{state}{localops} },
  0         0  
11161             );
11162 0         0 next LOOP;
11163             }
11164              
11165             my @local = $self->_state_find_user_host(
11166             $targs->{$target}[0],
11167 0         0 $targs->{$target}[2],
11168             );
11169              
11170 0 0       0 if (@local == 1) {
11171 0         0 my $ref = shift @local;
11172 0 0       0 if ($ref->[0] eq 'spoofed') {
11173 0         0 $self->send_event(
11174             "daemon_" . lc $type,
11175             $full,
11176             $ref->[1],
11177             $args->[1],
11178             );
11179             }
11180             else {
11181 0         0 $self->send_output(
11182             {
11183             prefix => $full,
11184             command => $type,
11185             params => [$target, $args->[1]],
11186             },
11187             $ref->[0],
11188             );
11189             }
11190             }
11191             else {
11192 0         0 push @$ref, ['407', $target];
11193 0         0 next LOOP;
11194             }
11195             }
11196 5         21 my $channel;
11197             my $status_msg;
11198 5 100       30 if ($targ_type eq 'channel') {
11199 1         5 $channel = $self->_state_chan_name($target);
11200             }
11201 5 50       32 if ($targ_type eq 'channel_ext') {
11202 0         0 $channel = $self->_state_chan_name($targs->{target}[1]);
11203 0         0 $status_msg = $targs->{target}[0];
11204             }
11205 5 50 66     24 if ($channel && $status_msg
      33        
11206             && !$self->state_user_chan_mode($nick, $channel)) {
11207 0         0 push @$ref, ['482', $target];
11208 0         0 next LOOP;
11209             }
11210 5 50 66     31 if ($channel && $self->state_chan_mode_set($channel, 'n')
      66        
11211             && !$self->state_is_chan_member($nick, $channel)) {
11212 0         0 push @$ref, ['404', $channel];
11213 0         0 next LOOP;
11214             }
11215 5 50 66     35 if ($channel && $self->state_chan_mode_set($channel, 'm')
      33        
11216             && !$self->state_user_chan_mode($nick, $channel)) {
11217 0         0 push @$ref, ['404', $channel];
11218 0         0 next LOOP;
11219             }
11220 5 0 66     24 if ($channel && $self->state_chan_mode_set($channel, 'T')
      33        
      33        
11221             && $type eq 'NOTICE' && !$self->state_user_chan_mode($nick, $channel)) {
11222 0         0 push @$ref, ['404', $channel];
11223 0         0 next LOOP;
11224             }
11225 5 50 66     36 if ($channel && $self->state_chan_mode_set($channel, 'M')
      33        
11226             && $self->state_user_umode($nick) !~ /r/) {
11227 0         0 push @$ref, ['477', $channel];
11228 0         0 next LOOP;
11229             }
11230 5 50 66     37 if ($channel && $self->_state_user_banned($nick, $channel)
      33        
11231             && !$self->state_user_chan_mode($nick, $channel)) {
11232 0         0 push @$ref, ['404', $channel];
11233 0         0 next LOOP;
11234             }
11235 5 0 66     30 if ($channel && $self->state_chan_mode_set($channel, 'c')
      0        
      33        
11236             && ( has_color($args->[1]) || has_formatting($args->[1]) ) ){
11237 0         0 push @$ref, ['408', $channel];
11238 0         0 next LOOP;
11239             }
11240 5 0 66     24 if ($channel && $self->state_chan_mode_set($channel, 'C')
      33        
      33        
11241             && $args->[1] =~ m!^\001! && $args->[1] !~ m!^\001ACTION! ){
11242 0         0 push @$ref, ['492', $channel];
11243 0         0 next LOOP;
11244             }
11245 5 100       26 if ($channel) {
11246 1         4 my $common = { };
11247 1 50       6 my $msg = {
11248             command => $type,
11249             params => [
11250             ($status_msg ? $target : $channel),
11251             $args->[1],
11252             ],
11253             };
11254 1         8 for my $member ($self->state_chan_list($channel, $status_msg)) {
11255 4 50       10 next if $self->_state_user_is_deaf($member);
11256 4         55 $common->{ $self->_state_user_route($member) }++;
11257             }
11258 1         3 delete $common->{$peer_id};
11259 1         5 for my $route_id (keys %$common) {
11260 3         7 $msg->{prefix} = $uid;
11261 3 50       7 if ($self->_connection_is_client($route_id)) {
11262 3         6 $msg->{prefix} = $full;
11263             }
11264 3 50       7 if ($route_id ne 'spoofed') {
11265 3         9 $self->send_output($msg, $route_id);
11266             }
11267             else {
11268 0 0       0 my $tmsg = $type eq 'PRIVMSG'
11269             ? 'public'
11270             : 'notice';
11271 0         0 $self->send_event(
11272             "daemon_$tmsg",
11273             $full,
11274             $channel,
11275             $args->[1],
11276             );
11277             }
11278             }
11279 1         7 next LOOP;
11280             }
11281 4         19 my $server = $self->server_name();
11282 4 50       19 if ($self->state_nick_exists($target)) {
11283 4         14 $target = $self->state_user_nick($target);
11284 4 50       61 if (my $away = $self->_state_user_away_msg($target)) {
11285 0         0 push @$ref, {
11286             prefix => $server,
11287             command => '301',
11288             params => [$nick, $target, $away],
11289             };
11290             }
11291 4         74 my $targ_umode = $self->state_user_umode($target);
11292             # Target user has CALLERID on
11293 4 50 33     75 if ($targ_umode && $targ_umode =~ /[Gg]/) {
11294 0         0 my $targ_rec = $self->{state}{users}{uc_irc($target) };
11295 0 0 0     0 if (($targ_umode =~ /G/ && (
      0        
      0        
      0        
11296             !$self->state_users_share_chan($target, $nick)
11297             || !$targ_rec->{accepts}{uc_irc($nick)}))
11298             || ($targ_umode =~ /g/
11299             && !$targ_rec->{accepts}{uc_irc($nick)})) {
11300 0         0 push @$ref, {
11301             prefix => $server,
11302             command => '716',
11303             params => [
11304             $nick,
11305             $target,
11306             'is in +g mode (server side ignore)',
11307             ],
11308             };
11309 0 0 0     0 if (!$targ_rec->{last_caller}
11310             || (time - $targ_rec->{last_caller} ) >= 60) {
11311 0         0 my ($n, $uh) = split /!/,
11312             $self->state_user_full($nick);
11313             $self->send_output(
11314             {
11315             prefix => $server,
11316             command => '718',
11317             params => [
11318             $target,
11319             "$n\[$uh\]",
11320             'is messaging you, and you are umode +g.'
11321             ],
11322             },
11323             $targ_rec->{route_id},
11324 0 0       0 ) if $targ_rec->{route_id} ne 'spoofed';
11325 0         0 push @$ref, {
11326             prefix => $server,
11327             command => '717',
11328             params => [
11329             $nick,
11330             $target,
11331             'has been informed that you messaged them.',
11332             ],
11333             };
11334             }
11335 0         0 $targ_rec->{last_caller} = time();
11336 0         0 next LOOP;
11337             }
11338             }
11339 4         30 my $msg = {
11340             prefix => $uid,
11341             command => $type,
11342             params => [$target, $args->[1]],
11343             };
11344 4         20 my $route_id = $self->_state_user_route($target);
11345 4 50       17 if ($route_id eq 'spoofed') {
11346 0         0 $msg->{prefix} = $full;
11347 0         0 $self->send_event(
11348             "daemon_" . lc $type,
11349             $full,
11350             $target,
11351             $args->[1],
11352             );
11353             }
11354             else {
11355 4 50       19 if ($self->_connection_is_client($route_id)) {
11356 4         12 $msg->{prefix} = $full;
11357             }
11358 4         36 $self->send_output($msg, $route_id);
11359             }
11360 4         30 next LOOP;
11361             }
11362             }
11363             }
11364              
11365 7 50       42 return @$ref if wantarray;
11366 0         0 return $ref;
11367             }
11368              
11369             sub _daemon_peer_topic {
11370 0     0   0 my $self = shift;
11371 0   0     0 my $peer_id = shift || return;
11372 0   0     0 my $uid = shift || return;
11373 0         0 my $server = $self->server_name();
11374 0         0 my $ref = [ ];
11375 0         0 my $args = [ @_ ];
11376 0         0 my $count = @$args;
11377              
11378             SWITCH:{
11379 0 0       0 if (!$count) {
  0         0  
11380 0         0 last SWITCH;
11381             }
11382 0 0       0 if (!$self->state_chan_exists($args->[0])) {
11383 0         0 last SWITCH;
11384             }
11385 0         0 my $record = $self->{state}{chans}{uc_irc($args->[0])};
11386 0         0 my $chan_name = $record->{name};
11387 0 0       0 if ( $args->[1] ) {
11388             $record->{topic}
11389 0         0 = [$args->[1], $self->state_user_full($uid), time];
11390             }
11391             else {
11392 0         0 delete $record->{topic};
11393             }
11394             $self->send_output(
11395             {
11396             prefix => $uid,
11397             command => 'TOPIC',
11398             params => [$chan_name, $args->[1]],
11399             },
11400 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
11401             );
11402 0         0 $self->_send_output_channel_local(
11403             $chan_name,
11404             {
11405             prefix => $self->state_user_full($uid),
11406             command => 'TOPIC',
11407             params => [$chan_name, $args->[1]],
11408             },
11409             );
11410             }
11411              
11412 0 0       0 return @$ref if wantarray;
11413 0         0 return $ref;
11414             }
11415              
11416             sub _daemon_peer_invite {
11417 1     1   3 my $self = shift;
11418 1   50     5 my $peer_id = shift || return;
11419 1   50     4 my $uid = shift || return;
11420 1         4 my $server = $self->server_name();
11421 1         2 my $ref = [ ];
11422 1         3 my $args = [ @_ ];
11423 1         3 my $count = @$args;
11424              
11425             # :7UPAAAAAA INVITE 8H8AAAAAA #dummynet 1525787545
11426             SWITCH: {
11427 1 50 33     2 if (!$count || $count < 3) {
  1         7  
11428 0         0 last SWITCH;
11429             }
11430 1         4 my ($who, $chan) = @$args;
11431 1         5 $chan = $self->_state_chan_name($chan);
11432 1         15 my $uchan = uc_irc($chan);
11433 1         12 my $chanrec = $self->{state}{chans}{$uchan};
11434 1 50       4 if ($self->_state_is_local_uid($who)) {
11435 1         3 my $record = $self->{state}{uids}{$who};
11436 1         4 $record->{invites}{$uchan} = time;
11437 1         3 my $route_id = $self->_state_uid_route($who);
11438 1         4 my $output = {
11439             prefix => $self->state_user_full($uid),
11440             command => 'INVITE',
11441             params => [$self->state_user_nick($who), $chan],
11442             colonify => 0,
11443             };
11444 1 50       5 if ($route_id eq 'spoofed') {
11445             $self->send_event(
11446             "daemon_invite",
11447             $output->{prefix},
11448 0         0 @{ $output->{params} },
  0         0  
11449             );
11450             }
11451             else {
11452 1         4 $self->send_output( $output, $route_id );
11453             }
11454             }
11455 1 50 33     9 if ( $chanrec->{mode} && $chanrec->{mode} =~ m!i! ) {
11456 1         4 $chanrec->{invites}{$who} = time;
11457             # Send NOTICE to +oh local channel members
11458             # ":%s NOTICE %%%s :%s is inviting %s to %s."
11459 1         5 my $notice = {
11460             prefix => $server,
11461             command => 'NOTICE',
11462             params => [
11463             $chan,
11464             sprintf(
11465             "%s is inviting %s to %s.",
11466             $self->state_user_nick($uid),
11467             $self->state_user_nick($who),
11468             $chan,
11469             ),
11470             ],
11471             };
11472 1         5 my $invite = {
11473             prefix => $self->state_user_full($uid),
11474             command => 'INVITE',
11475             params => [$self->state_user_nick($who), $chan],
11476             colonify => 0,
11477             };
11478 1         38 $self->_send_output_channel_local($chan,$notice,'','oh','','invite-notify');
11479 1         3 $self->_send_output_channel_local($chan,$invite,'','oh','invite-notify','');
11480             }
11481             # Send it on to other peers
11482             $self->send_output(
11483             {
11484             prefix => $uid,
11485             command => 'INVITE',
11486             params => $args,
11487             colonify => 0,
11488             },
11489 1         7 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  2         7  
11490             );
11491             }
11492              
11493 1 50       5 return @$ref if wantarray;
11494 1         4 return $ref;
11495             }
11496              
11497             sub _daemon_peer_away {
11498 10     10   42 my $self = shift;
11499 10   50     50 my $peer_id = shift || return;
11500 10   50     128 my $uid = shift || return;
11501 10         32 my $msg = shift;
11502 10         39 my $server = $self->server_name();
11503 10         30 my $ref = [ ];
11504              
11505             SWITCH: {
11506 10         25 my $rec = $self->{state}{uids}{$uid};
  10         33  
11507 10 50       50 if (!$msg) {
11508 0         0 delete $rec->{away};
11509             $self->send_output(
11510             {
11511             prefix => $uid,
11512             command => 'AWAY',
11513             },
11514 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
11515             );
11516 0         0 $self->_state_do_away_notify($uid,'*',$msg);
11517 0         0 last SWITCH;
11518             }
11519 10         35 $rec->{away} = $msg;
11520              
11521             $self->send_output(
11522             {
11523             prefix => $uid,
11524             command => 'AWAY',
11525             params => [$msg],
11526             },
11527 10         86 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  12         85  
11528             );
11529 10         86 $self->_state_do_away_notify($uid,'*',$msg);
11530             }
11531              
11532 10 50       54 return @$ref if wantarray;
11533 10         39 return $ref;
11534             }
11535              
11536             sub _daemon_peer_links {
11537 1     1   3 my $self = shift;
11538 1   50     3 my $peer_id = shift || return;
11539 1   50     5 my $uid = shift || return;
11540 1         4 my $server = $self->server_name();
11541 1         3 my $sid = $self->server_sid();
11542 1         2 my $ref = [ ];
11543 1         3 my $args = [ @_ ];
11544 1         3 my $count = @$args;
11545              
11546             SWITCH: {
11547 1 50 33     2 if (!$count || $count < 2) {
  1         8  
11548 0         0 last SWITCH;
11549             }
11550 1         4 my ($target,$mask) = @$args;
11551 1 50       4 if ( $sid ne $target ) {
11552 0         0 $self->send_output(
11553             {
11554             prefix => $uid,
11555             command => 'LINKS',
11556             params => $args,
11557             },
11558             $self->_state_sid_route($target),
11559             );
11560 0         0 last SWITCH;
11561             }
11562 1         3 my $urec = $self->{state}{uids}{$uid};
11563             $self->_send_to_realops(
11564             sprintf(
11565             'LINKS requested by %s (%s) [%s]',
11566             $urec->{nick}, (split /!/,$urec->{full}->())[1], $urec->{server},
11567 1         5 ), qw[Notice y],
11568             );
11569 1         3 push @$ref, $_ for
11570 1         6 @{ $self->_daemon_do_links($uid,$sid,$mask ) };
11571             }
11572              
11573 1 50       14 return @$ref if wantarray;
11574 0         0 return $ref;
11575             }
11576              
11577             sub _daemon_peer_svsjoin {
11578 6     6   15 my $self = shift;
11579 6   50     20 my $peer_id = shift || return;
11580 6   50     34 my $prefix = shift || return;
11581 6         21 my $sid = $self->server_sid();
11582 6         15 my $ref = [ ];
11583 6         17 my $args = [ @_ ];
11584 6         14 my $count = @$args;
11585              
11586             SWITCH: {
11587 6 50 66     15 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  6         32  
11588 0         0 last SWITCH;
11589             }
11590 6 50 33     58 if (!$count || $count < 2) {
11591 0         0 last SWITCH;
11592             }
11593 6         17 my $client = shift @$args;
11594 6         28 my $uid = $self->state_user_uid($client);
11595 6 50       78 last SWITCH if !$uid;
11596 6 50       151 if ( $uid =~ m!^$sid! ) {
11597 6         49 my $rec = $self->{state}{uids}{$uid};
11598             $self->_send_output_to_client(
11599             $rec->{route_id},
11600 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
11601 6 0       47 ) for $self->_daemon_cmd_join($rec->{nick}, @$args);
11602 6         28 last SWITCH;
11603             }
11604 0         0 my $route_id = $self->_state_uid_route($uid);
11605 0 0       0 if ( $route_id eq $peer_id ) {
11606             # The fuck
11607 0         0 last SWITCH;
11608             }
11609             $self->send_output(
11610             {
11611 0         0 prefix => $prefix,
11612             command => 'SVSJOIN',
11613             params => [
11614             $client,
11615             @$args,
11616             ],
11617             },
11618             $route_id,
11619             );
11620             }
11621              
11622 6 50       33 return @$ref if wantarray;
11623 6         23 return $ref;
11624             }
11625              
11626             sub _daemon_peer_svspart {
11627 1     1   3 my $self = shift;
11628 1   50     20 my $peer_id = shift || return;
11629 1   50     6 my $prefix = shift || return;
11630 1         3 my $sid = $self->server_sid();
11631 1         3 my $ref = [ ];
11632 1         3 my $args = [ @_ ];
11633 1         2 my $count = @$args;
11634              
11635             SWITCH: {
11636 1 50 33     3 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  1         5  
11637 0         0 last SWITCH;
11638             }
11639 1 50 33     14 if (!$count || $count < 2) {
11640 0         0 last SWITCH;
11641             }
11642 1         2 my $client = shift @$args;
11643 1         5 my $uid = $self->state_user_uid($client);
11644 1 50       3 last SWITCH if !$uid;
11645 1 50       25 if ( $uid =~ m!^$sid! ) {
11646 1         2 my $rec = $self->{state}{uids}{$uid};
11647             $self->_send_output_to_client(
11648             $rec->{route_id},
11649 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
11650 1 0       7 ) for $self->_daemon_cmd_part($rec->{nick}, @$args);
11651 1         4 last SWITCH;
11652             }
11653 0         0 my $route_id = $self->_state_uid_route($uid);
11654 0 0       0 if ( $route_id eq $peer_id ) {
11655             # The fuck
11656 0         0 last SWITCH;
11657             }
11658             $self->send_output(
11659             {
11660 0         0 prefix => $prefix,
11661             command => 'SVSPART',
11662             params => [
11663             $client,
11664             @$args,
11665             ],
11666             },
11667             $route_id,
11668             );
11669             }
11670              
11671 1 50       3 return @$ref if wantarray;
11672 1         3 return $ref;
11673             }
11674              
11675             sub _daemon_peer_svshost {
11676 2     2   5 my $self = shift;
11677 2   50     10 my $peer_id = shift || return;
11678 2   50     8 my $prefix = shift || return;
11679 2         8 my $sid = $self->server_sid();
11680 2         5 my $ref = [ ];
11681 2         6 my $args = [ @_ ];
11682 2         6 my $count = @$args;
11683              
11684             # :9T9 SVSHOST 7UPAAAABO 1529239224 fake.host.name
11685             SWITCH: {
11686 2 50 33     5 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  2         10  
11687 0         0 last SWITCH;
11688             }
11689 2 50 33     14 if (!$count || $count < 3) {
11690 0         0 last SWITCH;
11691             }
11692 2         6 my $client = shift @$args;
11693 2         11 my $uid = $self->state_user_uid($client);
11694 2 50       9 last SWITCH if !$uid;
11695 2 50       14 last SWITCH if $args->[0] !~ m!^\d+$!;
11696 2 50       12 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
11697 2 50       19 if ($args->[1] =~ $host_re) {
11698 2         11 $self->_state_do_change_hostmask($uid, $args->[1]);
11699             }
11700 2         7 unshift @$args, $uid;
11701             $self->send_output(
11702             {
11703             prefix => $prefix,
11704             command => 'SVSHOST',
11705             params => $args,
11706             colonify => 0,
11707             },
11708 2         17 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  4         12  
11709             );
11710             }
11711              
11712 2 50       10 return @$ref if wantarray;
11713 2         7 return $ref;
11714             }
11715              
11716             sub _daemon_peer_svsmode {
11717 31     31   89 my $self = shift;
11718 31   50     129 my $peer_id = shift || return;
11719 31   50     131 my $prefix = shift || return;
11720 31         104 my $sid = $self->server_sid();
11721 31         89 my $ref = [ ];
11722 31         107 my $args = [ @_ ];
11723 31         84 my $count = @$args;
11724              
11725             # :9T9 SVSMODE 7UPAAAABO 1529239224 + extra_arg
11726             SWITCH: {
11727 31 50 33     79 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  31         168  
11728 0         0 last SWITCH;
11729             }
11730 31 50 33     224 if (!$count || $count < 3) {
11731 0         0 last SWITCH;
11732             }
11733 31         99 my $client = shift @$args;
11734 31         161 my $uid = $self->state_user_uid($client);
11735 31 50       118 last SWITCH if !$uid;
11736 31 50       230 last SWITCH if $args->[0] !~ m!^\d+$!;
11737 31 50       228 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
11738 31         91 my $rec = $self->{state}{uids}{$uid};
11739 31         547 my $local = ( $uid =~ m!^$sid! );
11740 31 50       167 $local = $rec->{route_id} if $local;
11741 31 50       177 my $extra_arg = ( $count >= 4 ? $args->[2] : '' );
11742 31         182 my $umode = unparse_mode_line($args->[1]);
11743 31         1065 my $parsed_mode = parse_mode_line($umode);
11744 31         1914 my $previous = $rec->{umode};
11745 31         79 MODE: while (my $mode = shift @{ $parsed_mode->{modes} }) {
  90         437  
11746 59 50       197 next MODE if $mode eq '+o';
11747 59         227 my ($action, $char) = split //, $mode;
11748 59 50       235 next MODE if $char =~ m![SW]!;
11749 59 100 66     331 if ($action eq '+' && $char eq 'x') {
11750 3 50 33     40 if ($extra_arg && $extra_arg =~ $host_re) {
11751 3         23 $self->_state_do_change_hostmask($uid, $extra_arg);
11752             }
11753 3         9 next MODE;
11754             }
11755 56 100 66     294 if ($action eq '+' && $char eq 'd') {
11756 28 50       96 if ($extra_arg) {
11757 28         91 $rec->{account} = $extra_arg;
11758 28         61 foreach my $chan ( keys %{ $rec->{chans} } ) {
  28         138  
11759             $self->_send_output_channel_local(
11760             $chan,
11761             {
11762             prefix => $rec->{full}->(),
11763             command => 'ACCOUNT',
11764             colonify => 0,
11765             params => [ $rec->{account} ],
11766             },
11767             $rec->{route_id},
11768 4         17 '',
11769             'account-notify',
11770             );
11771             }
11772             }
11773 28         109 next MODE;
11774             }
11775 28 50 33     347 if ($action eq '+' && $rec->{umode} !~ /$char/) {
11776 28         87 $rec->{umode} .= $char;
11777 28 50       113 if ($char eq 'i') {
11778 0         0 $self->{state}{stats}{invisible}++;
11779             }
11780 28 50 33     147 if ($char eq 'w' && $local ) {
11781 0         0 $self->{state}{wallops}{$local} = time;
11782             }
11783 28 50 33     162 if ($char eq 'l' && $local ) {
11784 0         0 $self->{state}{locops}{$local} = time;
11785             }
11786             }
11787 28 50 33     124 if ($action eq '-' && $rec->{umode} =~ /$char/) {
11788 0         0 $rec->{umode} =~ s/$char//g;
11789 0 0       0 $self->{state}{stats}{invisible}-- if $char eq 'i';
11790              
11791 0 0       0 if ($char eq 'o') {
11792 0         0 $self->{state}{stats}{ops_online}--;
11793 0         0 delete $rec->{svstags}{313};
11794 0 0       0 if ( $local ) {
11795 0         0 delete $self->{state}{localops}{$local};
11796 0         0 $self->antiflood( $local, 1);
11797             }
11798             }
11799 0 0 0     0 if ($char eq 'w' && $local) {
11800 0         0 delete $self->{state}{wallops}{$local};
11801             }
11802 0 0 0     0 if ($char eq 'l' && $local) {
11803 0         0 delete $self->{state}{locops}{$local};
11804             }
11805             }
11806             }
11807 31         242 $rec->{umode} = join '', sort split //, $rec->{umode};
11808 31         107 unshift @$args, $uid;
11809             $self->send_output(
11810             {
11811             prefix => $prefix,
11812             command => 'SVSMODE',
11813             params => $args,
11814             colonify => 0,
11815             },
11816 31         256 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  62         255  
11817             );
11818 31 50       159 last SWITCH if !$local;
11819 31         149 my $set = gen_mode_change($previous, $rec->{umode});
11820 31 100       2140 if ($set) {
11821 28         99 my $full = $rec->{full}->();
11822             $self->send_output(
11823             {
11824             prefix => $full,
11825             command => 'MODE',
11826 28         242 params => [$rec->{nick}, $set],
11827             },
11828             $local
11829             );
11830 28         170 $self->send_event(
11831             "daemon_umode",
11832             $full,
11833             $set,
11834             );
11835             }
11836             }
11837              
11838 31 50       3672 return @$ref if wantarray;
11839 31         104 return $ref;
11840             }
11841              
11842             sub _daemon_peer_svsnick {
11843 3     3   12 my $self = shift;
11844 3   50     18 my $peer_id = shift || return;
11845 3   50     15 my $prefix = shift || return;
11846 3         13 my $sid = $self->server_sid();
11847 3         10 my $ref = [ ];
11848 3         12 my $args = [ @_ ];
11849 3         9 my $count = @$args;
11850              
11851             SWITCH: {
11852 3 50 33     8 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  3         21  
11853 0         0 last SWITCH;
11854             }
11855 3 50       15 if (!$count) {
11856 0         0 last SWITCH;
11857             }
11858 3 50       17 my $newnick = ( $count == 4 ? $args->[2] : $args->[1] );
11859 3 50       23 last SWITCH if !is_valid_nick_name($newnick); # maybe check nicklen too
11860 3         56 my $uid = $self->state_user_uid($args->[0]);
11861 3 50       14 last SWITCH if !$uid;
11862 3         11 my $rec = $self->{state}{uids}{$uid};
11863 3         9 my $ts = 0; my $newts = 0;
  3         7  
11864 3 50       14 if ( $count == 4 ) {
11865 0         0 $ts = $args->[1];
11866 0 0 0     0 last SWITCH if $ts && $ts != $rec->{ts};
11867             }
11868             else {
11869 3         11 $ts = $args->[2];
11870             }
11871 3 50       12 if ( $count == 3 ) {
11872 3         10 $newts = $ts;
11873             }
11874             else {
11875 0         0 $newts = $args->[3];
11876             }
11877 3 50       97 if ($uid !~ m!^$sid!) { # Not ours
11878 0 0       0 if ($rec->{route_id} eq $peer_id) {
11879             # eh!?
11880 0         0 last SWITCH;
11881             }
11882             $self->send_output(
11883             {
11884             prefix => $prefix,
11885             command => 'SVSNICK',
11886             params => [
11887             $uid,
11888             $newnick,
11889             $newts,
11890             ],
11891             },
11892             $rec->{route_id},
11893 0         0 );
11894 0         0 last SWITCH;
11895             }
11896              
11897 3         18 my $full = $rec->{full}->();
11898 3         11 my $nick = $rec->{nick};
11899 3         20 my $unick = uc_irc $nick;
11900 3         56 my $unew = uc_irc $newnick;
11901 3         42 my $server = uc $self->server_name();
11902              
11903 3 100       15 if ( $self->state_nick_exists($newnick) ) {
11904 2 100       10 if ( defined $self->{state}{users}{$unew} ) {
11905 1         3 my $exist = $self->{state}{users}{$unew};
11906 1 50       4 if ( $rec eq $exist ) {
11907 0         0 $rec->{nick} = $newnick;
11908 0         0 $rec->{ts} = $newts;
11909 0         0 last SWITCH;
11910             }
11911             # SVSNICK Collide methinks
11912             $self->_terminate_conn_error(
11913             $rec->{route_id},
11914 1         8 'SVSNICK Collide',
11915             );
11916 1         5 last SWITCH;
11917             }
11918 1 50       5 if ( defined $self->{state}{pending}{$unew} ) {
11919             $self->_terminate_conn_error(
11920 1         8 $self->{state}{pending}{$unew},
11921             'SVSNICK Override',
11922             );
11923             }
11924             }
11925              
11926 2         6 my $common;
11927 2         7 for my $chan (keys %{ $rec->{chans} }) {
  2         12  
11928 1         2 for my $user ( keys %{ $self->{state}{chans}{$chan}{users} } ) {
  1         7  
11929 3 50       21 next if $user !~ m!^$sid!;
11930 3         10 $common->{$user} = $self->_state_uid_route($user);
11931             }
11932             }
11933              
11934 2 50       12 if ($unick eq $unew) {
11935 0         0 $rec->{nick} = $newnick;
11936 0         0 $rec->{ts} = $newts;
11937             }
11938             else {
11939 2         5 $rec->{nick} = $newnick;
11940 2         21 $rec->{ts} = $newts;
11941             # WATCH ON/OFF
11942 2 50       19 if ( defined $self->{state}{watches}{$unick} ) {
11943 0         0 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  0         0  
11944 0 0       0 next if !defined $self->{state}{uids}{$wuid};
11945 0         0 my $wrec = $self->{state}{uids}{$wuid};
11946 0         0 my $laston = time();
11947 0         0 $self->{state}{watches}{$unick}{laston} = $laston;
11948             $self->send_output(
11949             {
11950             prefix => $rec->{server},
11951             command => '605',
11952             params => [
11953             $wrec->{nick},
11954             $nick,
11955             $rec->{auth}{ident},
11956             $rec->{auth}{hostname},
11957             $laston,
11958             'is offline',
11959             ],
11960             },
11961             $wrec->{route_id},
11962 0         0 );
11963             }
11964             }
11965 2 50       12 if ( defined $self->{state}{watches}{$unew} ) {
11966 0         0 foreach my $wuid ( keys %{ $self->{state}{watches}{$unew}{uids} } ) {
  0         0  
11967 0 0       0 next if !defined $self->{state}{uids}{$wuid};
11968 0         0 my $wrec = $self->{state}{uids}{$wuid};
11969             $self->send_output(
11970             {
11971             prefix => $rec->{server},
11972             command => '604',
11973             params => [
11974             $wrec->{nick},
11975             $rec->{nick},
11976             $rec->{auth}{ident},
11977             $rec->{auth}{hostname},
11978             $rec->{ts},
11979             'is online',
11980             ],
11981             },
11982             $wrec->{route_id},
11983 0         0 );
11984             }
11985             }
11986             # Remove from peoples accept lists
11987 2         5 for (keys %{ $rec->{accepts} }) {
  2         14  
11988 0         0 delete $self->{state}{users}{$_}{accepts}{$unick};
11989             }
11990 2         8 delete $rec->{accepts};
11991 2         8 delete $self->{state}{users}{$unick};
11992 2         7 $self->{state}{users}{$unew} = $rec;
11993 2         11 delete $self->{state}{peers}{$server}{users}{$unick};
11994 2         6 $self->{state}{peers}{$server}{users}{$unew} = $rec;
11995 2 100       14 if ( $rec->{umode} =~ /r/ ) {
11996 1         5 $rec->{umode} =~ s/r//g;
11997             $self->send_output(
11998             {
11999             prefix => $full,
12000             command => 'MODE',
12001             params => [
12002             $rec->{nick},
12003             '-r',
12004             ],
12005             },
12006             $rec->{route_id},
12007 1         34 );
12008             }
12009 2         38 unshift @{ $self->{state}{whowas}{$unick} }, {
12010             logoff => time(),
12011             account => $rec->{account},
12012             nick => $nick,
12013             user => $rec->{auth}{ident},
12014             host => $rec->{auth}{hostname},
12015             real => $rec->{auth}{realhost},
12016             sock => $rec->{socket}[0],
12017             ircname => $rec->{ircname},
12018             server => $rec->{server},
12019 2         6 };
12020             }
12021              
12022 2         30 $self->_send_to_realops(
12023             sprintf(
12024             'Nick change: From %s to %s [%s]',
12025             $nick, $newnick, (split /!/,$full)[1],
12026             ),
12027             'Notice',
12028             'n',
12029             );
12030              
12031             $self->send_output(
12032             {
12033             prefix => $rec->{uid},
12034             command => 'NICK',
12035 2         19 params => [$newnick, $rec->{ts}],
12036             },
12037             $self->_state_connected_peers(),
12038             );
12039              
12040 2         18 $self->send_event("daemon_nick", $full, $newnick);
12041              
12042             $self->send_output(
12043             {
12044             prefix => $full,
12045             command => 'NICK',
12046             params => [$newnick],
12047             },
12048 2         292 $rec->{route_id}, values %$common,
12049             );
12050             }
12051              
12052 3 50       28 return @$ref if wantarray;
12053 3         12 return $ref;
12054             }
12055              
12056             sub _daemon_peer_svskill {
12057 1     1   3 my $self = shift;
12058 1   50     6 my $peer_id = shift || return;
12059 1   50     5 my $prefix = shift || return;
12060 1         4 my $sid = $self->server_sid();
12061 1         3 my $ref = [ ];
12062 1         4 my $args = [ @_ ];
12063 1         3 my $count = @$args;
12064              
12065             SWITCH: {
12066 1 50 33     3 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  1         7  
12067 0         0 last SWITCH;
12068             }
12069 1 50 33     9 if (!$count || $count < 2) {
12070 0         0 last SWITCH;
12071             }
12072 1         4 my $client = shift @$args;
12073 1         6 my $uid = $self->state_user_uid($client);
12074 1 50       4 last SWITCH if !$uid;
12075 1 50       8 last SWITCH if $args->[0] !~ m!^\d+$!;
12076 1 50       9 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
12077 1 50       30 if ( $uid =~ m!^$sid! ) {
12078 1         4 my $rec = $self->{state}{uids}{$uid};
12079 1         3 my $reason = 'SVSKilled: ';
12080 1 50       4 if ( $count == 3 ) {
12081 1         7 $reason .= pop @$args;
12082             }
12083             else {
12084 0         0 $reason .= '';
12085             }
12086             $self->_terminate_conn_error(
12087             $rec->{route_id},
12088 1         7 $reason,
12089             );
12090 1         4 last SWITCH;
12091             }
12092 0         0 my $route_id = $self->_state_uid_route($uid);
12093 0 0       0 if ( $route_id eq $peer_id ) {
12094             # The fuck
12095 0         0 last SWITCH;
12096             }
12097             $self->send_output(
12098             {
12099 0         0 prefix => $prefix,
12100             command => 'SVSKILL',
12101             params => [
12102             $client,
12103             @$args,
12104             ],
12105             },
12106             $route_id,
12107             );
12108             }
12109              
12110 1 50       5 return @$ref if wantarray;
12111 1         3 return $ref;
12112             }
12113              
12114             sub _daemon_peer_svstag {
12115 3     3   9 my $self = shift;
12116 3   50     14 my $peer_id = shift || return;
12117 3   50     12 my $prefix = shift || return;
12118 3         10 my $sid = $self->server_sid();
12119 3         8 my $ref = [ ];
12120 3         11 my $args = [ @_ ];
12121 3         9 my $count = @$args;
12122              
12123             # - parv[0] = nickname
12124             # - parv[1] = TS
12125             # - parv[2] = [-][raw]
12126             # - parv[3] = required user mode(s) to see the tag
12127             # - parv[4] = tag line
12128              
12129             SWITCH: {
12130 3 50 33     6 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  3         18  
12131 0         0 last SWITCH;
12132             }
12133 3 50 33     46 if (!$count || $count < 2) {
12134 0         0 last SWITCH;
12135             }
12136 3         11 my $client = shift @$args;
12137 3         17 my $uid = $self->state_user_uid($client);
12138 3 50       79 last SWITCH if !$uid;
12139 3 50       30 last SWITCH if $args->[0] !~ m!^\d+$!;
12140 3 50       23 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
12141 3         9 my $rec = $self->{state}{uids}{$uid};
12142 3 50       21 if ( $args->[1] eq '-' ) {
12143 0         0 delete $rec->{svstags}{$_} for keys %{ $rec->{svstags} };
  0         0  
12144             $self->send_output(
12145             {
12146             prefix => $prefix,
12147             command => 'SVSTAG',
12148             params => [
12149             $uid,
12150             $rec->{ts},
12151             $args->[1],
12152             ],
12153             },
12154 0         0 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  0         0  
12155             );
12156 0         0 last SWITCH;
12157             }
12158 3 50 33     28 last SWITCH if $count < 5 || !$args->[3];
12159 3         27 $rec->{svstags}{$args->[1]} = {
12160             numeric => $args->[1],
12161             umodes => $args->[2],
12162             tagline => $args->[3],
12163             };
12164             $self->send_output(
12165             {
12166             prefix => $prefix,
12167             command => 'SVSTAG',
12168             params => [
12169             $uid,
12170             $rec->{ts},
12171             $args->[1],
12172             $args->[2],
12173             $args->[3],
12174             ],
12175             },
12176 3         82 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  3         29  
12177             );
12178             }
12179              
12180 3 50       25 return @$ref if wantarray;
12181 3         11 return $ref;
12182             }
12183              
12184             sub _state_create {
12185 184     184   550 my $self = shift;
12186              
12187 184         1128 $self->_state_delete();
12188              
12189             # Connection specific tables
12190 184         825 $self->{state}{conns} = { };
12191              
12192             # IRC State specific
12193 184         703 $self->{state}{users} = { };
12194 184         658 $self->{state}{peers} = { };
12195 184         688 $self->{state}{chans} = { };
12196              
12197             # Register ourselves as a peer.
12198             $self->{state}{peers}{uc $self->server_name()} = {
12199             name => $self->server_name(),
12200             hops => 0,
12201             desc => $self->{config}{SERVERDESC},
12202 184         994 ts => 6,
12203             };
12204              
12205 184 50       1019 if ( my $sid = $self->{config}{SID} ) {
12206 184         824 my $rec = $self->{state}{peers}{uc $self->server_name()};
12207 184         587 $rec->{sid} = $sid;
12208 184         538 $rec->{ts} = 6;
12209 184         856 $self->{state}{sids}{uc $sid} = $rec;
12210 184         727 $self->{state}{uids} = { };
12211 184         1303 $self->{genuid} = $sid . 'AAAAAA';
12212             }
12213              
12214             $self->{state}{stats} = {
12215 184         1620 maxconns => 0,
12216             maxlocal => 0,
12217             maxglobal => 0,
12218             ops_online => 0,
12219             invisible => 0,
12220             cmds => { },
12221             };
12222              
12223             $self->{state}{caps} = {
12224 184         1849 'account-notify' => 1,
12225             'away-notify' => 1,
12226             'chghost' => 1,
12227             'extended-join' => 1,
12228             'invite-notify' => 1,
12229             'multi-prefix' => 1,
12230             'userhost-in-names' => 1,
12231             };
12232              
12233 184         601 return 1;
12234             }
12235              
12236             sub _state_rand_sid {
12237 2     2   6 my $self = shift;
12238 2         18 my @components = ( 0 .. 9, 'A' .. 'Z' );
12239 2         5 my $total = scalar @components;
12240 2         4 my $prefx = 10;
12241 2         89 $self->{config}{SID} = join '', $components[ rand $prefx ], $components[ rand $total ], $components[ rand $total ];
12242             }
12243              
12244             sub _state_gen_uid {
12245 10570     10570   10950705 my $self = shift;
12246 10570         22471 my $uid = $self->{genuid};
12247 10570         20828 $self->{genuid} = _add_one_uid( $uid );
12248 10570         43015 while ( defined $self->{state}{uids}{$uid} ) {
12249 0         0 $uid = $self->{genuid};
12250 0         0 $self->{genuid} = _add_one_uid( $uid );
12251             }
12252 10570         24652 return $uid;
12253             }
12254              
12255             sub _add_one_uid {
12256 10570     10570   16265 my $UID = shift;
12257 10570         57624 my @cols = unpack 'a' x length $UID, $UID;
12258 10570         19235 my ($add,$add1);
12259             $add1 = $add = sub {
12260 10862     10862   16623 my $idx = shift;
12261 10862 50       26264 if ( $idx != 3 ) {
12262 10862 100       27878 if ( $cols[$idx] eq 'Z' ) {
    100          
12263 293         698 $cols[$idx] = '0';
12264             }
12265             elsif ( $cols[$idx] eq '9' ) {
12266 292         1097 $cols[$idx] = 'A';
12267 292         1256 $add->( $idx - 1 );
12268             }
12269             else {
12270 10277         23468 $cols[$idx]++;
12271             }
12272             }
12273             else {
12274 0 0       0 if ( $cols[$idx] eq 'Z' ) {
12275 0         0 @cols[3..8] = qw[A A A A A A];
12276             }
12277             else {
12278 0         0 $cols[$idx]++;
12279             }
12280             }
12281 10570         53280 };
12282 10570         28980 $add->(8);
12283 10570         50508 return pack 'a' x scalar @cols, @cols;
12284             }
12285              
12286             sub _state_delete {
12287 184     184   471 my $self = shift;
12288 184         523 delete $self->{state};
12289 184         437 return 1;
12290             }
12291              
12292             sub _state_update_stats {
12293 815     815   1791 my $self = shift;
12294 815         2383 my $server = $self->server_name();
12295 815         1876 my $global = keys %{ $self->{state}{users} };
  815         2542  
12296 815         1633 my $local = keys %{ $self->{state}{peers}{uc $server}{users} };
  815         2953  
12297              
12298             $self->{state}{stats}{maxglobal}
12299 815 100       3382 = $global if $global > $self->{state}{stats}{maxglobal};
12300             $self->{state}{stats}{maxlocal}
12301 815 100       2757 = $local if $local > $self->{state}{stats}{maxlocal};
12302 815         1630 return 1;
12303             }
12304              
12305             sub _state_conn_stats {
12306 527     527   1323 my $self = shift;
12307              
12308 527         2151 $self->{state}{stats}{conns_cumlative}++;
12309 527         1232 my $conns = keys %{ $self->{state}{conns} };
  527         2048  
12310             $self->{state}{stats}{maxconns} = $conns
12311 527 100       2493 if $conns > $self->{state}{stats}{maxconns};
12312 527         1241 return 1;
12313             }
12314              
12315             sub _state_cmd_stat {
12316 4134     4134   7684 my $self = shift;
12317 4134   50     10620 my $cmd = shift || return;
12318 4134   100     10342 my $line = shift || return;
12319 3907         6470 my $remote = shift;
12320 3907   100     20115 my $record = $self->{state}{stats}{cmds}{$cmd} || {
12321             remote => 0,
12322             local => 0,
12323             bytes => 0,
12324             };
12325              
12326 3907 100       11329 $record->{local}++ if !$remote;
12327 3907 100       9309 $record->{remote}++ if $remote;
12328 3907         7809 $record->{bytes} += length $line;
12329 3907         8872 $self->{state}{stats}{cmds}{$cmd} = $record;
12330 3907         8156 return 1;
12331             }
12332              
12333             sub _state_find_user_host {
12334 0     0   0 my $self = shift;
12335 0   0     0 my $luser = shift || return;
12336 0   0     0 my $host = shift || '*';
12337 0         0 my $local = $self->{state}{peers}{uc $self->server_name()}{users};
12338 0         0 my @conns;
12339 0         0 for my $user (values %$local) {
12340 0 0 0     0 if (matches_mask($host, $user->{auth}{hostname})
12341             && matches_mask($luser, $user->{auth}{ident})) {
12342 0         0 push @conns, [$user->{route_id}, $user->{nick}];
12343             }
12344             }
12345              
12346 0         0 return @conns;
12347             }
12348              
12349             sub _state_add_drkx_line {
12350 26     26   114 my $self = shift;
12351 26   50     484 my $type = shift || return;
12352 26         150 my @args = @_;
12353 26 50       302 return if !@args;
12354 26 50       251 return if $type !~ m!^((RK|[DKX])LINE|RESV)$!i;
12355 26         117 $type = lc($type) . 's';
12356 26         82 my $ref = { };
12357 26         103 foreach my $field ( qw[setby setat target duration] ) {
12358 104         287 $ref->{$field} = shift @args;
12359 104 50       291 return if !defined $ref->{$field};
12360             }
12361 26         101 $ref->{reason} = pop @args;
12362 26 100       209 if ( $type =~ m!^([xd]lines|resvs)$! ) {
12363 18         86 $ref->{mask} = shift @args;
12364 18 50       135 return if !$ref->{mask};
12365             }
12366             else {
12367 8         25 $ref->{user} = shift @args;
12368 8         24 $ref->{host} = shift @args;
12369 8 50 33     67 return if !$ref->{user} || !$ref->{host};
12370             }
12371 26 100       315 if ( $ref->{duration} ) {
12372             $ref->{alarm} =
12373             $poe_kernel->delay_set(
12374             '_state_drkx_line_alarm',
12375             $ref->{duration},
12376 17         133 $type,
12377             $ref,
12378             );
12379             }
12380 26 100       1564 if ( $type eq 'resvs' ) {
12381 8         243 $self->{state}{$type}{ uc_irc $ref->{mask} } = $ref;
12382             }
12383             else {
12384 18         43 push @{ $self->{state}{$type} }, $ref;
  18         109  
12385             }
12386 26         410 return 1;
12387             }
12388              
12389             sub _state_del_drkx_line {
12390 15     15   44 my $self = shift;
12391 15   50     108 my $type = shift || return;
12392 15         56 my @args = @_;
12393 15 50       57 return if !@args;
12394 15 50       140 return if $type !~ m!^((RK|[DKX])LINE|RESV)$!i;
12395 15         56 $type = lc($type) . 's';
12396 15         54 my ($mask,$user,$host);
12397 15 100       88 if ( $type =~ m!^([xd]lines|resvs)$! ) {
12398 11         36 $mask = shift @args;
12399 11 50       46 return if !$mask;
12400             }
12401             else {
12402 4         12 $user = shift @args;
12403 4         11 $host = shift @args;
12404 4 50 33     28 return if !$user || !$host;
12405             }
12406 15         30 my $result; my $i = 0;
  15         38  
12407 15 100       60 if ( $type eq 'resvs' ) {
12408 5         41 $result = delete $self->{state}{resvs}{ uc_irc $mask };
12409             }
12410             else {
12411 10         50 LINES: for (@{ $self->{state}{$type} }) {
  10         53  
12412 10 100 66     67 if ($mask && $_->{mask} eq $mask) {
12413 6         16 $result = splice @{ $self->{state}{$type} }, $i, 1;
  6         30  
12414 6         21 last LINES;
12415             }
12416 4 50 33     39 if ($user && ($_->{user} eq $user && $_->{host} eq $host)) {
      33        
12417 4         9 $result = splice @{ $self->{state}{$type} }, $i, 1;
  4         29  
12418 4         14 last LINES;
12419             }
12420 0         0 ++$i;
12421             }
12422             }
12423 15 50       130 return if !$result;
12424 15 100       73 if ( my $alarm = delete $result->{alarm} ) {
12425 8         54 $poe_kernel->alarm_remove( $alarm );
12426             }
12427 15         964 return $result;
12428             }
12429              
12430             {
12431              
12432             my %drkxlines = (
12433             'rklines' => 'RK-Line',
12434             'klines' => 'K-Line',
12435             'dlines' => 'D-Line',
12436             'xlines' => 'X-Line',
12437             'resvs' => 'RESV',
12438             );
12439              
12440             sub _state_drkx_line_alarm {
12441 9     9   89902776 my ($kernel,$self,$type,$ref) = @_[KERNEL,OBJECT,ARG0,ARG1];
12442 9         71 my $fancy = $drkxlines{$type};
12443 9         49 delete $ref->{alarm};
12444 9         26 my $res; my $i = 0;
  9         60  
12445 9 100       71 if ( $type eq 'resvs' ) {
12446 2         26 $res = delete $self->{state}{resvs}{uc_irc $ref->{mask}};
12447             }
12448             else {
12449 7         23 LINES: foreach my $drkxline ( @{ $self->{state}{$type} } ) {
  7         62  
12450 7 50       51 if ( $drkxline eq $ref ) {
12451 7         23 $res = splice @{ $self->{state}{$type} }, $i, 1;
  7         38  
12452 7         44 last LINES;
12453             }
12454 0         0 ++$i;
12455             }
12456             }
12457 9 50       129 return if !$res;
12458 9   66     112 my $mask = $res->{mask} || join '@', $res->{user}, $res->{host};
12459 9         134 my $locops = sprintf 'Temporary %s for [%s] expired', $fancy, $mask;
12460 9 100       94 $self->del_denial( $res->{mask} ) if $type eq 'dlines';
12461 9         219 $self->send_event( "daemon_expired", lc($fancy), $mask );
12462 9         1774 $self->_send_to_realops( $locops, 'Notice', 'X' );
12463 9         56 return;
12464             }
12465              
12466             }
12467              
12468             sub _state_is_resv {
12469 389     389   1372 my $self = shift;
12470 389   50     1482 my $thing = shift || return;
12471 389         940 my $conn_id = shift;
12472 389 100 66     2182 if ($conn_id && !$self->_connection_exists($conn_id)) {
12473 1         4 $conn_id = '';
12474             }
12475 389 100 100     3576 if ($conn_id && $self->{state}{conns}{$conn_id}{resv_exempt}) {
12476 1         12 return 0;
12477             }
12478 388         887 foreach my $mask ( keys %{ $self->{state}{resvs} } ) {
  388         1998  
12479 10 100       97 if ( matches_mask( $mask, $thing ) ) {
12480 7         467 return $self->{state}{resvs}{$mask}{reason};
12481             }
12482             }
12483 381         2038 return 0;
12484             }
12485              
12486             sub _state_have_resv {
12487 8     8   23 my $self = shift;
12488 8   50     31 my $mask = shift || return;
12489 8 50       42 return 1 if $self->{state}{resvs}{uc_irc $mask};
12490 8         148 return 0;
12491             }
12492              
12493             sub _state_do_away_notify {
12494 18     18   52 my $self = shift;
12495 18   50     62 my $uid = shift || return;
12496 18   50     80 my $chan = shift || return;
12497 18         36 my $msg = shift;
12498 18 50       95 return if !$self->state_uid_exists($uid);
12499 18         77 my $sid = $self->server_sid();
12500 18         49 my $rec = $self->{state}{uids}{$uid};
12501 18         44 my $common = { };
12502 18         37 my @chans;
12503 18 100       84 if ( $chan eq '*' ) {
12504 15         49 @chans = keys %{ $rec->{chans} };
  15         89  
12505             }
12506             else {
12507 3         14 push @chans, uc_irc $chan;
12508             }
12509 18         90 for my $uchan (@chans) {
12510 5         16 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  5         34  
12511 8 100       124 next if $user !~ m!^$sid!;
12512 6 100       40 next if !$self->{state}{uids}{$user}{caps}{'away-notify'};
12513 1         3 $common->{$user} = $self->_state_uid_route($user);
12514             }
12515             }
12516             my $ref = {
12517 18         77 prefix => $rec->{full}->(),
12518             command => 'AWAY',
12519             };
12520 18 100       110 $ref->{params} = [ $msg ] if $msg;
12521 18         81 $self->send_output( $ref, $common->{$_} ) for keys %$common;
12522 18         81 return 1;
12523             }
12524              
12525             sub _state_do_local_users_match_xline {
12526 5     5   13 my $self = shift;
12527 5   50     20 my $mask = shift || return;
12528 5   50     24 my $reason = shift || '';
12529 5         16 my $sid = $self->server_sid();
12530 5         15 my $server = $self->server_name();
12531              
12532 5         14 foreach my $luser ( keys %{ $self->{state}{sids}{$sid}{uids} } ) {
  5         41  
12533 5         16 my $urec = $self->{state}{uids}{$luser};
12534 5 50       45 next if $urec->{route_id} eq 'spoofed';
12535 0 0       0 next if $urec->{umode} =~ m!o!;
12536 0 0 0     0 if ( $urec->{ircname} && matches_mask( $mask, $urec->{ircname} ) ) {
12537             $self->send_output(
12538             {
12539             prefix => $server,
12540             command => '465',
12541             params => [
12542             $urec->{nick},
12543             "You are banned from this server- $reason",
12544             ],
12545             },
12546             $urec->{route_id},
12547 0         0 );
12548 0         0 $self->_terminate_conn_error( $urec->{route_id}, $reason );
12549             }
12550             }
12551 5         16 return 1;
12552             }
12553              
12554             sub _state_do_local_users_match_dline {
12555 5     5   12 my $self = shift;
12556 5   50     31 my $netmask = shift || return;
12557 5   50     18 my $reason = shift || '';
12558 5         30 my $sid = $self->server_sid();
12559 5         17 my $server = $self->server_name();
12560              
12561 5         13 foreach my $luser ( keys %{ $self->{state}{sids}{$sid}{uids} } ) {
  5         35  
12562 5         16 my $urec = $self->{state}{uids}{$luser};
12563 5 50       25 next if $urec->{route_id} eq 'spoofed';
12564 0 0       0 next if $urec->{umode} =~ m!o!;
12565 0 0       0 if ( Net::CIDR::cidrlookup($urec->{socket}[0],$netmask) ) {
12566             $self->send_output(
12567             {
12568             prefix => $server,
12569             command => '465',
12570             params => [
12571             $urec->{nick},
12572             "You are banned from this server- $reason",
12573             ],
12574             },
12575             $urec->{route_id},
12576 0         0 );
12577 0         0 $self->_terminate_conn_error( $urec->{route_id}, $reason );
12578             }
12579             }
12580 5         19 return 1;
12581             }
12582              
12583             sub _state_do_local_users_match_rkline {
12584 2     2   6 my $self = shift;
12585 2   50     7 my $luser = shift || return;
12586 2   50     17 my $host = shift || return;
12587 2   50     9 my $reason = shift || '';
12588 2         15 my $sid = $self->server_sid();
12589 2         8 my $server = $self->server_name();
12590 2         7 my $local = $self->{state}{sids}{$sid}{uids};
12591              
12592 2         18 for my $urec (values %$local) {
12593 2 50       27 next if $urec->{route_id} eq 'spoofed';
12594 0 0 0     0 next if $urec->{umode} && $urec->{umode} =~ /o/;
12595 0 0 0     0 if (($urec->{socket}[0] =~ /$host/
      0        
12596             || $urec->{auth}{hostname} =~ /$host/)
12597             && $urec->{auth}{ident} =~ /$luser/) {
12598             $self->send_output(
12599             {
12600             prefix => $server,
12601             command => '465',
12602             params => [
12603             $urec->{nick},
12604             "You are banned from this server- $reason",
12605             ],
12606             },
12607             $urec->{route_id},
12608 0         0 );
12609 0         0 $self->_terminate_conn_error( $urec->{route_id}, $reason );
12610             }
12611             }
12612 2         9 return 1;
12613             }
12614              
12615             sub _state_do_local_users_match_kline {
12616 6     6   17 my $self = shift;
12617 6   50     80 my $luser = shift || return;
12618 6   50     21 my $host = shift || return;
12619 6   50     31 my $reason = shift || '';
12620 6         28 my $local = $self->{state}{peers}{uc $self->server_name()}{users};
12621 6         29 my $server = $self->server_name();
12622              
12623 6 50       40 if (my $netmask = Net::CIDR::cidrvalidate($host)) {
12624 6         3841 for my $user (values %$local) {
12625 6 50       36 next if $user->{route_id} eq 'spoofed';
12626 0 0 0     0 next if $user->{umode} && $user->{umode} =~ /o/;
12627 0 0 0     0 if (Net::CIDR::cidrlookup($user->{socket}[0],$netmask)
12628             && matches_mask($luser, $user->{auth}{ident})) {
12629             $self->send_output(
12630             {
12631             prefix => $server,
12632             command => '465',
12633             params => [
12634             $user->{nick},
12635             "You are banned from this server- $reason",
12636             ],
12637             },
12638             $user->{route_id},
12639 0         0 );
12640 0         0 $self->_terminate_conn_error( $user->{route_id}, $reason );
12641             }
12642             }
12643             }
12644             else {
12645 0         0 for my $user (values %$local) {
12646 0 0       0 next if $user->{route_id} eq 'spoofed';
12647 0 0 0     0 next if $user->{umode} && $user->{umode} =~ /o/;
12648              
12649 0 0 0     0 if ((matches_mask($host, $user->{socket}[0])
      0        
12650             || matches_mask($host, $user->{auth}{hostname}))
12651             && matches_mask($luser, $user->{auth}{ident})) {
12652             $self->send_output(
12653             {
12654             prefix => $server,
12655             command => '465',
12656             params => [
12657             $user->{nick},
12658             "You are banned from this server- $reason",
12659             ],
12660             },
12661             $user->{route_id},
12662 0         0 );
12663 0         0 $self->_terminate_conn_error( $user->{route_id}, $reason );
12664             }
12665             }
12666             }
12667              
12668 6         26 return 1;
12669             }
12670              
12671             sub _state_user_matches_rkline {
12672 229     229   704 my $self = shift;
12673 229   50     984 my $conn_id = shift || return;
12674 229         719 my $record = $self->{state}{conns}{$conn_id};
12675 229   66     1659 my $host = $record->{auth}{hostname} || $record->{socket}[0];
12676 229   66     1821 my $user = $record->{auth}{ident} || "~" . $record->{user};
12677 229         692 my $ip = $record->{socket}[0];
12678              
12679 229 100       1029 return 0 if $record->{kline_exempt};
12680              
12681 228         583 for my $kline (@{ $self->{state}{rklines} }) {
  228         1375  
12682 2 50 33     94 if (($host =~ /$kline->{host}/ || $ip =~ /$kline->{host}/)
      33        
12683             && $user =~ /$kline->{user}/) {
12684 2         15 return $kline->{reason};
12685             }
12686             }
12687 226         1224 return 0;
12688             }
12689              
12690             sub _state_user_matches_kline {
12691 234     234   626 my $self = shift;
12692 234   50     1016 my $conn_id = shift || return;
12693 234         715 my $record = $self->{state}{conns}{$conn_id};
12694 234   66     1966 my $host = $record->{auth}{hostname} || $record->{socket}[0];
12695 234   66     1893 my $user = $record->{auth}{ident} || "~" . $record->{user};
12696 234         844 my $ip = $record->{socket}[0];
12697              
12698 234 100       1046 return 0 if $record->{kline_exempt};
12699              
12700 233         991 for my $kline (@{ $self->{state}{klines} }) {
  233         1111  
12701 5 50 0     26 if (my $netmask = Net::CIDR::cidrvalidate($kline->{host})) {
    0 0        
12702 5 50 33     3014 if (Net::CIDR::cidrlookup($ip,$netmask)
12703             && matches_mask($kline->{user}, $user)) {
12704 5         2155 return $kline->{reason};
12705             }
12706             }
12707             elsif ((matches_mask($kline->{host}, $host)
12708             || matches_mask($kline->{host}, $ip))
12709             && matches_mask($kline->{user}, $user)) {
12710 0         0 return $kline->{reason};
12711             }
12712             }
12713              
12714 228         1217 return 0;
12715             }
12716              
12717             sub _state_user_matches_xline {
12718 239     239   677 my $self = shift;
12719 239   50     1046 my $conn_id = shift || return;
12720 239         701 my $record = $self->{state}{conns}{$conn_id};
12721 239   50     1014 my $ircname = $record->{ircname} || return;
12722              
12723 239         624 for my $xline (@{ $self->{state}{xlines} }) {
  239         1332  
12724 5 50       39 if ( matches_mask( $xline->{mask}, $ircname ) ) {
12725 5         496 return $xline->{reason};
12726             }
12727             }
12728              
12729 234         1256 return 0;
12730             }
12731              
12732             sub _state_auth_client_conn {
12733 245     245   935 my $self = shift;
12734 245   50     1020 my $conn_id = shift || return;
12735              
12736 245 100 66     1554 if (!$self->{config}{auth} || !@{ $self->{config}{auth} }) {
  10         55  
12737 235         1094 return 1;
12738             }
12739 10         28 my $record = $self->{state}{conns}{$conn_id};
12740 10   66     46 my $host = $record->{auth}{hostname} || $record->{socket}[0];
12741 10   33     74 my $user = $record->{auth}{ident} || "~" . $record->{user};
12742 10         36 my $uh = join '@', $user, $host;
12743 10         29 my $ui = join '@', $user, $record->{socket}[0];
12744              
12745 10         19 for my $auth (@{ $self->{config}{auth} }) {
  10         35  
12746 10 100 100     66 if (matches_mask($auth->{mask}, $uh)
12747             || matches_mask($auth->{mask}, $ui)) {
12748 9 100 100     698 if ($auth->{password} && (!$record->{pass}
      100        
12749             || !chkpasswd($record->{pass}, $auth->{password}) )) {
12750 4         18 return 0;
12751             }
12752 5 100       7485 if ($auth->{spoof}) {
12753             $self->_send_to_realops(
12754             sprintf(
12755             '%s spoofing: %s as %s',
12756             $record->{nick}, $record->{auth}{hostname},
12757             $auth->{spoof},
12758 1         12 ),
12759             'Notice',
12760             's',
12761             );
12762 1         3 $record->{auth}{hostname} = $auth->{spoof};
12763             }
12764 5         23 foreach my $feat ( qw(exceed_limit kline_exempt resv_exempt can_flood need_ident) ) {
12765 25 100       75 $record->{$feat} = 1 if $auth->{$feat};
12766             }
12767 5 100 66     64 if (!$record->{auth}{ident} && $auth->{no_tilde}) {
12768 1         3 $record->{auth}{ident} = $record->{user};
12769             }
12770 5         40 return 1;
12771             }
12772             }
12773              
12774 1         136 return 0;
12775             }
12776              
12777             sub _state_auth_peer_conn {
12778 259     259   690 my $self = shift;
12779 259         841 my ($conn_id, $name, $pass) = @_;
12780              
12781 259 50 33     1418 if (!$conn_id || !$self->_connection_exists($conn_id)) {
12782 0         0 return;
12783             }
12784              
12785 259 50 33     1823 return 0 if !$name || !$pass;
12786 259         906 my $peers = $self->{config}{peers};
12787 259 50       1216 return 0 if !$peers->{uc $name};
12788 259         822 my $peer = $peers->{uc $name};
12789 259 100       1767 return -1 if !chkpasswd($pass,$peer->{pass});
12790              
12791 258         27982 my $conn = $self->{state}{conns}{$conn_id};
12792              
12793 258 50 66     1125 if ($peer->{certfp} && $conn->{secured}) {
12794 4         32 my $certfp = $self->connection_certfp($conn_id);
12795 4 100 66     33 return -2 if !$certfp || $certfp ne $peer->{certfp};
12796             }
12797              
12798 257 100 66     2945 if (!$peer->{ipmask} && $conn->{socket}[0] =~ /^(127\.|::1)/) {
12799 254         948 return 1;
12800             }
12801 3 50       20 return -3 if !$peer->{ipmask};
12802 3         12 my $client_ip = $conn->{socket}[0];
12803              
12804 3 50       15 if (ref $peer->{ipmask} eq 'ARRAY') {
12805 0         0 for my $block ( @{ $peer->{ipmask} }) {
  0         0  
12806 0 0       0 if ( eval { $block->isa('Net::Netmask') } ) {
  0         0  
12807 0 0       0 return -3 if $block->match($client_ip);
12808 0         0 next;
12809             }
12810 0 0       0 return 1 if Net::CIDR::cidrlookup( $client_ip, $block );
12811             }
12812             }
12813              
12814             return 1 if matches_mask(
12815             '*!*@'.$peer->{ipmask},
12816 3 50       32 "*!*\@$client_ip",
12817             );
12818              
12819 0         0 return -3;
12820             }
12821              
12822             {
12823              
12824             my %flag_notices = (
12825             kline_exempt => '*** You are exempt from K/RK lines',
12826             resv_exempt => '*** You are exempt from resvs',
12827             exceed_limit => '*** You are exempt from user limits',
12828             can_flood => '*** You are exempt from flood protection',
12829             );
12830              
12831             sub _state_auth_flags_notices {
12832 227     227   640 my $self = shift;
12833 227   50     1002 my $conn_id = shift || return;
12834 227 50       950 return if !$self->_connection_exists($conn_id);
12835 227         916 my $server = $self->server_name();
12836 227         728 my $crec = $self->{state}{conns}{$conn_id};
12837 227         1050 my $nick = $crec->{nick};
12838              
12839 227         803 foreach my $feat ( qw(kline_exempt resv_exempt exceed_limit can_flood) ) {
12840 908 100       2612 next if !$crec->{$feat};
12841 4 100       36 $self->antiflood($conn_id, 0) if $feat eq 'can_flood';
12842             $self->_send_output_to_client(
12843             $conn_id,
12844             {
12845             prefix => $server,
12846             command => 'NOTICE',
12847 4         40 params => [ $nick, $flag_notices{$feat} ],
12848             },
12849             );
12850             }
12851 227         633 return 1;
12852             }
12853              
12854             }
12855              
12856             sub _state_send_credentials {
12857 257     257   649 my $self = shift;
12858 257   50     974 my $conn_id = shift || return;
12859 257   50     999 my $name = shift || return;
12860 257 50       850 return if !$self->_connection_exists($conn_id);
12861 257 50       1389 return if !$self->{config}{peers}{uc $name};
12862 257 50       880 return if $self->_connection_terminated($conn_id);
12863              
12864 257         940 my $peer = $self->{config}{peers}{uc $name};
12865 257         1070 my $rec = $self->{state}{peers}{uc $self->server_name()};
12866 257         719 my $sid = $rec->{sid};
12867              
12868             $self->send_output(
12869             {
12870             command => 'PASS',
12871 257 50       3685 params => [$peer->{rpass}, 'TS', ( $sid ? ( 6 => $sid ) : () )],
12872             },
12873             $conn_id,
12874             );
12875              
12876             $self->send_output(
12877             {
12878             command => 'CAPAB',
12879             params => [
12880 257         3062 join (' ', @{ $self->{config}{capab} },
12881 257 100       1114 ($peer->{zip} ? 'ZIP' : ())
12882             ),
12883             ],
12884             },
12885             $conn_id,
12886             );
12887              
12888 257         742 my $desc = '';
12889 257 100       1086 $desc = '(H) ' if $self->{config}{hidden};
12890 257         863 $desc .= $rec->{desc};
12891              
12892             $self->send_output(
12893             {
12894             command => 'SERVER',
12895             params => [
12896             $rec->{name},
12897 257         1870 $rec->{hops} + 1,
12898             $desc,
12899             ],
12900             },
12901             $conn_id,
12902             );
12903              
12904 257         1800 $self->send_output(
12905             {
12906             command => 'SVINFO',
12907             params => [6, 6, 0, time],
12908             },
12909             $conn_id,
12910             );
12911              
12912 257         1777 $self->{state}{conns}{$conn_id}{zip} = $peer->{zip};
12913 257         787 return 1;
12914             }
12915              
12916             sub _state_send_burst {
12917 257     257   739 my $self = shift;
12918 257   50     1005 my $conn_id = shift || return;
12919 257 50       1045 return if !$self->_connection_exists($conn_id);
12920 257 50       1046 return if $self->_connection_terminated($conn_id);
12921 257         1168 my $server = $self->server_name();
12922 257         857 my $sid = $self->server_sid();
12923 257         759 my $conn = $self->{state}{conns}{$conn_id};
12924 257         525 my $burst = grep { /^EOB$/i } @{ $conn->{capab} };
  4077         8535  
  257         859  
12925 257         575 my $invex = grep { /^IE$/i } @{ $conn->{capab} };
  4077         7629  
  257         681  
12926 257         636 my $excepts = grep { /^EX$/i } @{ $conn->{capab} };
  4077         7551  
  257         738  
12927 257         582 my $tburst = grep { /^TBURST$/i } @{ $conn->{capab} };
  4077         7609  
  257         666  
12928 257         601 my $rhost = grep { /^RHOST$/i } @{ $conn->{capab} };
  4077         7509  
  257         752  
12929 257   66     1481 $rhost = ( $self->_state_our_capab('RHOST') && $rhost );
12930 257         1537 my %map = qw(bans b excepts e invex I);
12931 257         782 my @lists = qw(bans);
12932 257 100       1021 push @lists, 'excepts' if $excepts;
12933 257 100       1049 push @lists, 'invex' if $invex;
12934              
12935             # Send SERVER burst
12936 257         601 my %eobs;
12937 257         1255 for ($self->_state_server_burst($sid, $conn->{sid})) {
12938 207         668 $eobs{ $_->{prefix} }++;
12939 207         934 $self->send_output($_, $conn_id );
12940             }
12941              
12942             # Send NICK burst
12943 257         867 for my $uid (keys %{ $self->{state}{uids} }) {
  257         1235  
12944 334         1051 my $record = $self->{state}{uids}{$uid};
12945 334 50       1487 next if $record->{route_id} eq $conn_id;
12946              
12947 334         916 my $umode_fixed = $record->{umode};
12948 334         1589 $umode_fixed =~ s/[^aiow]//g;
12949 334         901 my $prefix = $record->{sid};
12950             my $arrayref = [
12951             $record->{nick},
12952             $record->{hops} + 1,
12953             $record->{ts},
12954             '+' . $umode_fixed,
12955             $record->{auth}{ident},
12956             $record->{auth}{hostname},
12957 334         2134 ];
12958 334 100       1126 push @$arrayref, $record->{auth}{realhost} if $rhost;
12959             push @$arrayref, ( $record->{ipaddress} || 0 ),
12960 334   100     2381 $record->{uid}, $record->{account}, $record->{ircname};
12961 334         1497 my @uid_burst = (
12962             {
12963             prefix => $prefix,
12964             command => 'UID',
12965             params => $arrayref,
12966             },
12967             );
12968 334 100       1543 if ( $record->{away} ) {
12969             push @uid_burst, {
12970             prefix => $record->{uid},
12971             command => 'AWAY',
12972 8         44 params => [ $record->{away} ],
12973             };
12974             }
12975 334         669 foreach my $svstag ( keys %{ $record->{svstags} } ) {
  334         1669  
12976             push @uid_burst, {
12977             prefix => $prefix,
12978             command => 'SVSTAG',
12979             params => [
12980             $record->{uid},
12981             $record->{ts},
12982             $svstag,
12983             $record->{svstags}{$svstag}{umodes},
12984             $record->{svstags}{$svstag}{tagline},
12985 3         55 ],
12986             };
12987             }
12988 334         1528 $self->send_output( $_, $conn_id ) for @uid_burst;
12989             }
12990              
12991             # Send SJOIN+MODE burst
12992 257         669 for my $chan (keys %{ $self->{state}{chans} }) {
  257         1073  
12993 61 50       224 next if $chan =~ /^\&/;
12994 61         203 my $chanrec = $self->{state}{chans}{$chan};
12995 1023         1650 my @uids = map { $_->[1] }
12996 4499         6359 sort { $a->[0] cmp $b->[0] }
12997 61         266 map { my $w = $_; $w =~ tr/@%+/ABC/; [$w, $_] }
  1023         1450  
  1023         1530  
  1023         2085  
12998             $self->state_chan_list_multi_prefixed($chan,'UIDS');
12999              
13000             my $chanref = [
13001             $chanrec->{ts},
13002             $chanrec->{name},
13003             '+' . $chanrec->{mode},
13004             ($chanrec->{ckey} || ()),
13005 61   33     890 ($chanrec->{climit} || ()),
      66        
13006             ];
13007              
13008 61         277 my $length = length( join ' ', @$chanref ) + 11;
13009 61         129 my $buf = '';
13010 61         353 UID: foreach my $uid ( @uids ) {
13011 1023 100       2327 if (length(join ' ', $buf, '1', $uid)+$length+1 > 510) {
13012 11         74 $self->send_output(
13013             {
13014             prefix => $sid,
13015             command => 'SJOIN',
13016             params => [ @$chanref, $buf ],
13017             },
13018             $conn_id,
13019             );
13020 11         30 $buf = $uid;
13021 11         31 next UID;
13022             }
13023 1012         1819 $buf = join ' ', $buf, $uid;
13024 1012         2477 $buf =~ s!^\s+!!;
13025             }
13026 61 50       213 if ($buf) {
13027 61         437 $self->send_output(
13028             {
13029             prefix => $sid,
13030             command => 'SJOIN',
13031             params => [ @$chanref, $buf ],
13032             },
13033             $conn_id,
13034             );
13035             }
13036              
13037 61         190 my @output_modes;
13038 61         153 OUTER: for my $type (@lists) {
13039 183         440 my $length = length($sid) + 5 + length($chan) + 4 + length($chanrec->{ts}) + 2;
13040 183         360 my @buffer = ( '', '' );
13041 183         312 INNER: for my $thing (keys %{ $chanrec->{$type} }) {
  183         628  
13042 168         369 $thing = $chanrec->{$type}{$thing}[0];
13043 168 100       415 if (length(join ' ', '1', $buffer[1], $thing)+$length+1 > 510) {
13044 12         22 $buffer[0] = '+' . $buffer[0];
13045             push @output_modes, {
13046             prefix => $sid,
13047             command => 'BMASK',
13048             colonify => 1,
13049             params => [
13050             $chanrec->{ts},
13051             $chanrec->{name},
13052 12         82 $map{$type},
13053             $buffer[1],
13054             ],
13055             };
13056 12         33 $buffer[0] = '+' . $map{$type};
13057 12         17 $buffer[1] = $thing;
13058 12         51 next INNER;
13059             }
13060              
13061 156 100       252 if ($buffer[1]) {
13062 147         226 $buffer[0] .= $map{$type};
13063 147         354 $buffer[1] = join ' ', $buffer[1], $thing;
13064             }
13065             else {
13066 9         21 $buffer[0] = '+' . $map{$type};
13067 9         14 $buffer[1] = $thing;
13068             }
13069             }
13070              
13071             push @output_modes, {
13072             prefix => $sid,
13073             command => 'BMASK',
13074             colonify => 1,
13075             params => [
13076             $chanrec->{ts},
13077             $chanrec->{name},
13078 183 100       527 $map{$type},
13079             $buffer[1],
13080             ],
13081             } if $buffer[1];
13082             }
13083 61         156 $self->send_output($_, $conn_id) for @output_modes;
13084              
13085 61 100 66     466 if ( $tburst && $chanrec->{topic} ) {
13086             $self->send_output(
13087             {
13088             prefix => $sid,
13089             command => 'TBURST',
13090             params => [
13091             $chanrec->{ts},
13092             $chanrec->{name},
13093 8         23 @{ $chanrec->{topic} }[2,1,0],
  8         69  
13094             ],
13095             colonify => 1,
13096             },
13097             $conn_id,
13098             );
13099             }
13100             }
13101              
13102             # EOB for each connected peer if EOB supported
13103             # and our own EOB first
13104 257 50       1004 if ( $burst ) {
13105 257         1970 $self->send_output(
13106             {
13107             prefix => $sid,
13108             command => 'EOB',
13109             },
13110             $conn_id,
13111             );
13112 257         857 delete $eobs{$sid};
13113             $self->send_output(
13114             {
13115             prefix => $_,
13116             command => 'EOB',
13117             },
13118             $conn_id,
13119 257         1302 ) for keys %eobs;
13120             }
13121              
13122 257         1085 return 1;
13123             }
13124              
13125             sub _state_server_burst {
13126 464     464   1121 my $self = shift;
13127 464   50     1452 my $peer = shift || return;
13128 464   50     1361 my $targ = shift || return;
13129 464 50 33     1335 if (!$self->state_peer_exists( $peer )
13130             || !$self->state_peer_exists($targ)) {
13131             }
13132              
13133 464         1092 my $ref = [ ];
13134              
13135 464         837 for my $server (keys %{ $self->{state}{sids}{$peer}{sids} }) {
  464         2423  
13136 464 100       1476 next if $server eq $targ;
13137 207         693 my $rec = $self->{state}{sids}{$server};
13138 207         505 my $desc = '';
13139 207 100       850 $desc = '(H) ' if $rec->{hidden};
13140 207         777 $desc .= $rec->{desc};
13141             push @$ref, {
13142             prefix => $peer,
13143             command => 'SID',
13144 207         1459 params => [$rec->{name}, $rec->{hops} + 1, $server, $desc],
13145             };
13146 207         1764 push @$ref, $_ for $self->_state_server_burst($rec->{sid}, $targ);
13147             }
13148              
13149 464 50       2246 return @$ref if wantarray;
13150 0         0 return $ref;
13151             }
13152              
13153             sub _state_do_change_hostmask {
13154 6     6   1440 my $self = shift;
13155 6   50     40 my $uid = shift || return;
13156 6   50     56 my $nhost = shift || return;
13157 6         16 my $ref = [ ];
13158 6         101 my $sid = $self->server_sid();
13159 6         27 my $server = $self->server_name();
13160              
13161             SWITCH: {
13162 6 50       15 if ($nhost !~ $host_re ) {
  6         47  
13163 0         0 last SWITCH;
13164             }
13165 6         23 my $rec = $self->{state}{uids}{$uid};
13166 6 50       35 if ($nhost eq $rec->{auth}{hostname}) {
13167 0         0 last SWITCH;
13168             }
13169 6         213 my $local = ( $uid =~ m!^$sid! );
13170 6 50       44 my $conn_id = ($local ? $rec->{route_id} : '');
13171 6         27 my $full = $rec->{full}->();
13172 6         15 foreach my $chan ( keys %{ $rec->{chans} } ) {
  6         34  
13173 3         35 $self->_send_output_channel_local(
13174             $chan,
13175             {
13176             prefix => $full,
13177             command => 'QUIT',
13178             params => [ 'Changing hostname' ],
13179             },
13180             $conn_id, '', '', 'chghost'
13181             );
13182             $self->_send_output_channel_local(
13183             $chan,
13184             {
13185             prefix => $full,
13186             command => 'CHGHOST',
13187             colonify => 0,
13188 3         39 params => [ $rec->{auth}{ident}, $nhost ],
13189             },
13190             $conn_id,
13191             '',
13192             'chghost'
13193             );
13194             }
13195 6         32 $rec->{auth}{hostname} = $nhost;
13196 6 50       27 if ($local) {
13197             $self->send_output(
13198             {
13199             prefix => $server,
13200             command => '396',
13201             params => [
13202             $rec->{nick},
13203             $nhost,
13204             'is now your visible host',
13205             ],
13206             },
13207             $rec->{route_id},
13208 6         91 );
13209             }
13210 6         32 $full = $rec->{full}->();
13211 6         18 CHAN: foreach my $uchan ( keys %{ $rec->{chans} } ) {
  6         26  
13212 3         12 my $chan = $self->{state}{chans}{$uchan}{name};
13213 3         8 my $modeline;
13214             MODES: {
13215 3         9 my $modes = $rec->{chans}{$uchan};
  3         12  
13216 3 50       30 last MODES if !$modes;
13217             $modes = join '',
13218 9         27 map { $_->[1] }
13219 9         31 sort { $a->[0] cmp $b->[0] }
13220 3         19 map { my $w = $_; $w =~ tr/ohv/ABC/; [$w, $_] }
  9         21  
  9         17  
  9         44  
13221             split //, $modes;
13222 3         12 my @args;
13223 3         13 push @args, $_ for
13224 9         30 map { $rec->{nick} } split //, $modes;
13225 3         20 $modeline = join ' ', "+$modes", @args;
13226             }
13227             $self->_send_output_channel_local(
13228 3         35 $chan,
13229             {
13230             prefix => $full,
13231             command => 'JOIN',
13232             colonify => 0,
13233             params => [ $chan ],
13234             },
13235             $conn_id, '', '', [ qw[chghost extended-join] ]
13236             );
13237             $self->_send_output_channel_local(
13238             $chan,
13239             {
13240             prefix => $full,
13241             command => 'JOIN',
13242             colonify => 0,
13243 3         41 params => [ $chan, $rec->{account}, $rec->{ircname} ],
13244             },
13245             $conn_id, '', 'extended-join', 'chghost'
13246             );
13247 3 50       18 if ($modeline) {
13248 3         38 $self->_send_output_channel_local(
13249             $chan,
13250             {
13251             prefix => $server,
13252             command => 'MODE',
13253             colonify => 0,
13254             params => [ $chan, split m! !, $modeline ],
13255             },
13256             $conn_id, '', '', 'chghost'
13257             );
13258             }
13259 3 50       24 if ($rec->{away}) {
13260             $self->_send_output_channel_local(
13261             $chan,
13262             {
13263             prefix => $full,
13264             command => 'AWAY',
13265 0         0 params => [ $rec->{away} ],
13266             },
13267             $conn_id, '', 'away-notify', 'chghost'
13268             );
13269             }
13270             }
13271             }
13272              
13273 6 50       43 return @$ref if wantarray;
13274 6         22 return $ref;
13275             }
13276              
13277             sub _state_do_map {
13278 14     14   23 my $self = shift;
13279 14   50     29 my $nick = shift || return;
13280 14   50     29 my $psid = shift || return;
13281 14         17 my $plen = shift;
13282 14         19 my $ctn = shift;
13283 14         20 my $ref = [ ];
13284 14 50       33 return if !$self->state_sid_exists($psid);
13285 14         23 my $rec = $self->{state}{sids}{$psid};
13286              
13287             SWITCH: {
13288 14         27 my $global = scalar keys %{ $self->{state}{uids} };
  14         20  
  14         31  
13289 14         20 my $local = scalar keys %{ $rec->{uids} };
  14         29  
13290 14         120 my $suffix = sprintf(" | Users: %5d (%1.2f%%)", $local, ( 100 * $local / $global ) );
13291              
13292 14         31 my $prompt = ' ' x $plen;
13293 14 100       38 substr $prompt, -2, 2, '|-' if $plen;
13294 14 100 100     68 substr $prompt, -2, 2, '`-' if !$ctn && $plen;
13295 14         38 my $buffer = $rec->{name} . ' ';
13296 14         52 $buffer .= '-' x ( 64 - length($buffer) - length($prompt) );
13297 14         21 $buffer .= $suffix;
13298              
13299 14 50 66     43 if ( $plen && $plen > 60 ) {
13300             push @$ref, {
13301             prefix => $self->server_name(),
13302             command => '016',
13303             params => [
13304             $nick,
13305             join '', $prompt, $rec->{name}
13306 0         0 ],
13307             };
13308 0         0 last SWITCH;
13309             }
13310              
13311 14         31 push @$ref, {
13312             prefix => $self->server_name(),
13313             command => '015',
13314             params => [
13315             $nick,
13316             join '', $prompt, $buffer
13317             ],
13318             };
13319 14         36 my $sids = $self->{state}{sids}{$psid}{sids};
13320 14         23 my $cnt = keys %$sids;
13321 14         46 foreach my $server (sort { keys %{ $sids->{$a}{sids} } <=> keys %{ $sids->{$b}{sids} } } keys %$sids) {
  2         4  
  2         9  
  2         15  
13322 12         67 push @$ref, $_ for $self->_state_do_map( $nick, $server, $plen + 2, --$cnt );
13323             }
13324             }
13325              
13326 14 50       58 return @$ref if wantarray;
13327 0         0 return $ref;
13328             }
13329              
13330             sub _state_sid_links {
13331 20     20   34 my $self = shift;
13332 20   50     46 my $psid = shift || return;
13333 20   50     42 my $orig = shift || return;
13334 20   50     41 my $nick = shift || return;
13335 20   100     68 my $mask = shift || '*';
13336 20 50       66 return if !$self->state_sid_exists($psid);
13337              
13338 20         39 my $ref = [ ];
13339 20         52 my $peer = $self->_state_sid_name($psid);
13340              
13341 20         41 my $sids = $self->{state}{sids}{$psid}{sids};
13342 20         73 for my $server (sort { keys %{ $sids->{$b}{sids} } <=> keys %{ $sids->{$a}{sids} } } keys %$sids) {
  5         9  
  5         21  
  5         29  
13343 15         233 my $rec = $self->{state}{sids}{$server};
13344 15         48 for ($self->_state_sid_links($server, $orig, $nick)) {
13345 5         14 push @$ref, $_;
13346             }
13347             push @$ref, {
13348             prefix => $orig,
13349             command => '364',
13350             params => [
13351             $nick,
13352             $rec->{name},
13353             $peer,
13354             join( ' ', $rec->{hops}, $rec->{desc}),
13355             ],
13356 15 100       73 } if matches_mask($mask, $rec->{name});
13357             }
13358              
13359 20 50       640 return @$ref if wantarray;
13360 0         0 return $ref;
13361             }
13362              
13363             sub _state_peer_for_peer {
13364 0     0   0 my $self = shift;
13365 0   0     0 my $peer = shift || return;
13366 0 0       0 return if !$self->state_peer_exists($peer);
13367 0         0 $peer = uc $peer;
13368 0         0 return $self->{state}{peers}{$peer}{peer};
13369             }
13370              
13371             sub _state_server_squit {
13372 345     345   804 my $self = shift;
13373 345   50     1104 my $sid = shift || return;
13374 345 100       1035 return if !$self->state_sid_exists($sid);
13375 344         1051 my $ref = [ ];
13376 344         901 push @$ref, $_ for keys %{ $self->{state}{sids}{$sid}{uids} };
  344         2834  
13377              
13378 344         953 for my $psid (keys %{ $self->{state}{sids}{$sid}{sids} }) {
  344         1526  
13379 117         796 push @$ref, $_ for $self->_state_server_squit($psid);
13380             }
13381              
13382 344         1079 my $rec = delete $self->{state}{sids}{$sid};
13383 344         1136 my $upeer = uc $rec->{name};
13384 344         1124 my $me = uc $self->server_name();
13385 344         1006 my $mysid = $self->server_sid();
13386              
13387             $self->_send_to_realops(
13388             sprintf(
13389             'Server %s split from %s',
13390             $rec->{name},
13391             $self->{state}{sids}{ $rec->{psid} }{name},
13392             ), qw[Notice e],
13393 344 100       2030 ) if $mysid ne $rec->{psid};
13394              
13395 344         1186 delete $self->{state}{peers}{$upeer};
13396 344         966 delete $self->{state}{peers}{$me}{peers}{$upeer};
13397 344         925 delete $self->{state}{peers}{$me}{sids}{$sid};
13398 344 50       2030 return @$ref if wantarray;
13399 0         0 return $ref;
13400             }
13401              
13402             sub _state_register_peer {
13403 257     257   593 my $self = shift;
13404 257   50     1032 my $conn_id = shift || return;
13405 257 50       1085 return if !$self->_connection_exists($conn_id);
13406 257         1331 my $server = $self->server_name();
13407 257         1019 my $mysid = $self->server_sid();
13408 257         737 my $record = $self->{state}{conns}{$conn_id};
13409 257         708 my $psid = $record->{ts_data}[1];
13410 257 50       899 return if !$psid;
13411              
13412 257 100       989 if (!$record->{cntr}) {
13413 254         1387 $self->_state_send_credentials($conn_id, $record->{name});
13414             }
13415              
13416 257         889 $record->{burst} = $record->{registered} = 1;
13417 257         656 $record->{conn_time} = time;
13418 257         718 $record->{type} = 'p';
13419 257         763 $record->{route_id} = $conn_id;
13420 257         638 $record->{peer} = $server;
13421 257         785 $record->{psid} = $mysid;
13422 257         941 $record->{users} = { };
13423 257         839 $record->{peers} = { };
13424 257         740 $record->{sid} = $psid;
13425 257         784 my $ucname = uc $record->{name};
13426 257 100       1743 $record->{serv} = 1 if $self->{state}{services}{$ucname};
13427 257         1185 $self->{state}{peers}{uc $server}{peers}{ $ucname } = $record;
13428 257         728 $self->{state}{peers}{ $ucname } = $record;
13429 257         1156 $self->{state}{sids}{ $mysid }{sids}{ $psid } = $record;
13430 257         659 $self->{state}{sids}{ $psid } = $record;
13431 257         1395 $self->antiflood($conn_id, 0);
13432              
13433 257 100       1594 if (my $sslinfo = $self->connection_secured($conn_id)) {
13434             $self->_send_to_realops(
13435             sprintf(
13436             'Link with %s[unknown@%s] established: [TLS: %s] (Capabilities: %s)',
13437 6         27 $record->{name}, $record->{socket}[0], $sslinfo, join(' ', @{ $record->{capab} }),
  6         76  
13438             ),
13439             'Notice',
13440             's',
13441             );
13442             }
13443             else {
13444             $self->_send_to_realops(
13445             sprintf(
13446             'Link with %s[unknown@%s] established: (Capabilities: %s)',
13447 251         905 $record->{name}, $record->{socket}[0], join(' ', @{ $record->{capab} }),
  251         3125  
13448             ),
13449             'Notice',
13450             's',
13451             );
13452             }
13453              
13454             $self->send_output(
13455             {
13456             prefix => $mysid,
13457             command => 'SID',
13458             params => [
13459             $record->{name},
13460             $record->{hops} + 1,
13461             $psid,
13462             ( $record->{hidden} ? '(H) ' : '' ) .
13463             $record->{desc},
13464             ],
13465             },
13466 257 50       3195 grep { $_ ne $conn_id } $self->_state_connected_peers(),
  380         2595  
13467             );
13468              
13469             $self->send_event(
13470             'daemon_sid',
13471             $record->{name},
13472             $mysid,
13473             $record->{hops},
13474             $psid,
13475             $record->{desc},
13476 257         1841 );
13477             $self->send_event(
13478             'daemon_server',
13479             $record->{name},
13480             $server,
13481             $record->{hops},
13482             $record->{desc},
13483 257         33633 );
13484              
13485 257         29701 return 1;
13486             }
13487              
13488             sub _state_register_client {
13489 227     227   931 my $self = shift;
13490 227   50     1015 my $conn_id = shift || return;
13491 227 50       945 return if !$self->_connection_exists($conn_id);
13492              
13493 227         833 my $record = $self->{state}{conns}{$conn_id};
13494 227         1252 $record->{ts} = $record->{idle_time} = $record->{conn_time} = time;
13495 227         765 $record->{_ignore_i_umode} = 1;
13496 227         875 $record->{server} = $self->server_name();
13497 227         1178 $record->{hops} = 0;
13498 227         804 $record->{route_id} = $conn_id;
13499 227         875 $record->{umode} = '';
13500              
13501              
13502 227         1171 $record->{uid} = $self->_state_gen_uid();
13503 227         1084 $record->{sid} = substr $record->{uid}, 0, 3;
13504              
13505 227 100       1006 if (!$record->{auth}{ident}) {
13506 226         3242 $record->{auth}{ident} = '~' . $record->{user};
13507             }
13508              
13509 227 100 66     3887 if ($record->{auth}{hostname} eq 'localhost' ||
      66        
13510             !$record->{auth}{hostname} && $record->{socket}[0] =~ /^(127\.|::1)/) {
13511 226         1037 $record->{auth}{hostname} = $self->server_name();
13512             }
13513              
13514 227 50       1065 if (!$record->{auth}{hostname}) {
13515 0         0 $record->{auth}{hostname} = $record->{socket}[0];
13516             }
13517              
13518 227         2466 $record->{auth}{realhost} = $record->{auth}{hostname};
13519              
13520 227         1053 $record->{account} = '*';
13521              
13522 227         840 $record->{ipaddress} = $record->{socket}[0]; # Needed later for UID command
13523 227 50       1165 $record->{ipaddress} = '0' if $record->{ipaddress} =~ m!^:!;
13524              
13525 227         1143 my $unick = uc_irc $record->{nick};
13526 227         3766 my $ucserver = uc $record->{server};
13527 227         916 $self->{state}{users}{$unick} = $record;
13528 227 50       1689 $self->{state}{uids}{ $record->{uid} } = $record if $record->{uid};
13529 227         1151 $self->{state}{peers}{$ucserver}{users}{$unick} = $record;
13530 227 50       1215 $self->{state}{peers}{$ucserver}{uids}{ $record->{uid} } = $record if $record->{uid};
13531              
13532             $record->{full} = sub {
13533             return sprintf('%s!%s@%s',
13534             $record->{nick},
13535             $record->{auth}{ident},
13536 902     902   8509 $record->{auth}{hostname});
13537 227         1574 };
13538              
13539 227         721 my $umode = '+i';
13540 227 100       899 if ( $record->{secured} ) {
13541 8         29 $umode .= 'S';
13542 8         33 $record->{umode} = 'S';
13543 8 100       100 if (my $certfp = $self->connection_certfp($conn_id)) {
13544 5         200 $record->{certfp} = $certfp;
13545             }
13546             }
13547              
13548             my $arrayref = [
13549             $record->{nick},
13550             $record->{hops} + 1,
13551             $record->{ts}, $umode,
13552             $record->{auth}{ident},
13553             $record->{auth}{hostname},
13554             $record->{ipaddress},
13555             $record->{uid},
13556             $record->{account},
13557             $record->{ircname},
13558 227         1690 ];
13559              
13560             my $rhostref = [
13561             $record->{nick},
13562             $record->{hops} + 1,
13563             $record->{ts}, $umode,
13564             $record->{auth}{ident},
13565             $record->{auth}{hostname},
13566             $record->{auth}{realhost},
13567             $record->{ipaddress},
13568             $record->{uid},
13569             $record->{account},
13570             $record->{ircname},
13571 227         1722 ];
13572              
13573 227         2669 delete $self->{state}{pending}{uc_irc($record->{nick})};
13574              
13575 227         4232 foreach my $peer_id ( $self->_state_connected_peers() ) {
13576 332 50       1491 if ( $self->_state_peer_capab( $peer_id, 'RHOST' ) ) {
13577             $self->send_output(
13578             {
13579             prefix => $record->{sid},
13580 0         0 command => 'UID',
13581             params => $rhostref,
13582             },
13583             $peer_id,
13584             );
13585             }
13586             else {
13587             $self->send_output(
13588             {
13589             prefix => $record->{sid},
13590 332         2617 command => 'UID',
13591             params => $arrayref,
13592             },
13593             $peer_id,
13594             );
13595             }
13596 332 100       2556 if ($record->{certfp}) {
13597             $self->send_output(
13598             {
13599             prefix => $record->{uid},
13600             command => 'CERTFP',
13601 8         58 params => [ $record->{certfp} ],
13602             colonify => 0,
13603             },
13604             $peer_id,
13605             );
13606             }
13607             }
13608              
13609             $self->_send_to_realops(
13610             sprintf(
13611             'Client connecting: %s (%s@%s) [%s] {%s} [%s] <%s>',
13612 227         3347 @{ $rhostref }[0,4,6], $record->{socket}[0],
13613             'users', $record->{ircname}, $record->{uid},
13614 227         1036 ),
13615             'Notice',
13616             'c',
13617             );
13618              
13619 227         1259 $self->send_event('daemon_uid', @$arrayref);
13620 227   50     28719 $self->send_event('daemon_nick', @{ $arrayref }[0..5], $record->{server}, ( $arrayref->[9] || '' ) );
  227         1881  
13621 227         27239 $self->_state_update_stats();
13622              
13623 227 100       1192 if ( defined $self->{state}{watches}{$unick} ) {
13624 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         7  
13625 1 50       6 next if !defined $self->{state}{uids}{$wuid};
13626 1         3 my $wrec = $self->{state}{uids}{$wuid};
13627             $self->send_output(
13628             {
13629             prefix => $record->{server},
13630             command => '600',
13631             params => [
13632             $wrec->{nick},
13633             $record->{nick},
13634             $record->{auth}{ident},
13635             $record->{auth}{hostname},
13636             $record->{ts},
13637             'logged online',
13638             ],
13639             },
13640             $wrec->{route_id},
13641 1         10 );
13642             }
13643             }
13644 227         1129 return $record->{uid};
13645             }
13646              
13647             sub state_nicks {
13648 0     0 1 0 my $self = shift;
13649 0         0 return map { $self->{state}{users}{$_}{nick} }
13650 0         0 keys %{ $self->{state}{users} };
  0         0  
13651             }
13652              
13653             sub state_nick_exists {
13654 4169     4169 1 7828 my $self = shift;
13655 4169   50     9756 my $nick = shift || return 1;
13656 4169         12324 $nick = uc_irc($nick);
13657              
13658 4169 100 100     62773 if (!defined $self->{state}{users}{$nick}
13659             && !defined $self->{state}{pending}{$nick}) {
13660 925         3519 return 0;
13661             }
13662 3244         10384 return 1;
13663             }
13664              
13665             sub state_uid_exists {
13666 6637     6637 0 10300 my $self = shift;
13667 6637   50     12985 my $uid = shift || return 1;
13668 6637 100       22015 return 1 if defined $self->{state}{uids}{$uid};
13669 11         152 return 0;
13670             }
13671              
13672             sub state_chans {
13673 0     0 1 0 my $self = shift;
13674 0         0 return map { $self->{state}{chans}{$_}{name} }
13675 0         0 keys %{ $self->{state}{chans} };
  0         0  
13676             }
13677              
13678             sub state_chan_exists {
13679 1881     1881 1 3282 my $self = shift;
13680 1881   50     4340 my $chan = shift || return;
13681 1881 100       5656 return 0 if !defined $self->{state}{chans}{uc_irc($chan)};
13682 1775         25651 return 1;
13683             }
13684              
13685             sub state_peers {
13686 0     0 1 0 my $self = shift;
13687 0         0 return map { $self->{state}{peers}{$_}{name} }
13688 0         0 keys %{ $self->{state}{peers} };
  0         0  
13689             }
13690              
13691             sub state_peer_exists {
13692 905     905 1 1741 my $self = shift;
13693 905   50     2349 my $peer = shift || return;
13694 905 100       4946 return 0 if !defined $self->{state}{peers}{uc $peer};
13695 49         169 return 1;
13696             }
13697              
13698             sub state_sid_exists {
13699 2471     2471 0 4501 my $self = shift;
13700 2471   50     6420 my $sid = shift || return;
13701 2471 100       8026 return 0 if !defined $self->{state}{sids}{ $sid };
13702 2073         5600 return 1;
13703             }
13704              
13705             sub state_check_joinflood_warning {
13706 52     52 0 123 my $self = shift;
13707 52   50     190 my $nick = shift || return;
13708 52   50     183 my $chan = shift || return;
13709 52         163 my $joincount = $self->{config}{joinfloodcount};
13710 52         140 my $jointime = $self->{config}{joinfloodtime};
13711 52 50 33     324 return if !$joincount || !$jointime;
13712 52 50       167 return if !$self->state_nick_exists($nick);
13713 52 50       196 return if !$self->state_chan_exists($chan);
13714 52         220 my $crec = $self->{state}{chans}{uc_irc $chan};
13715 52         628 $crec->{_num_joined}++;
13716 52   33     461 $crec->{_num_joined} -= ( time - ( $self->{_last_joined} || time ) ) *
13717             ( $joincount / $jointime );
13718 52 50       378 if ( $crec->{_num_joined} <= 0 ) {
    50          
13719 0         0 $crec->{_num_joined} = 0;
13720 0         0 delete $crec->{_jfnotice};
13721             }
13722             elsif ( $crec->{_num_joined} >= $joincount ) {
13723 0 0       0 if ( !$crec->{_jfnotice} ) {
13724 0         0 $crec->{_jfnotice} = 1;
13725 0         0 my $urec = $self->{state}{users}{uc_irc $nick};
13726             $self->_send_to_realops(
13727             sprintf(
13728             'Possible Join Flooder %s[%s] on %s target: %s',
13729             $urec->{nick}, (split /!/,$urec->{full}->())[1],
13730             $urec->{server}, $crec->{name},
13731 0         0 ),
13732             qw[Notice b],
13733             );
13734             }
13735             }
13736 52         190 $crec->{_last_joined} = time();
13737             }
13738              
13739             sub state_check_spambot_warning {
13740 59     59 0 154 my $self = shift;
13741 59   50     305 my $nick = shift || return;
13742 59   100     817 my $chan = shift || return;
13743 52         246 my $spamnum = $self->{config}{MAX_JOIN_LEAVE_COUNT};
13744 52 50       259 return if !$self->state_nick_exists($nick);
13745 52         218 my $urec = $self->{state}{users}{uc_irc $nick};
13746              
13747 52 50 33     1029 if ( $spamnum && $urec->{_jl_cnt} && $urec->{_jl_cnt} >= $spamnum ) {
      33        
13748 0 0 0     0 if ( $urec->{_owcd} && $urec->{_owcd} > 0 ) {
13749 0         0 $urec->{_owcd}--;
13750             }
13751             else {
13752 0         0 $urec->{_owcd} = 0;
13753             }
13754 0 0       0 if ( $urec->{_owcd} == 0 ) {
13755             my $msg = $chan ?
13756             sprintf(
13757             'User %s (%s) trying to join %s is a possible spambot',
13758             $urec->{nick}, (split /!/,$urec->{full}->())[1], $chan,
13759             ) :
13760             sprintf(
13761             'User %s (%s) is a possible spambot',
13762 0 0       0 $urec->{nick}, (split /!/,$urec->{full}->())[1],
13763             );
13764 0         0 $self->_send_to_realops(
13765             $msg, qw[Notice b],
13766             );
13767 0         0 $urec->{_owcd} = $self->{config}{OPER_SPAM_COUNTDOWN};
13768             }
13769             }
13770             else {
13771 52   50     322 my $delta = time() - ( $urec->{_last_leave} || 0 );
13772 52 50       232 if ( $delta > $self->{config}{JOIN_LEAVE_COUNT_EXPIRE} ) {
13773 52         213 my $dec_cnt = $delta / $self->{config}{JOIN_LEAVE_COUNT_EXPIRE};
13774 52 50 50     367 if ($dec_cnt > ( $urec->{_jl_cnt} || 0 )) {
13775 52         169 $urec->{_jl_cnt} = 0;
13776             }
13777             else {
13778 0         0 $urec->{_jl_cnt} -= $dec_cnt;
13779             }
13780             }
13781             else {
13782             $urec->{_jl_cnt}++ if ( time() - $urec->{_last_join} )
13783 0 0       0 < $self->{config}{MIN_JOIN_LEAVE_TIME};
13784             }
13785 52 50       227 if ( $chan ) {
13786 52         190 $urec->{_last_join} = time();
13787             }
13788             else {
13789 0         0 $urec->{_last_leave} = time();
13790             }
13791             }
13792             }
13793              
13794             sub state_flood_attack_channel {
13795 8     8 0 20 my $self = shift;
13796 8   50     34 my $nick = shift || return;
13797 8   50     28 my $chan = shift || return;
13798 8   50     32 my $type = shift || 'PRIVMSG';
13799 8 50 33     57 return 0 if !$self->{config}{floodcount} || !$self->{config}{floodtime};
13800 8 50       24 return if !$self->state_nick_exists($nick);
13801 8 50       24 return if !$self->state_chan_exists($chan);
13802 8         27 my $urec = $self->{state}{users}{uc_irc $nick};
13803 8 50       98 return 0 if $urec->{route_id} eq 'spoofed';
13804 8 50 33     90 return 0 if $urec->{can_flood} || $urec->{umode} =~ /o/;
13805 8         29 my $crec = $self->{state}{chans}{uc_irc $chan};
13806 8         98 my $first = $crec->{_first_msg};
13807 8 50 66     40 if ( $first && ( $first + $self->{config}{floodtime} < time() ) ) {
13808 0 0       0 if ( $crec->{_recv_msgs} ) {
13809 0         0 $crec->{_recv_msgs} = 0;
13810             }
13811             else {
13812 0         0 $crec->{_flood_notice} = 0;
13813             }
13814 0         0 $crec->{_first_msg} = time();
13815             }
13816 8         19 my $recv = $crec->{_recv_msgs};
13817 8 100 100     58 if ( $recv && $recv >= $self->{config}{floodcount} ) {
13818 1 50       45 if ( !$crec->{_flood_notice} ) {
13819             $self->_send_to_realops(
13820             sprintf(
13821             'Possible Flooder %s[%s] on %s target: %s',
13822             $urec->{nick}, (split /!/, $urec->{full}->())[1],
13823             $urec->{server}, $crec->{name},
13824 1         6 ), qw[Notice b],
13825             );
13826 1         5 $crec->{_flood_notice} = 1;
13827             }
13828 1 50       6 if ( $type ne 'NOTICE' ) {
13829             $self->send_output(
13830             {
13831             prefix => $self->server_name(),
13832             command => 'NOTICE',
13833             params => [
13834             $urec->{nick},
13835             "*** Message to $crec->{name} throttled due to flooding",
13836             ],
13837             },
13838             $urec->{route_id},
13839 1         4 );
13840             }
13841 1         7 return 1;
13842             }
13843 7 100       24 $crec->{_first_msg} = time() if !$first;
13844 7         17 $crec->{_recv_msgs}++;
13845 7         41 return 0;
13846             }
13847              
13848             sub state_flood_attack_client {
13849 14     14 0 36 my $self = shift;
13850 14   50     59 my $nick = shift || return;
13851 14   50     76 my $targ = shift || return;
13852 14   50     51 my $type = shift || 'PRIVMSG';
13853 14 50 33     119 return 0 if !$self->{config}{floodcount} || !$self->{config}{floodtime};
13854 14 50       50 return if !$self->state_nick_exists($nick);
13855 14 50       49 return if !$self->state_nick_exists($targ);
13856 14         50 my $urec = $self->{state}{users}{uc_irc $nick};
13857 14 50       210 return 0 if $urec->{route_id} eq 'spoofed';
13858 14 100 66     134 return 0 if $urec->{can_flood} || $urec->{umode} =~ /o/;
13859 12         46 my $trec = $self->{state}{users}{uc_irc $targ};
13860 12         174 my $first = $trec->{_first_msg};
13861 12 50 66     91 if ( $first && ( $first + $self->{config}{floodtime} < time() ) ) {
13862 0 0       0 if ( $trec->{_recv_msgs} ) {
13863 0         0 $trec->{_recv_msgs} = 0;
13864             }
13865             else {
13866 0         0 $trec->{_flood_notice} = 0;
13867             }
13868 0         0 $trec->{_first_msg} = time();
13869             }
13870 12         36 my $recv = $trec->{_recv_msgs};
13871 12 100 100     83 if ( $recv && $recv >= $self->{config}{floodcount} ) {
13872 1 50       7 if ( !$trec->{_flood_notice} ) {
13873             $self->_send_to_realops(
13874             sprintf(
13875             'Possible Flooder %s[%s] on %s target: %s',
13876             $urec->{nick}, (split /!/, $urec->{full}->())[1],
13877             $urec->{server}, $trec->{nick},
13878 1         6 ), qw[Notice b],
13879             );
13880 1         5 $trec->{_flood_notice} = 1;
13881             }
13882 1 50       6 if ( $type ne 'NOTICE' ) {
13883             $self->send_output(
13884             {
13885             prefix => $self->server_name(),
13886             command => 'NOTICE',
13887             params => [
13888             $urec->{nick},
13889             "*** Message to $trec->{nick} throttled due to flooding",
13890             ],
13891             },
13892             $urec->{route_id},
13893 1         6 );
13894             }
13895 1         13 return 1;
13896             }
13897 11 100       55 $trec->{_first_msg} = time() if !$first;
13898 11         46 $trec->{_recv_msgs}++;
13899 11         48 return 0;
13900             }
13901              
13902             sub state_can_send_to_channel {
13903 23     23 0 54 my $self = shift;
13904 23   50     80 my $nick = shift || return;
13905 23   50     90 my $chan = shift || return;
13906 23   50     85 my $msg = shift || return;
13907 23   50     68 my $type = shift || 'PRIVMSG';
13908 23 50       95 return if !$self->state_nick_exists($nick);
13909 23 50       86 return if !$self->state_chan_exists($chan);
13910 23         98 my $uid = $self->state_user_uid($nick);
13911 23         343 my $crec = $self->{state}{chans}{uc_irc $chan};
13912 23         295 my $urec = $self->{state}{uids}{$uid};
13913 23         75 my $member = defined $crec->{users}{$uid};
13914              
13915 23 100 66     168 if ( $crec->{mode} =~ /c/ && ( has_color($msg) || has_formatting($msg) ) ) {
      66        
13916 2         33 return [ '408', $crec->{name} ];
13917             }
13918 21 100 100     164 if ( $crec->{mode} =~ /C/ && $msg =~ m!^\001! && $msg !~ m!^\001ACTION! ) {
      100        
13919 1         6 return [ '492', $crec->{name} ];
13920             }
13921 20 50 33     156 if ( $crec->{mode} =~ /n/ && !$member ) {
13922 0         0 return [ '404', $crec->{name} ];
13923             }
13924 20 100 66     108 if ( $crec->{mode} =~ /M/ && $urec->{umode} !~ /r/ ) {
13925 2         9 return [ '477', $crec->{name} ];
13926             }
13927 18 100 66     177 if ( $member && $crec->{users}{$uid} ) {
13928 8         43 return 2;
13929             }
13930 10 50       35 if ( $crec->{mode} =~ /m/ ) {
13931 0         0 return [ '404', $crec->{name} ];
13932             }
13933 10 100 66     49 if ( $crec->{mode} =~ /T/ && $type eq 'NOTICE' ) {
13934 2         10 return [ '404', $crec->{name} ];
13935             }
13936 8 50       39 if ( $self->_state_user_banned($nick, $chan) ) {
13937 0         0 return [ '404', $crec->{name} ];
13938             }
13939 8         24 return 1;
13940             }
13941              
13942             sub _state_peer_name {
13943 2     2   6 my $self = shift;
13944 2   50     7 my $peer = shift || return;
13945 2 100       11 return if !$self->state_peer_exists($peer);
13946 1         6 return $self->{state}{peers}{uc $peer}{name};
13947             }
13948              
13949             sub _state_peer_sid {
13950 7     7   34 my $self = shift;
13951 7   50     26 my $peer = shift || return;
13952 7 100       33 if ( $peer =~ m!^\d! ) {
13953 4 50       18 return if !$self->state_sid_exists($peer);
13954 4         24 return $self->{state}{sids}{$peer}{sid};
13955             }
13956             else {
13957 3 50       12 return if !$self->state_peer_exists($peer);
13958 3         21 return $self->{state}{peers}{uc $peer}{sid};
13959             }
13960             }
13961              
13962             sub _state_sid_name {
13963 944     944   2044 my $self = shift;
13964 944   50     2672 my $sid = shift || return;
13965 944 50       2713 return if !$self->state_sid_exists($sid);
13966 944         11342 return $self->{state}{sids}{$sid}{name};
13967             }
13968              
13969             sub _state_sid_serv {
13970 52     52   129 my $self = shift;
13971 52   50     263 my $sid = shift || return;
13972 52 50       250 return if !$self->state_sid_exists($sid);
13973 52 100       294 return 0 if !$self->{state}{sids}{$sid}{serv};
13974 43         270 return 1;
13975             }
13976              
13977             sub _state_peer_desc {
13978 4     4   14 my $self = shift;
13979 4   50     18 my $peer = shift || return;
13980 4 50       29 return if !$self->state_peer_exists($peer);
13981 4         53 return $self->{state}{peers}{uc $peer}{desc};
13982             }
13983              
13984             sub _state_peer_capab {
13985 923     923   1972 my $self = shift;
13986 923   50     2722 my $conn_id = shift || return;
13987 923   50     2511 my $capab = shift || return;
13988 923         1920 $capab = uc $capab;
13989 923 50       2601 return if !$self->_connection_is_peer($conn_id);
13990 923         2017 my $conn = $self->{state}{conns}{$conn_id};
13991 923         1657 return scalar grep { $_ eq $capab } @{ $conn->{capab} };
  14703         25833  
  923         2304  
13992             }
13993              
13994             sub _state_our_capab {
13995 811     811   1558 my $self = shift;
13996 811   50     2415 my $capab = shift || return;
13997 811         1761 $capab = uc $capab;
13998 811         1909 my $capabs = $self->{config}{capab};
13999 811         1357 return scalar grep { $_ eq $capab } @{ $capabs };
  9732         19681  
  811         1797  
14000             }
14001              
14002             sub state_user_full {
14003 3143     3143 1 5948 my $self = shift;
14004 3143   50     7802 my $nick = shift || return;
14005 3143         5102 my $oper = shift;
14006 3143         5599 my $opuser = '';
14007 3143         4824 my $record;
14008 3143 100       11889 if ( $nick =~ m!^\d! ) {
14009 2545 50       6592 return if !$self->state_uid_exists($nick);
14010 2545         5663 $record = $self->{state}{uids}{$nick};
14011             }
14012             else {
14013 598 50       1842 return if !$self->state_nick_exists($nick);
14014 598         2029 $record = $self->{state}{users}{uc_irc($nick)};
14015             }
14016 3143 100 66     13197 if ( $oper && defined $record->{opuser} ) {
14017 1         15 $opuser = '{' . $record->{opuser} . '}';
14018             }
14019 3143         9975 return $record->{full}->() . $opuser;
14020             }
14021              
14022             sub state_user_nick {
14023 182     182 1 500 my $self = shift;
14024 182   50     859 my $nick = shift || return;
14025 182 100       947 if ( $nick =~ m!^\d! ) {
14026 110 100       534 return if !$self->state_uid_exists($nick);
14027 108         536 return $self->{state}{uids}{$nick}{nick};
14028             }
14029             else {
14030 72 100       327 return if !$self->state_nick_exists($nick);
14031 71         296 return $self->{state}{users}{uc_irc($nick)}{nick};
14032             }
14033             }
14034              
14035             sub state_user_uid {
14036 586     586 0 1264 my $self = shift;
14037 586   50     1928 my $nick = shift || return;
14038 586 100       2497 if ( $nick =~ m!^\d! ) {
14039 46 100       230 return if !$self->state_uid_exists($nick);
14040 42         180 return $self->{state}{uids}{$nick}{uid};
14041             }
14042             else {
14043 540 100       1515 return if !$self->state_nick_exists($nick);
14044 536         2452 return $self->{state}{users}{uc_irc($nick)}{uid};
14045             }
14046             }
14047              
14048             sub _state_user_ip {
14049 22     22   83 my $self = shift;
14050 22   50     102 my $nick = shift || return;
14051 22 50 33     119 return if !$self->state_nick_exists($nick)
14052             || !$self->_state_is_local_user($nick);
14053 22         413 my $record = $self->{state}{users}{uc_irc($nick)};
14054 22         304 return $record->{socket}[0];
14055             }
14056              
14057             sub _state_user_away {
14058 0     0   0 my $self = shift;
14059 0   0     0 my $nick = shift || return;
14060 0 0       0 return if !$self->state_nick_exists($nick);
14061 0 0       0 return 1 if defined $self->{state}{users}{uc_irc($nick)}{away};
14062 0         0 return 0;
14063             }
14064              
14065             sub _state_user_away_msg {
14066 17     17   48 my $self = shift;
14067 17   50     63 my $nick = shift || return;
14068 17 50       57 return if !$self->state_nick_exists($nick);
14069 17         60 return $self->{state}{users}{uc_irc($nick)}{away};
14070             }
14071              
14072             sub state_user_umode {
14073 77     77 1 218 my $self = shift;
14074 77   50     281 my $nick = shift || return;
14075 77 50       321 return if! $self->state_nick_exists($nick);
14076 77         277 return $self->{state}{users}{uc_irc($nick)}{umode};
14077             }
14078              
14079             sub state_user_is_operator {
14080 267     267 1 673 my $self = shift;
14081 267   50     937 my $nick = shift || return;
14082 267 50       1011 return if !$self->state_nick_exists($nick);
14083 267 100       1051 return 0 if $self->{state}{users}{uc_irc($nick)}{umode} !~ /o/;
14084 60         1304 return 1;
14085             }
14086              
14087             sub _state_user_is_deaf {
14088 31     31   53 my $self = shift;
14089 31   50     68 my $nick = shift || return;
14090 31 50       63 return if !$self->state_nick_exists($nick);
14091 31 50       74 return 0 if $self->{state}{users}{uc_irc($nick)}{umode} !~ /D/;
14092 0         0 return 1;
14093             }
14094              
14095             sub state_user_chans {
14096 117     117 1 322 my $self = shift;
14097 117   50     492 my $nick = shift || return;
14098 117 50       404 return if !$self->state_nick_exists($nick);
14099 117         525 my $record = $self->{state}{users}{uc_irc($nick)};
14100 2         18 return map { $self->{state}{chans}{$_}{name} }
14101 117         1353 keys %{ $record->{chans} };
  117         785  
14102             }
14103              
14104             sub _state_user_route {
14105 448     448   1095 my $self = shift;
14106 448   50     1578 my $nick = shift || return;
14107 448 50       1736 return if !$self->state_nick_exists($nick);
14108 448         1970 my $record = $self->{state}{users}{uc_irc($nick)};
14109 448         5823 return $record->{route_id};
14110             }
14111              
14112             sub _state_uid_route {
14113 621     621   1139 my $self = shift;
14114 621   50     1486 my $uid = shift || return;
14115 621 50       1624 return if !$self->state_uid_exists($uid);
14116 621         1325 my $record = $self->{state}{uids}{ $uid };
14117 621         1807 return $record->{route_id};
14118             }
14119              
14120             sub state_user_server {
14121 1     1 1 3 my $self = shift;
14122 1   50     4 my $nick = shift || return;
14123 1 50       5 return if !$self->state_nick_exists($nick);
14124 1         10 my $record = $self->{state}{users}{uc_irc($nick)};
14125 1         14 return $record->{server};
14126             }
14127              
14128             sub state_uid_sid {
14129 0     0 0 0 my $self = shift;
14130 0   0     0 my $uid = shift || return;
14131 0 0       0 return if !$self->state_uid_exists($uid);
14132 0         0 return substr( $uid, 0, 3 );
14133             }
14134              
14135             sub _state_peer_route {
14136 37     37   69 my $self = shift;
14137 37   50     195 my $peer = shift || return;
14138 37 50       119 return if !$self->state_peer_exists($peer);
14139 37         104 my $record = $self->{state}{peers}{uc $peer};
14140 37         236 return $record->{route_id};
14141             }
14142              
14143             sub _state_sid_route {
14144 463     463   980 my $self = shift;
14145 463   50     1228 my $sid = shift || return;
14146 463 50       1123 return if !$self->state_sid_exists($sid);
14147 463         1155 my $record = $self->{state}{sids}{$sid};
14148 463         2034 return $record->{route_id};
14149             }
14150              
14151             sub _state_connected_peers {
14152 2129     2129   5631 my $self = shift;
14153 2129         5812 my $server = uc $self->server_name();
14154 2129 50       3894 return if !keys %{ $self->{state}{peers} } > 1;
  2129         8666  
14155 2129         5250 my $record = $self->{state}{peers}{$server};
14156 3130         11946 return map { $record->{peers}{$_}{route_id} }
14157 2129         3639 keys %{ $record->{peers} };
  2129         7623  
14158             }
14159              
14160             sub state_chan_list {
14161 10     10 1 33 my $self = shift;
14162 10   50     34 my $chan = shift || return;
14163 10   50     59 my $status_msg = shift || '';
14164 10 50       33 return if !$self->state_chan_exists($chan);
14165              
14166 10         47 $status_msg =~ s/[^@%+]//g;
14167 10         45 my $record = $self->{state}{chans}{uc_irc($chan)};
14168 31         126 return map { $self->{state}{uids}{$_}{nick} }
14169 10 50       127 keys %{ $record->{users} } if !$status_msg;
  10         46  
14170              
14171 0         0 my %map = qw(o 3 h 2 v 1);
14172 0         0 my %sym = qw(@ 3 % 2 + 1);
14173 0         0 my $lowest = (sort map { $sym{$_} } split //, $status_msg)[0];
  0         0  
14174              
14175 0         0 return map { $self->{state}{uids}{$_}{nick} }
14176             grep {
14177 0         0 $record->{users}{ $_ } and (reverse sort map { $map{$_} }
14178 0 0       0 split //, $record->{users}{$_})[0] >= $lowest
14179 0         0 } keys %{ $record->{users} };
  0         0  
14180             }
14181              
14182             sub state_chan_list_prefixed {
14183 96     96 1 234 my $self = shift;
14184 96   50     354 my $chan = shift || return;
14185 96         215 my $flag = shift;
14186 96 50       357 return if !$self->state_chan_exists($chan);
14187 96         365 my $record = $self->{state}{chans}{uc_irc($chan)};
14188              
14189             return map {
14190 171         444 my $n = $self->{state}{uids}{$_}{nick};
14191 171 100 66     1180 $n = (($flag && $flag eq 'FULL') ? $self->state_user_full($_) : $n );
14192 171         441 my $m = $record->{users}{$_};
14193 171         319 my $p = '';
14194 171 100       688 $p = '@' if $m =~ /o/;
14195 171 100 100     836 $p = '%' if $m =~ /h/ && !$p;
14196 171 50 66     658 $p = '+' if $m =~ /v/ && !$p;
14197 171         953 $p . $n;
14198 96         1117 } keys %{ $record->{users} };
  96         497  
14199             }
14200              
14201             sub state_chan_list_multi_prefixed {
14202 75     75 0 174 my $self = shift;
14203 75   50     236 my $chan = shift || return;
14204 75         153 my $flag = shift;
14205 75 50       264 return if !$self->state_chan_exists($chan);
14206 75         259 my $record = $self->{state}{chans}{uc_irc($chan)};
14207              
14208             return map {
14209 1045         1732 my $rec = $self->{state}{uids}{$_};
14210 1045 100 100     3051 my $n = ( ($flag && $flag eq 'UIDS') ? $_ : $rec->{nick} );
14211 1045 100 100     2775 $n = (($flag && $flag eq 'FULL') ? $self->state_user_full($_) : $n );
14212 1045         2297 my $m = $record->{users}{$_};
14213 1045         1488 my $p = '';
14214 1045 100       2176 $p .= '@' if $m =~ /o/;
14215 1045 100       1839 $p .= '%' if $m =~ /h/;
14216 1045 100       1832 $p .= '+' if $m =~ /v/;
14217 1045         2432 $p . $n;
14218 75         1173 } keys %{ $record->{users} };
  75         639  
14219             }
14220              
14221             sub _state_chan_timestamp {
14222 1     1   3 my $self = shift;
14223 1   50     4 my $chan = shift || return;
14224 1 50       4 return if !$self->state_chan_exists($chan);
14225 1         4 return $self->{state}{chans}{uc_irc($chan)}{ts};
14226             }
14227              
14228             sub state_chan_topic {
14229 57     57 1 152 my $self = shift;
14230 57   50     208 my $chan = shift || return;
14231 57 50       224 return if !$self->state_chan_exists($chan);
14232 57         256 my $record = $self->{state}{chans}{uc_irc($chan)};
14233 57 50       925 return if !$record->{topic};
14234 0         0 return [@{ $record->{topic} }];
  0         0  
14235             }
14236              
14237             sub _state_is_local_user {
14238 28     28   96 my $self = shift;
14239 28   50     142 my $nick = shift || return;
14240 28         159 my $record = $self->{state}{sids}{uc $self->server_sid()};
14241 28 50       257 if ( $nick =~ m!^\d! ) {
14242 0 0       0 return if !$self->state_uid_exists($nick);
14243 0 0       0 return 1 if defined $record->{uids}{$nick};
14244             }
14245             else {
14246 28 50       138 return if !$self->state_nick_exists($nick);
14247 28 50       130 return 1 if defined $record->{users}{uc_irc($nick)};
14248             }
14249 0         0 return 0;
14250             }
14251              
14252             sub _state_is_local_uid {
14253 3274     3274   4728 my $self = shift;
14254 3274   50     6231 my $uid = shift || return;
14255 3274 50       5588 return if !$self->state_uid_exists($uid);
14256 3274 100       6013 return 1 if $self->server_sid() eq substr( $uid, 0, 3 );
14257 3245         6092 return 0;
14258             }
14259              
14260             sub _state_chan_name {
14261 211     211   484 my $self = shift;
14262 211   50     676 my $chan = shift || return;
14263 211 50       652 return if !$self->state_chan_exists($chan);
14264 211         738 return $self->{state}{chans}{uc_irc($chan)}{name};
14265             }
14266              
14267             sub state_chan_mode_set {
14268 69     69 1 187 my $self = shift;
14269 69   50     262 my $chan = shift || return;
14270 69   50     295 my $mode = shift || return;
14271 69 50       247 return if !$self->state_chan_exists($chan);
14272              
14273 69         352 $mode =~ s/[^a-zA-Z]+//g;
14274 69 50       315 $mode = (split //, $mode )[0] if length $mode > 1;
14275 69         265 my $record = $self->{state}{chans}{uc_irc($chan)};
14276 69 100       1585 return 1 if $record->{mode} =~ /$mode/;
14277 65         368 return 0;
14278             }
14279              
14280             sub _state_user_invited {
14281 4     4   366 my $self = shift;
14282 4   50     16 my $nick = shift || return;
14283 4   50     12 my $chan = shift || return;
14284 4 50       16 return if !$self->state_nick_exists($nick);
14285 4 50       14 return 0 if !$self->state_chan_exists($chan);
14286 4         15 my $nickrec = $self->{state}{users}{uc_irc($nick)};
14287 4 100       52 return 1 if $nickrec->{invites}{uc_irc($chan)};
14288             # Check if user matches INVEX
14289 3 50       63 return 1 if $self->_state_user_matches_list($nick, $chan, 'invex');
14290 3         15 return 0;
14291             }
14292              
14293             sub _state_user_banned {
14294 69     69   172 my $self = shift;
14295 69   50     290 my $nick = shift || return;
14296 69   50     305 my $chan = shift || return;
14297 69 50       305 return 0 if !$self->_state_user_matches_list($nick, $chan, 'bans');
14298 0 0       0 return 1 if !$self->_state_user_matches_list($nick, $chan, 'excepts');
14299 0         0 return 0;
14300             }
14301              
14302             sub _state_user_matches_list {
14303 72     72   159 my $self = shift;
14304 72   50     246 my $nick = shift || return;
14305 72   50     257 my $chan = shift || return;
14306 72   50     267 my $list = shift || 'bans';
14307 72 50       224 return if !$self->state_nick_exists($nick);
14308 72 50       232 return 0 if !$self->state_chan_exists($chan);
14309 72         271 my $full = $self->state_user_full($nick);
14310 72         271 my $record = $self->{state}{chans}{uc_irc($chan)};
14311              
14312 72         864 for my $mask (keys %{ $record->{$list} }) {
  72         362  
14313 3 50       84 return 1 if matches_mask($mask, $full);
14314             }
14315 72         479 return 0;
14316             }
14317              
14318             sub state_is_chan_member {
14319 383     383 1 805 my $self = shift;
14320 383   50     1435 my $nick = shift || return;
14321 383   50     1028 my $chan = shift || return;
14322 383 50       1367 return if !$self->state_nick_exists($nick);
14323 383 50       1005 return 0 if !$self->state_chan_exists($chan);
14324 383         1107 my $record = $self->{state}{users}{uc_irc($nick)};
14325 383 100       4459 return 1 if defined $record->{chans}{uc_irc($chan)};
14326 72         982 return 0;
14327             }
14328              
14329             sub state_uid_chan_member {
14330 2     2 0 7 my $self = shift;
14331 2   50     30 my $uid = shift || return;
14332 2   50     9 my $chan = shift || return;
14333 2 50       8 return if !$self->state_uid_exists($uid);
14334 2 50       8 return 0 if !$self->state_chan_exists($chan);
14335 2         7 my $record = $self->{state}{uids}{$uid};
14336 2 50       9 return 1 if defined $record->{chans}{uc_irc($chan)};
14337 0         0 return 0;
14338             }
14339             sub state_user_chan_mode {
14340 0     0 1 0 my $self = shift;
14341 0   0     0 my $nick = shift || return;
14342 0   0     0 my $chan = shift || return;
14343 0 0       0 return if !$self->state_is_chan_member($nick, $chan);
14344 0         0 return $self->{state}{users}{uc_irc($nick)}{chans}{uc_irc($chan)};
14345             }
14346              
14347             sub state_is_chan_op {
14348 64     64 1 266 my $self = shift;
14349 64   50     243 my $nick = shift || return;
14350 64   50     255 my $chan = shift || return;
14351 64 50       282 return if !$self->state_is_chan_member($nick, $chan);
14352 64         1012 my $record = $self->{state}{users}{uc_irc($nick)};
14353 64 100       840 return 1 if $record->{chans}{uc_irc($chan)} =~ /o/;
14354 14 50 33     227 return 1 if $self->{config}{OPHACKS} && $record->{umode} =~ /o/;
14355 14         72 return 0;
14356             }
14357              
14358             sub state_is_chan_hop {
14359 55     55 1 137 my $self = shift;
14360 55   50     245 my $nick = shift || return;
14361 55   50     254 my $chan = shift || return;
14362 55 50       199 return if !$self->state_is_chan_member($nick, $chan);
14363 55         814 my $record = $self->{state}{users}{uc_irc($nick)};
14364 55 100       694 return 1 if $record->{chans}{uc_irc($chan)} =~ /h/;
14365 34         518 return 0;
14366             }
14367              
14368             sub state_has_chan_voice {
14369 0     0 1 0 my $self = shift;
14370 0   0     0 my $nick = shift || return;
14371 0   0     0 my $chan = shift || return;
14372 0 0       0 return if !$self->state_is_chan_member($nick, $chan);
14373 0         0 my $record = $self->{state}{users}{uc_irc($nick)};
14374 0 0       0 return 1 if $record->{chans}{uc_irc($chan)} =~ /v/;
14375 0         0 return 0;
14376             }
14377              
14378             sub _state_o_line {
14379 25     25   81 my $self = shift;
14380 25   50     157 my $nick = shift || return;
14381 25         113 my ($user, $pass) = @_;
14382 25 50       95 return if !$self->state_nick_exists($nick);
14383 25 50 33     278 return if !$user || !$pass;
14384              
14385 25         108 my $ops = $self->{config}{ops};
14386 25 100       115 return if !$ops->{$user};
14387 24 50       218 return -1 if !chkpasswd ($pass, $ops->{$user}{password});
14388              
14389 24 100       170276 if ($ops->{$user}{ssl_required}) {
14390 6 100       47 return -2 if $self->{state}{users}{uc_irc $nick}{umode} !~ /S/;
14391             }
14392              
14393 23 100       294 if ($ops->{$user}{certfp}) {
14394 4         20 my $certfp = $self->{state}{users}{uc_irc $nick}{certfp};
14395 4 100 66     87 if (!$certfp || uc($certfp) ne uc($ops->{$user}{certfp})) {
14396 1         6 return -3;
14397             }
14398             }
14399              
14400 22         166 my $client_ip = $self->_state_user_ip($nick);
14401 22 50       130 return if !$client_ip;
14402 22 50 33     377 if (!$ops->{$user}{ipmask} && ($client_ip && $client_ip =~ /^(127\.|::1)/)) {
      33        
14403 22         101 return 1;
14404             }
14405 0 0       0 return 0 if !$ops->{$user}{ipmask};
14406              
14407 0 0       0 if (ref $ops->{$user}{ipmask} eq 'ARRAY') {
14408 0         0 for my $block (@{ $ops->{$user}{ipmask} }) {
  0         0  
14409 0 0       0 if ( eval { $block->isa('Net::Netmask') } ) {
  0         0  
14410 0 0       0 return 1 if $block->match($client_ip);
14411 0         0 next;
14412             }
14413 0 0       0 return 1 if Net::CIDR::cidrlookup( $client_ip, $block );
14414             }
14415             }
14416 0 0       0 return 1 if matches_mask($ops->{$user}{ipmask}, $client_ip);
14417 0         0 return 0;
14418             }
14419              
14420             sub _state_users_share_chan {
14421 0     0   0 my $self = shift;
14422 0   0     0 my $nick1 = shift || return;
14423 0   0     0 my $nick2 = shift || return;
14424 0 0 0     0 return if !$self->state_nick_exists($nick1)
14425             || !$self->state_nick_exists($nick2);
14426 0         0 my $rec1 = $self->{state}{users}{uc_irc($nick1)};
14427 0         0 my $rec2 = $self->{state}{users}{uc_irc($nick2)};
14428 0         0 for my $chan (keys %{ $rec1->{chans} }) {
  0         0  
14429 0 0       0 return 1 if $rec2->{chans}{$chan};
14430             }
14431 0         0 return 0;
14432             }
14433              
14434             sub _state_parse_msg_targets {
14435 38     38   116 my $self = shift;
14436 38   50     164 my $targets = shift || return;
14437 38         88 my %results;
14438              
14439 38         189 for my $target (split /,/, $targets) {
14440 38 100       236 if ($target =~ /^[#&]/) {
14441 18         71 $results{$target} = ['channel'];
14442 18         53 next;
14443             }
14444 20 50       114 if ($target =~ /^([@%+]+)([#&].+)$/ ) {
14445 0         0 $results{$target} = ['channel_ext', $1, $2];
14446 0         0 next;
14447             }
14448 20 100       88 if ( $target =~ /^\$([^#].+)$/ ) {
14449 1         7 $results{$target} = ['servermask', $1];
14450 1         3 next;
14451             }
14452 19 100       120 if ( $target =~ /^\$#(.+)$/ ) {
14453 1         5 $results{$target} = ['hostmask', $1];
14454 1         3 next;
14455             }
14456 18 50       175 if ($target =~ /@/ ) {
14457 0         0 my ($nick, $server) = split /@/, $target, 2;
14458 0         0 my $host;
14459 0 0       0 ($nick, $host) = split ( /%/, $nick, 2 ) if $nick =~ /%/;
14460 0         0 $results{$target} = ['nick_ext', $nick, $server, $host];
14461 0         0 next;
14462             }
14463 18 100       134 if ($target =~ $uid_re) {
14464 4         20 $results{$target} = ['uid'];
14465 4         11 next;
14466             }
14467 14         74 $results{$target} = ['nick'];
14468             }
14469              
14470 38         179 return \%results;
14471             }
14472              
14473             sub server_name {
14474 13982     13982 1 42646 return $_[0]->{config}{'SERVERNAME'};
14475             }
14476              
14477             sub server_version {
14478 233     233 1 892 return $_[0]->{config}{'VERSION'};
14479             }
14480              
14481             sub server_sid {
14482 9281     9281 0 26503 return $_[0]->{config}{'SID'};
14483             }
14484              
14485             sub server_created {
14486 227     227 1 1407 return strftime("This server was created %a %h %d %Y at %H:%M:%S %Z",
14487             localtime($_[0]->server_config('created')));
14488             }
14489              
14490             sub _client_nickname {
14491 3834     3834   6752 my $self = shift;
14492 3834   50     9712 my $wheel_id = $_[0] || return;
14493 3834 100       12145 return '*' if !$self->{state}{conns}{$wheel_id}{nick};
14494 3616         9360 return $self->{state}{conns}{$wheel_id}{nick};
14495             }
14496              
14497             sub _client_uid {
14498 801     801   1863 my $self = shift;
14499 801   50     2573 my $wheel_id = $_[0] || return;
14500 801 50       3142 return '*' if !$self->{state}{conns}{$wheel_id}{uid};
14501 801         2169 return $self->{state}{conns}{$wheel_id}{uid};
14502             }
14503              
14504             sub _client_ip {
14505 240     240   749 my $self = shift;
14506 240   50     1155 my $wheel_id = shift || return '';
14507 240         2476 return $self->{state}{conns}{$wheel_id}{socket}[0];
14508             }
14509              
14510             sub server_config {
14511 1308     1308 1 2896 my $self = shift;
14512 1308   50     3828 my $value = shift || return;
14513 1308         31806 return $self->{config}{uc $value};
14514             }
14515              
14516             sub configure {
14517 184     184 1 5419 my $self = shift;
14518 184 100       1531 my $opts = ref $_[0] eq 'HASH' ? $_[0] : { @_ };
14519 184         2035 $opts->{uc $_} = delete $opts->{$_} for keys %$opts;
14520              
14521             my %defaults = (
14522             CREATED => time(),
14523             CASEMAPPING => 'rfc1459',
14524             SERVERNAME => 'poco.server.irc',
14525             SERVERDESC => 'Poco? POCO? POCO!',
14526 184         780 VERSION => do {
14527 182     182   4072 no strict 'vars';
  182         623  
  182         1603583  
14528 184 50       8178 ref($self) . '-' . (defined $VERSION ? $VERSION : 'dev-git');
14529             },
14530             NETWORK => 'poconet',
14531             NETWORKDESC => 'poco mcpoconet',
14532             HOSTLEN => 63,
14533             NICKLEN => 9,
14534             USERLEN => 10,
14535             REALLEN => 50,
14536             KICKLEN => 120,
14537             TOPICLEN => 80,
14538             AWAYLEN => 160,
14539             CHANNELLEN => 50,
14540             PASSWDLEN => 20,
14541             KEYLEN => 23,
14542             MAXCHANNELS => 15, # Think this is called CHANLIMIT now
14543             MAXACCEPT => 20,
14544             MODES => 4,
14545             MAXTARGETS => 4,
14546             MAXCLIENTS => 512,
14547             MAXBANS => 50,
14548             MAXBANLENGTH => 1024,
14549             AUTH => 1,
14550             ANTIFLOOD => 1,
14551             OPHACKS => 0,
14552             JOIN_LEAVE_COUNT_EXPIRE => 120,
14553             OPER_SPAM_COUNTDOWN => 5,
14554             MAX_JOIN_LEAVE_COUNT => 25,
14555             MIN_JOIN_LEAVE_TIME => 60,
14556             knock_client_count => 1,
14557             knock_client_time => 5 * 60,
14558             knock_delay_channel => 60,
14559             pace_wait => 10,
14560             max_watch => 50,
14561             max_bans_large => 500,
14562             oper_umode => 'aceklnswy',
14563             anti_spam_exit_message_time => 5 * 60,
14564             anti_nick_flood => 1,
14565             max_nick_time => 20,
14566             max_nick_changes => 5,
14567             floodcount => 10,
14568             floodtime => 1,
14569             joinfloodcount => 18,
14570             joinfloodtime => 6,
14571             hidden_servers => '',
14572             hidden => '',
14573             );
14574 184         5424 $self->{config}{$_} = $defaults{$_} for keys %defaults;
14575              
14576 184         1153 for my $opt (qw(HOSTLEN NICKLEN USERLEN REALLEN TOPICLEN CHANNELLEN
14577             PASSWDLEN KEYLEN MAXCHANNELS MAXACCEPT MODES MAXTARGETS MAXBANS)) {
14578 2392         3832 my $new = delete $opts->{$opt};
14579 2392 50 33     5811 if (defined $new && $new > $self->{config}{$opt}) {
14580 0         0 $self->{config}{$opt} = $new;
14581             }
14582             }
14583              
14584 184         614 for my $opt (qw(KICKLEN AWAYLEN)) {
14585 368         887 my $new = delete $opts->{$opt};
14586 368 50 33     1384 if (defined $new && $new < $self->{config}{$opt}) {
14587 0         0 $self->{config}{$opt} = $new;
14588             }
14589             }
14590              
14591 184         676 for my $opt (keys %$opts) {
14592 471 100       2722 next if $opt !~ m!^(knock_|pace_|max_watch|max_bans_|oper_umode|max_nick|anti_|flood|hidden)!i;
14593             $self->{config}{lc $opt} = delete $opts->{$opt}
14594 127 50       907 if defined $opts->{$opt};
14595             }
14596              
14597 184         1057 $self->{config}{oper_umode} =~ s/[^DFGHRSWXabcdefgijklnopqrsuwy]+//g;
14598 184         668 $self->{config}{oper_umode} =~ s/[SWori]+//g;
14599              
14600 184         685 for my $opt (keys %$opts) {
14601 344 50       1470 $self->{config}{$opt} = $opts->{$opt} if defined $opts->{$opt};
14602             }
14603              
14604             {
14605 184         478 my $sid = delete $self->{config}{SID};
  184         608  
14606 184 100 66     2789 if (!$sid || $sid !~ $sid_re) {
14607 2         121 warn "No SID or SID is invalid, generating a random one\n";
14608 2         23 $self->_state_rand_sid();
14609             }
14610             else {
14611 182         895 $self->{config}{SID} = uc $sid;
14612             }
14613             }
14614              
14615             $self->{config}{BANLEN}
14616 184         610 = sum(@{ $self->{config} }{qw(NICKLEN USERLEN HOSTLEN)}, 3);
  184         1720  
14617             $self->{config}{USERHOST_REPLYLEN}
14618 184         576 = sum(@{ $self->{config} }{qw(NICKLEN USERLEN HOSTLEN)}, 5);
  184         2264  
14619              
14620 184         850 $self->{config}{SERVERNAME} =~ s/[^a-zA-Z0-9\-.]//g;
14621 184 50       1411 if ($self->{config}{SERVERNAME} !~ /\./) {
14622 0         0 $self->{config}{SERVERNAME} .= '.';
14623             }
14624              
14625 184 0 33     1531 if (!defined $self->{config}{ADMIN}
      33        
14626             || ref $self->{config}{ADMIN} ne 'ARRAY'
14627 0         0 || @{ $self->{config}{ADMIN} } != 3) {
14628 184         668 $self->{config}{ADMIN} = [];
14629 184         624 $self->{config}{ADMIN}[0] = 'Somewhere, Somewhere, Somewhere';
14630 184         586 $self->{config}{ADMIN}[1] = 'Some Institution';
14631 184         545 $self->{config}{ADMIN}[2] = 'someone@somewhere';
14632             }
14633              
14634 184 0 33     1211 if (!defined $self->{config}{INFO}
      33        
14635             || ref $self->{config}{INFO} ne 'ARRAY'
14636 0         0 || !@{ $self->{config}{INFO} } == 1) {
14637 184         1941 $self->{config}{INFO} = [split /\n/, <<'EOF'];
14638             # POE::Component::Server::IRC
14639             #
14640             # Author: Chris "BinGOs" Williams
14641             #
14642             # Filter-IRCD Written by Hachi
14643             #
14644             # This module may be used, modified, and distributed under the same
14645             # terms as Perl itself. Please see the license that came with your Perl
14646             # distribution for details.
14647             #
14648             EOF
14649             }
14650              
14651             $self->{Error_Codes} = {
14652 184         17180 263 => [1, "Server load is temporarily too heavy. Please wait a while and try again."],
14653             401 => [1, "No such nick/channel"],
14654             402 => [1, "No such server"],
14655             403 => [1, "No such channel"],
14656             404 => [1, "Cannot send to channel"],
14657             405 => [1, "You have joined too many channels"],
14658             406 => [1, "There was no such nickname"],
14659             407 => [1, "Too many targets"],
14660             408 => [1, "You cannot use control codes on this channel"],
14661             409 => [0, "No origin specified"],
14662             410 => [1, "Invalid CAP subcommand"],
14663             411 => [0, "No recipient given (%s)"],
14664             412 => [0, "No text to send"],
14665             413 => [1, "No toplevel domain specified"],
14666             414 => [1, "Wildcard in toplevel domain"],
14667             415 => [1, "Bad server/host mask"],
14668             421 => [1, "Unknown command"],
14669             422 => [0, "MOTD File is missing"],
14670             423 => [1, "No administrative info available"],
14671             424 => [1, "File error doing % on %"],
14672             431 => [1, "No nickname given"],
14673             432 => [1, "Erroneous nickname"],
14674             433 => [1, "Nickname is already in use"],
14675             436 => [1, "Nickname collision KILL from %s\@%s"],
14676             437 => [1, "Nick/channel is temporarily unavailable"],
14677             438 => [1, "Nick change too fast. Please wait %s seconds."],
14678             440 => [1, "Services are currently unavailable."],
14679             441 => [1, "They aren\'t on that channel"],
14680             442 => [1, "You\'re not on that channel"],
14681             443 => [2, "is already on channel"],
14682             444 => [1, "User not logged in"],
14683             445 => [0, "SUMMON has been disabled"],
14684             446 => [0, "USERS has been disabled"],
14685             447 => [0, "Cannot change nickname while on %s (+N)"],
14686             451 => [0, "You have not registered"],
14687             461 => [1, "Not enough parameters"],
14688             462 => [0, "Unauthorised command (already registered)"],
14689             463 => [0, "Your host isn\'t among the privileged"],
14690             464 => [0, "Password incorrect"],
14691             465 => [0, "You are banned from this server"],
14692             466 => [0, "You will be banned from this server"],
14693             467 => [1, "Channel key already set"],
14694             471 => [1, "Cannot join channel (+l)"],
14695             472 => [1, "is unknown mode char to me for %s"],
14696             473 => [1, "Cannot join channel (+i)"],
14697             474 => [1, "Cannot join channel (+b)"],
14698             475 => [1, "Cannot join channel (+k)"],
14699             476 => [1, "Bad Channel Mask"],
14700             477 => [1, "You need to identify to a registered nick to join or speak in that channel."],
14701             478 => [2, "Channel list is full"],
14702             481 => [0, "Permission Denied- You\'re not an IRC operator"],
14703             482 => [1, "You\'re not channel operator"],
14704             483 => [0, "You can\'t kill a server!"],
14705             484 => [0, "Your connection is restricted!"],
14706             485 => [1, "Cannot join channel (%s)"],
14707             489 => [1, "Cannot join channel (+S) - SSL/TLS required"],
14708             491 => [0, "Only few of mere mortals may try to enter the twilight zone"],
14709             492 => [1, "You cannot send CTCPs to this channel."],
14710             501 => [0, "Unknown MODE flag"],
14711             502 => [0, "Cannot change mode for other users"],
14712             512 => [0, "Maximum size for WATCH-list is %s entries"],
14713             520 => [1, "Cannot join channel (+O)"],
14714             521 => [0, "Bad list syntax"],
14715             524 => [1, "Help not found"],
14716             710 => [2, "has asked for an invite."],
14717             711 => [1, "Your KNOCK has been delivered."],
14718             712 => [1, "Too many KNOCKs (%s)."],
14719             713 => [1, "Channel is open."],
14720             714 => [1, "You are already on that channel."],
14721             723 => [1, "Insufficient oper privileges."],
14722             };
14723              
14724             $self->{config}{isupport} = {
14725             INVEX => 'I',
14726             EXCEPTS => 'e',
14727             CALLERID => undef,
14728             CHANTYPES => '#&',
14729             KNOCK => undef,
14730             PREFIX => '(ohv)@%+',
14731             CHANMODES => 'beI,k,l,cimnprstuCLMNORST',
14732             STATUSMSG => '@%+',
14733             DEAF => 'D',
14734             MAXLIST => 'beI:' . $self->{config}{MAXBANS},
14735             SAFELIST => undef,
14736             ELIST => 'CMNTU',
14737 184         1829 map { ($_, $self->{config}{$_}) }
  1656         6603  
14738             qw(MAXCHANNELS MAXTARGETS NICKLEN TOPICLEN KICKLEN CASEMAPPING
14739             NETWORK MODES AWAYLEN),
14740             };
14741              
14742 184         1369 $self->{config}{capab} = [qw(KNOCK DLN TBURST UNDLN ENCAP UNKLN KLN RHOST SVS CLUSTER EOB QS)];
14743              
14744 184         15836 $self->{config}{cmds}{uc $_}++ for
14745             qw[accept admin away bmask cap close connect die dline encap eob etrace globops info invite ison isupport join kick kill],
14746             qw[kline knock links list locops lusers map message mode motd names nick oper part pass ping pong quit rehash remove],
14747             qw[resv rkline set sid sjoin squit stats summon svinfo svshost svsjoin svskill svsmode svsnick svspart svstag tburst time],
14748             qw[tmode topic trace uid umode undline unkline unresv unrkline unxline user userhost users version wallops watch who whois whowas xline];
14749              
14750 184         1653 return 1;
14751             }
14752              
14753             sub _send_to_realops {
14754 2155     2155   4726 my $self = shift;
14755 2155   50     6499 my $msg = shift || return;
14756 2155   100     5658 my $type = shift || 'Notice';
14757 2155         3799 my $flags = shift; # Future use
14758 2155         5242 my $server = $self->server_name();
14759 2155 100       9344 $flags =~ s/[^a-zA-Z]+//g if $flags;
14760              
14761 2155         9570 my %types = (
14762             NOTICE => 'Notice',
14763             LOCOPS => 'LocOps',
14764             GLOBOPS => 'Global',
14765             );
14766              
14767             my $notice =
14768 2155   50     11230 sprintf('*** %s -- %s', ( $types{uc $type} || 'Notice' ), $msg );
14769              
14770 2155         4311 my @locops;
14771              
14772 2155 100       5492 if ( $flags ) {
14773 34         742 @locops = grep { $self->{state}{conns}{$_}{umode} =~ m![$flags]! }
14774 2099         3629 keys %{ $self->{state}{localops} };
  2099         7385  
14775             }
14776             else {
14777 56         155 @locops = keys %{ $self->{state}{localops} };
  56         360  
14778             }
14779              
14780 2155         9842 $self->send_event( 'daemon_snotice', $notice );
14781              
14782 2155         290982 $self->send_output(
14783             {
14784             prefix => $server,
14785             command => 'NOTICE',
14786             params => [
14787             '*',
14788             $notice,
14789             ],
14790             },
14791             @locops,
14792             );
14793 2155         9035 return 1;
14794             }
14795              
14796             sub _send_output_to_client {
14797 2491     2491   5165 my $self = shift;
14798 2491   50     6268 my $wheel_id = shift || return 0;
14799 2491         6477 my $nick = $self->_client_nickname($wheel_id);
14800 2491         5956 my $prefix = $self->server_name();
14801 2491 100       6690 if ( $self->_connection_is_peer($wheel_id) ) {
14802 34         48 $nick = shift;
14803 34         55 $prefix = $self->server_sid();
14804             }
14805 2491   50     6561 my $err = shift || return 0;
14806 2491 50       5236 return if !$self->_connection_exists($wheel_id);
14807              
14808             SWITCH: {
14809 2491 100       4290 if (ref $err eq 'HASH') {
  2491         6763  
14810 2428         8990 $self->send_output($err, $wheel_id);
14811 2428         5704 last SWITCH;
14812             }
14813 63 50       338 if (defined $self->{Error_Codes}{$err}) {
14814 63         274 my $input = {
14815             command => $err,
14816             prefix => $self->server_name(),
14817             params => [$nick],
14818             };
14819 63 100       370 if ($self->{Error_Codes}{$err}[0] > 0) {
14820 41         235 for (my $i = 1; $i <= $self->{Error_Codes}{$err}[0]; $i++) {
14821 41         97 push @{ $input->{params} }, shift;
  41         207  
14822             }
14823             }
14824 63 100       386 if ($self->{Error_Codes}{$err}[1] =~ /%/) {
14825 6         60 push @{ $input->{params} },
14826 6         17 sprintf($self->{Error_Codes}{$err}[1], @_);
14827             }
14828             else {
14829 57         145 push @{ $input->{params} }, $self->{Error_Codes}{$err}[1];
  57         217  
14830             }
14831 63         361 $self->send_output($input, $wheel_id);
14832             }
14833             }
14834              
14835 2491         6414 return 1;
14836             }
14837              
14838             sub _send_output_channel_local {
14839 202     202   530 my $self = shift;
14840 202   50     696 my $channel = shift || return;
14841 202 50       666 return if !$self->state_chan_exists($channel);
14842 202         699 my ($output,$conn_id,$status,$poscap,$negcap) = @_;
14843 202 50       645 return if !$output;
14844 202         598 my $sid = $self->server_sid();
14845              
14846 202 100       839 my $is_msg = ( $output->{command} =~ m!^(PRIVMSG|NOTICE)$! ? 1 : 0 );
14847 202         691 my $chanrec = $self->{state}{chans}{uc_irc($channel)};
14848 202         2254 my @targs;
14849 202 100       615 my $negative = ( $status ? $status =~ s!^\-!! : '' );
14850 202         393 UID: foreach my $uid ( keys %{ $chanrec->{users} } ) {
  202         1300  
14851 776 100       3700 next if $uid !~ m!^$sid!;
14852 437         1372 my $route_id = $self->_state_uid_route( $uid );
14853 437 100 100     1841 if ( $conn_id && $conn_id eq $route_id ) {
14854 127         350 next UID;
14855             }
14856 310 100       771 if ( $status ) {
14857 21         35 my $matched;
14858 21         58 STATUS: foreach my $stat ( split //, $status ) {
14859 42 100       442 $matched++ if $chanrec->{users}{$uid} =~ m!$stat!;
14860             }
14861 21 100 100     160 next UID if ( $negative && $matched ) || ( !$negative && !$matched );
      100        
      100        
14862             }
14863 301 100       843 if ( $poscap ) {
14864 89 50       204 foreach my $cap ( @{ ref $poscap eq 'ARRAY' ? $poscap : [ $poscap ] } ) {
  89         426  
14865 89 100       437 next UID if !$self->{state}{uids}{$uid}{caps}{$cap};
14866             }
14867             }
14868 225 100       633 if ( $negcap ) {
14869 91 100       216 foreach my $cap ( @{ ref $negcap eq 'ARRAY' ? $negcap : [ $negcap ] } ) {
  91         443  
14870 94 100       447 next UID if $self->{state}{uids}{$uid}{caps}{$cap};
14871             }
14872             }
14873 210 50 66     690 if ( $is_msg && $self->{state}{uids}{$uid}{umode} =~ m!D! ) { # +D 'deaf'
14874 0         0 next UID;
14875             }
14876             # Default
14877 210         591 push @targs, $route_id;
14878             }
14879              
14880 202         1064 $self->send_output($output,@targs);
14881              
14882 202         483 my $spoofs = grep { $_ eq 'spoofed' } @targs;
  210         632  
14883              
14884             $self->send_event(
14885             "daemon_" . lc $output->{command},
14886             $output->{prefix},
14887 202 100 66     1198 @{ $output->{params} },
  196         1095  
14888             ) if !$is_msg || $spoofs;
14889              
14890 202         24359 return 1;
14891             }
14892              
14893             sub _duration {
14894 227     227   584 my $duration = shift;
14895 227 50 33     3101 $duration = 0 if !defined $duration || $duration !~ m!^\d+$!;
14896 227         578 my $timestr;
14897 227         664 my $days = my $hours = my $mins = my $secs = 0;
14898 227         1128 while ($duration >= 60 * 60 * 24) {
14899 0         0 $duration -= 60 * 60 * 24;
14900 0         0 ++$days;
14901             }
14902 227         888 while ($duration >= 60 * 60) {
14903 0         0 $duration -= 60 * 60;
14904 0         0 ++$hours;
14905             }
14906 227         858 while ($duration >= 60) {
14907 0         0 $duration -= 60;
14908 0         0 ++$mins;
14909             }
14910 227         641 $secs = $duration;
14911 227 50       3543 return sprintf(
14912             '%u day%s, %02u:%02u:%02u',
14913             $days, ($days == 1 ? '' : 's'), $hours, $mins, $secs,
14914             );
14915             }
14916              
14917             sub add_operator {
14918 30     30 1 365 my $self = shift;
14919 30         79 my $ref;
14920 30 50       203 if (ref $_[0] eq 'HASH') {
14921 30         108 $ref = $_[0];
14922             }
14923             else {
14924 0         0 $ref = { @_ };
14925             }
14926 30         274 $ref->{lc $_} = delete $ref->{$_} for keys %$ref;
14927              
14928 30 50 33     398 if (!defined $ref->{username} || !defined $ref->{password}) {
14929 0         0 warn "Not enough parameters\n";
14930 0         0 return;
14931             }
14932              
14933 30 50 66     413 if (($ref->{ssl_required} || $ref->{certfp}) && !$self->{got_ssl}) {
      66        
14934 0         0 warn "SSL required, but it is not supported, ignoring\n";
14935 0         0 delete $ref->{ssl_required};
14936 0         0 delete $ref->{certfp};
14937             }
14938              
14939 30 50 33     199 if ( $ref->{ipmask} && $ref->{ipmask} eq 'ARRAY' ) {
14940 0         0 my @validated;
14941 0         0 foreach my $mask ( @{ $ref->{ipmask} } ) {
  0         0  
14942 0 0       0 if ( eval { $mask->isa('Net::Netmask' ) } ) {
  0         0  
14943 0         0 push @validated, $mask;
14944 0         0 next;
14945             }
14946 0         0 my $valid = Net::CIDR::cidrvalidate($mask);
14947 0 0       0 push @validated, $valid if $valid;
14948             }
14949 0         0 $ref->{ipmask} = \@validated;
14950             }
14951              
14952 30 100       176 if ( $ref->{umode} ) {
14953 28         180 $ref->{umode} =~ s/[^DFGHRSWXabcdefgijklnopqrsuwy]+//g;
14954 28         98 $ref->{umode} =~ s/[SWori]+//g;
14955             }
14956              
14957 30         196 my $record = $self->{state}{peers}{uc $self->server_name()};
14958 30         92 my $user = delete $ref->{username};
14959 30         137 $self->{config}{ops}{$user} = $ref;
14960 30         134 return 1;
14961             }
14962              
14963             sub del_operator {
14964 0     0 1 0 my $self = shift;
14965 0   0     0 my $user = shift || return;
14966 0 0       0 return if !defined $self->{config}{ops}{$user};
14967 0         0 delete $self->{config}{ops}{$user};
14968 0         0 return;
14969             }
14970              
14971             sub add_service {
14972 46     46 1 339 my $self = shift;
14973 46   50     243 my $host = shift || return;
14974 46         241 $self->{state}{services}{uc $host} = $host;
14975 46         134 return 1;
14976             }
14977              
14978             sub del_service {
14979 0     0 1 0 my $self = shift;
14980 0   0     0 my $host = shift || return;
14981 0         0 delete $self->{state}{services}{uc $host};
14982 0         0 return 1;
14983             }
14984              
14985             sub add_auth {
14986 6     6 1 3417 my $self = shift;
14987 6         21 my $parms;
14988 6 50       42 if (ref $_[0] eq 'HASH') {
14989 0         0 $parms = $_[0];
14990             }
14991             else {
14992 6         41 $parms = { @_ };
14993             }
14994 6         63 $parms->{lc $_} = delete $parms->{$_} for keys %$parms;
14995              
14996 6 50       30 if (!$parms->{mask}) {
14997 0         0 warn "Not enough parameters specified\n";
14998 0         0 return;
14999             }
15000 6         12 push @{ $self->{config}{auth} }, $parms;
  6         27  
15001 6         17 return 1;
15002             }
15003              
15004             sub del_auth {
15005 0     0 1 0 my $self = shift;
15006 0   0     0 my $mask = shift || return;
15007 0         0 my $i = 0;
15008              
15009 0         0 for (@{ $self->{config}{auth} }) {
  0         0  
15010 0 0       0 if ($_->{mask} eq $mask) {
15011 0         0 splice( @{ $self->{config}{auth} }, $i, 1 );
  0         0  
15012 0         0 last;
15013             }
15014 0         0 ++$i;
15015             }
15016 0         0 return;
15017             }
15018              
15019             sub add_peer {
15020 290     290 1 115384 my $self = shift;
15021 290         599 my $parms;
15022 290 50       1106 if (ref $_[0] eq 'HASH') {
15023 0         0 $parms = $_[0];
15024             }
15025             else {
15026 290         1749 $parms = { @_ };
15027             }
15028 290         2758 $parms->{lc $_} = delete $parms->{$_} for keys %$parms;
15029              
15030 290 50 33     2995 if (!defined $parms->{name} || !defined $parms->{pass}
      33        
15031             || !defined $parms->{rpass}) {
15032 0         0 croak((caller(0))[3].": Not enough parameters specified\n");
15033 0         0 return;
15034             }
15035              
15036 290 100 66     1999 $parms->{type} = 'c' if !$parms->{type} || lc $parms->{type} ne 'r';
15037 290         796 $parms->{type} = lc $parms->{type};
15038 290 50 66     1240 $parms->{rport} = 6667 if $parms->{type} eq 'r' && !$parms->{rport};
15039              
15040 290         755 for (qw(sockport sockaddr)) {
15041 580 50       2121 $parms->{ $_ } = '*' if !$parms->{ $_ };
15042             }
15043              
15044 290 100       1110 $parms->{ipmask} = $parms->{raddress} if $parms->{raddress};
15045 290 100       972 $parms->{zip} = 0 if !$parms->{zip};
15046 290 100       1654 $parms->{ssl} = 0 if !$parms->{ssl};
15047              
15048 290 50 66     1324 if ( $parms->{ipmask} && $parms->{ipmask} eq 'ARRAY' ) {
15049 0         0 my @validated;
15050 0         0 foreach my $mask ( @{ $parms->{ipmask} } ) {
  0         0  
15051 0 0       0 if ( eval { $mask->isa('Net::Netmask' ) } ) {
  0         0  
15052 0         0 push @validated, $mask;
15053 0         0 next;
15054             }
15055 0         0 my $valid = Net::CIDR::cidrvalidate($mask);
15056 0 0       0 push @validated, $valid if $valid;
15057             }
15058 0         0 $parms->{ipmask} = \@validated;
15059             }
15060              
15061 290         764 my $name = $parms->{name};
15062 290         1315 $self->{config}{peers}{uc $name} = $parms;
15063 290 50       973 $self->add_service( $name ) if $parms->{service};
15064             $self->add_connector(
15065             remoteaddress => $parms->{raddress},
15066             remoteport => $parms->{rport},
15067             name => $name,
15068             usessl => $parms->{ssl},
15069 290 50 66     1050 ) if $parms->{type} eq 'r' && $parms->{auto};
15070              
15071 290         898 return 1;
15072             }
15073              
15074             sub del_peer {
15075 0     0 1 0 my $self = shift;
15076 0   0     0 my $name = shift || return;
15077 0 0       0 return if !defined $self->{config}{peers}{uc $name};
15078 0         0 my $rec = delete $self->{config}{peers}{uc $name};
15079 0 0       0 $self->del_service( $rec->{name} ) if $rec->{service};
15080 0         0 return;
15081             }
15082              
15083             sub add_pseudo {
15084 2     2 1 17 my $self = shift;
15085 2         3 my $parms;
15086 2 50       7 if (ref $_[0] eq 'HASH') {
15087 2         4 $parms = $_[0];
15088             }
15089             else {
15090 0         0 $parms = { @_ };
15091             }
15092 2         13 $parms->{lc $_} = delete $parms->{$_} for keys %$parms;
15093              
15094 2 50 33     14 if (!defined $parms->{cmd} || !defined $parms->{name}
      33        
15095             || !defined $parms->{target}) {
15096 0         0 croak((caller(0))[3].": Not enough parameters specified\n");
15097 0         0 return;
15098             }
15099              
15100 2         17 my ($nick,$user,$host) = parse_user( $parms->{target} );
15101              
15102 2 50 33     40 if (!$nick || !$user || !$host) {
      33        
15103 0         0 croak((caller(0))[3].": target is invalid\n");
15104 0         0 return;
15105             }
15106              
15107 2         6 $parms->{nick} = $nick;
15108 2         3 $parms->{user} = $user;
15109 2         5 $parms->{host} = $host;
15110              
15111 2         5 my $cmd = delete $parms->{cmd};
15112 2         5 $cmd = uc $cmd;
15113              
15114 2 50 33     10 if (defined $self->{config}{cmds}{$cmd} || defined $self->{config}{pseudo}{$cmd}) {
15115 0         0 croak((caller(0))[3].": That command already exists\n");
15116 0         0 return;
15117             }
15118              
15119 2         5 $self->{config}{pseudo}{$cmd} = $parms;
15120 2         6 return 1;
15121             }
15122              
15123             sub del_pseudo {
15124 0     0 1 0 my $self = shift;
15125 0   0     0 my $cmd = shift || return;
15126 0         0 delete $self->{config}{pseudo}{uc $cmd};
15127 0         0 return 1;
15128             }
15129              
15130             sub _terminate_conn_error {
15131 240     240   670 my $self = shift;
15132 240   50     942 my $conn_id = shift || return;
15133 240         646 my $msg = shift;
15134 240 50       852 return if !$self->_connection_exists($conn_id);
15135              
15136 240         2351 $self->disconnect($conn_id, $msg);
15137 240         805 $self->{state}{conns}{$conn_id}{terminated} = 1;
15138 240 100       1266 if ( $self->{state}{conns}{$conn_id}{type} eq 'c' ) {
15139 205         641 my $conn = $self->{state}{conns}{$conn_id};
15140             $self->_send_to_realops(
15141             sprintf(
15142             'Client exiting: %s (%s@%s) [%s] [%s]',
15143             $conn->{nick},
15144             $conn->{auth}{ident},
15145             $conn->{auth}{realhost},
15146 205         2810 $conn->{socket}[0],
15147             $msg,
15148             ),
15149             'Notice',
15150             'c',
15151             );
15152             }
15153             $self->send_output(
15154             {
15155 240         1727 command => 'ERROR',
15156             params => [
15157             'Closing Link: ' . $self->_client_ip($conn_id)
15158             . ' (' . $msg . ')',
15159             ],
15160             },
15161             $conn_id,
15162             );
15163              
15164 240         881 foreach my $nick ( keys %{ $self->{state}{pending} }) {
  240         1727  
15165 19         67 my $id = $self->{state}{pending}{$nick};
15166 19 50       89 if ($id == $conn_id) {
15167 19         62 delete $self->{state}{pending}{$nick};
15168 19         51 last;
15169             }
15170             }
15171              
15172 240         677 return 1;
15173             }
15174              
15175             sub daemon_server_join {
15176 4     4 1 12742 my $self = shift;
15177 4         20 my $server = $self->server_name();
15178 4         15 my $mysid = $self->server_sid();
15179 4         10 my $ref = [ ];
15180 4         16 my $args = [ @_ ];
15181 4         9 my $count = @$args;
15182              
15183             SWITCH: {
15184 4 50 33     10 if (!$count || $count < 2) {
  4         33  
15185 0         0 last SWITCH;
15186             }
15187 4 50 33     53 if ( $args->[0] =~ m!^\d! && !$self->state_uid_exists($args->[0]) ) {
    50 33        
15188 0         0 last SWITCH;
15189             }
15190             elsif ( $args->[0] !~ m!^\d! && !$self->state_nick_exists($args->[0])) {
15191 0         0 last SWITCH;
15192             }
15193 4 50       21 if ( $args->[1] !~ m!^[#&]! ) {
15194 0         0 last SWITCH;
15195             }
15196 4         24 $ref = $self->_daemon_peer_svsjoin( 'spoofed', $mysid, @$args );
15197             }
15198              
15199 4 50       23 return @$ref if wantarray;
15200 4         18 return $ref;
15201             }
15202              
15203             sub daemon_server_kill {
15204 6     6 1 19 my $self = shift;
15205 6         23 my $server = $self->server_name();
15206 6         18 my $mysid = $self->server_sid();
15207 6         37 my $ref = [ ];
15208 6         23 my $args = [ @_ ];
15209 6         16 my $count = @$args;
15210              
15211             SWITCH: {
15212 6 50       17 if (!$count) {
  6         42  
15213 0         0 last SWITCH;
15214             }
15215 6 50 33     66 if ( $args->[0] =~ m!^\d! && !$self->state_uid_exists($args->[0]) ) {
    50 33        
15216 0         0 last SWITCH;
15217             }
15218             elsif ( $args->[0] !~ m!^\d! && !$self->state_nick_exists($args->[0])) {
15219 0         0 last SWITCH;
15220             }
15221              
15222              
15223 6         126 my $target = $self->state_user_nick($args->[0]);
15224 6   50     34 my $comment = $args->[1] || '';
15225 6 100 66     42 my $conn_id = ($args->[2] && $self->_connection_exists($args->[2])
15226             ? $args->[2]
15227             : '');
15228              
15229 6 50       37 if ($self->_state_is_local_user($target)) {
15230 6         122 my $route_id = $self->_state_user_route($target);
15231 6         65 $self->send_output(
15232             {
15233             prefix => $server,
15234             command => 'KILL',
15235             params => [$target, $comment],
15236             },
15237             $route_id,
15238             );
15239             $self->send_output(
15240             {
15241             prefix => $mysid,
15242             command => 'KILL',
15243             params => [
15244             $self->state_user_uid($target),
15245             join('!', $server, $target )." ($comment)",
15246             ],
15247             },
15248 6 100       51 grep { !$conn_id || $_ ne $conn_id }
  9         69  
15249             $self->_state_connected_peers(),
15250             );
15251 6 100       35 if ($route_id eq 'spoofed') {
15252 3         84 $self->call(
15253             'del_spoofed_nick',
15254             $target,
15255             "Killed ($server ($comment))",
15256             );
15257             }
15258             else {
15259 3         14 $self->{state}{conns}{$route_id}{killed} = 1;
15260 3         24 $self->_terminate_conn_error(
15261             $route_id,
15262             "Killed ($server ($comment))",
15263             );
15264             }
15265             }
15266             else {
15267 0         0 my $tuid = $self->state_user_uid( $target );
15268 0         0 $self->{state}{uids}{$tuid}{killed} = 1;
15269             $self->send_output(
15270             {
15271             prefix => $mysid,
15272             command => 'KILL',
15273             params => [$tuid, "$server ($comment)"],
15274             },
15275 0 0       0 grep { !$conn_id || $_ ne $conn_id }
  0         0  
15276             $self->_state_connected_peers(),
15277             );
15278             $self->send_output(
15279 0         0 @{ $self->_daemon_peer_quit(
  0         0  
15280             $tuid,
15281             "Killed ($server ($comment))"
15282             ) });
15283             }
15284             }
15285              
15286 6 50       52 return @$ref if wantarray;
15287 6         22 return $ref;
15288             }
15289              
15290             sub daemon_server_mode {
15291 10     10 1 91768 my $self = shift;
15292 10         22 my $chan = shift;
15293 10         39 my $server = $self->server_name();
15294 10         47 my $sid = $self->server_sid();
15295 10         25 my $ref = [ ];
15296 10         41 my $args = [ @_ ];
15297 10         24 my $count = @$args;
15298              
15299             SWITCH: {
15300 10 50       21 if (!$self->state_chan_exists($chan)) {
  10         33  
15301 0         0 last SWITCH;
15302             }
15303 10         43 my $record = $self->{state}{chans}{uc_irc($chan)};
15304 10         120 $chan = $record->{name};
15305 10         42 my $mode_u_set = ( $record->{mode} =~ /u/ );
15306 10         25 my $full = $server;
15307 10         35 my %subs; my @reply_args; my $reply;
  10         0  
15308 10         39 my $parsed_mode = parse_mode_line(@$args);
15309              
15310 10         606 while(my $mode = shift (@{ $parsed_mode->{modes} })) {
  23         82  
15311 13 50       49 next if $mode !~ /^[+-][CceIbkMNRSTLOlimnpstohuv]$/;
15312 13         37 my $arg;
15313 13 100       80 if ($mode =~ /^(\+[ohvklbIe]|-[ohvbIe])/) {
15314 3         8 $arg = shift @{ $parsed_mode->{args} };
  3         13  
15315             }
15316 13 100       60 if (my ($flag, $char) = $mode =~ /^([-+])([ohv])/ ) {
15317              
15318 2 50 33     16 if ($flag eq '+'
15319             && $record->{users}{$self->state_user_uid($arg)} !~ /$char/) {
15320             # Update user and chan record
15321 2         61 $arg = $self->state_user_uid($arg);
15322             $record->{users}{$arg} = join('', sort
15323 2         47 split //, $record->{users}{$arg} . $char);
15324             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
15325 2         12 = $record->{users}{$arg};
15326 2         26 $reply .= $mode;
15327 2         11 my $anick = $self->state_user_nick($arg);
15328 2         9 $subs{$anick} = $arg;
15329 2         7 push @reply_args, $anick;
15330             }
15331              
15332 2 50 33     10 if ($flag eq '-' && $record->{users}{uc_irc($arg)}
15333             =~ /$char/) {
15334             # Update user and chan record
15335 0         0 $arg = $self->state_user_uid($arg);
15336 0         0 $record->{users}{$arg} =~ s/$char//g;
15337             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
15338 0         0 = $record->{users}{$arg};
15339 0         0 $reply .= $mode;
15340 0         0 my $anick = $self->state_user_nick($arg);
15341 0         0 $subs{$anick} = $arg;
15342 0         0 push @reply_args, $anick;
15343             }
15344 2         6 next;
15345             }
15346 11 0 33     41 if ($mode eq '+l' && $arg =~ /^\d+$/ && $arg > 0) {
      33        
15347 0         0 $reply .= $mode;
15348 0         0 push @reply_args, $arg;
15349 0 0       0 if ($record->{mode} !~ /l/) {
15350             $record->{mode} = join('', sort split //,
15351 0         0 $record->{mode} . 'l');
15352             }
15353 0         0 $record->{climit} = $arg;
15354 0         0 next;
15355             }
15356 11 50 33     34 if ($mode eq '-l' && $record->{mode} =~ /l/) {
15357 0         0 $reply .= $mode;
15358 0         0 $record->{mode} =~ s/l//g;
15359 0         0 delete $record->{climit};
15360 0         0 next;
15361             }
15362 11 50 33     35 if ($mode eq '+k' && $arg) {
15363 0         0 $reply .= $mode;
15364 0         0 push @reply_args, $arg;
15365 0 0       0 if ($record->{mode} !~ /k/) {
15366             $record->{mode} = join('', sort split //,
15367 0         0 $record->{mode} . 'k');
15368             }
15369 0         0 $record->{ckey} = $arg;
15370 0         0 next;
15371             }
15372 11 50 33     35 if ($mode eq '-k' && $record->{mode} =~ /k/) {
15373 0         0 $reply .= $mode;
15374 0         0 push @reply_args, '*';
15375 0         0 $record->{mode} =~ s/k//g;
15376 0         0 delete $record->{ckey};
15377 0         0 next;
15378             }
15379             # Bans
15380 11 100       63 if (my ($flag) = $mode =~ /(\+|-)b/) {
15381 1         9 my $mask = normalize_mask($arg);
15382 1         71 my $umask = uc_irc($mask);
15383 1 50 33     29 if ($flag eq '+' && !$record->{bans}{$umask}) {
15384 1   33     9 $record->{bans}{$umask}
15385             = [$mask, ($full || $server), time];
15386 1         5 $reply .= $mode;
15387 1         5 push @reply_args, $mask;
15388             }
15389 1 0 33     6 if ($flag eq '-' and $record->{bans}{$umask}) {
15390 0         0 delete $record->{bans}{$umask};
15391 0         0 $reply .= $mode;
15392 0         0 push @reply_args, $mask;
15393             }
15394 1         4 next;
15395             }
15396             # Invex
15397 10 50       32 if (my ($flag) = $mode =~ /(\+|-)I/) {
15398 0         0 my $mask = normalize_mask($arg);
15399 0         0 my $umask = uc_irc($mask);
15400 0 0 0     0 if ($flag eq '+' && !$record->{invex}{$umask}) {
15401 0   0     0 $record->{invex}{$umask}
15402             = [$mask, ($full || $server), time];
15403 0         0 $reply .= $mode;
15404 0         0 push @reply_args, $mask;
15405             }
15406 0 0 0     0 if ($flag eq '-' && $record->{invex}{$umask}) {
15407 0         0 delete $record->{invex}{$umask};
15408 0         0 $reply .= $mode;
15409 0         0 push @reply_args, $mask;
15410             }
15411 0         0 next;
15412             }
15413             # Exceptions
15414 10 50       32 if (my ($flag) = $mode =~ /(\+|-)e/) {
15415 0         0 my $mask = normalize_mask($arg);
15416 0         0 my $umask = uc_irc($mask);
15417 0 0 0     0 if ($flag eq '+' && !$record->{excepts}{$umask}) {
15418 0   0     0 $record->{excepts}{$umask}
15419             = [$mask, ($full || $server), time];
15420 0         0 $reply .= $mode;
15421 0         0 push @reply_args, $mask;
15422             }
15423 0 0 0     0 if ($flag eq '-' && $record->{excepts}{$umask}) {
15424 0         0 delete $record->{excepts}{$umask};
15425 0         0 $reply .= $mode;
15426 0         0 push @reply_args, $mask;
15427             }
15428 0         0 next;
15429             }
15430             # The rest should be argumentless.
15431 10         34 my ($flag, $char) = split //, $mode;
15432 10 100 66     123 if ($flag eq '+' && $record->{mode} !~ /$char/) {
15433             $record->{mode} = join('', sort split //,
15434 7         58 $record->{mode} . $char);
15435 7         20 $reply .= $mode;
15436 7         20 next;
15437             }
15438 3 50 33     65 if ($flag eq '-' && $record->{mode} =~ /$char/) {
15439 3         28 $record->{mode} =~ s/$char//g;
15440 3         9 $reply .= $mode;
15441 3         9 next;
15442             }
15443             } # while
15444              
15445 10 50       59 if ($reply) {
15446 10         43 $reply = unparse_mode_line($reply);
15447             my @reply_args_peer = map {
15448 10 100       372 ( defined $subs{$_} ? $subs{$_} : $_ )
  3         27  
15449             } @reply_args;
15450             $self->send_output(
15451             {
15452             prefix => $sid,
15453             command => 'TMODE',
15454 10         105 params => [$record->{ts}, $chan, $reply, @reply_args_peer],
15455             colonify => 0,
15456             },
15457             $self->_state_connected_peers(),
15458             );
15459             $self->_send_output_channel_local(
15460             $record->{name},
15461             {
15462             prefix => $server,
15463             command => 'MODE',
15464             colonify => 0,
15465             params => [
15466             $record->{name},
15467 10 100       151 $reply,
15468             @reply_args,
15469             ],
15470             },
15471             '', ( $mode_u_set ? 'oh' : '' ),
15472             );
15473 10 100       62 if ($mode_u_set) {
15474 2         10 my $bparse = parse_mode_line( $reply, @reply_args );
15475 2         123 my $breply; my @breply_args;
15476 2         4 while (my $bmode = shift (@{ $bparse->{modes} })) {
  4         18  
15477 2         5 my $arg;
15478 2 100       13 $arg = shift @{ $bparse->{args} }
  1         5  
15479             if $bmode =~ /^(\+[ohvklbIe]|-[ohvbIe])/;
15480 2 100       10 next if $bmode =~ m!^[+-][beI]$!;
15481 1         3 $breply .= $bmode;
15482 1 50       5 push @breply_args, $arg if $arg;
15483             }
15484 2 100       13 if ($breply) {
15485 1         5 my $parsed_line = unparse_mode_line($breply);
15486             $self->_send_output_channel_local(
15487             $record->{name},
15488             {
15489             prefix => $server,
15490             command => 'MODE',
15491             colonify => 0,
15492             params => [
15493             $record->{name},
15494 1         31 $parsed_line,
15495             @breply_args,
15496             ],
15497             },
15498             '','-oh',
15499             );
15500             }
15501             }
15502             }
15503             } # SWITCH
15504              
15505 10 50       32 return @$ref if wantarray;
15506 10         55 return $ref;
15507             }
15508              
15509             sub daemon_server_kick {
15510 2     2 1 74670 my $self = shift;
15511 2         15 my $server = $self->server_name();
15512 2         10 my $sid = $self->server_sid();
15513 2         8 my $ref = [ ];
15514 2         8 my $args = [ @_ ];
15515 2         6 my $count = @$args;
15516              
15517             SWITCH: {
15518 2 50 33     6 if (!$count || $count < 2) {
  2         22  
15519 0         0 last SWITCH;
15520             }
15521 2         11 my $chan = (split /,/, $args->[0])[0];
15522 2         10 my $who = (split /,/, $args->[1])[0];
15523 2 50       15 if (!$self->state_chan_exists($chan)) {
15524 0         0 last SWITCH;
15525             }
15526 2         13 $chan = $self->_state_chan_name($chan);
15527 2 50       35 if (!$self->state_nick_exists($who)) {
15528 0         0 last SWITCH;
15529             }
15530 2         13 $who = $self->state_user_nick($who);
15531 2 50       66 if (!$self->state_is_chan_member($who, $chan)) {
15532 0         0 last SWITCH;
15533             }
15534 2         34 my $wuid = $self->state_user_uid($who);
15535 2   33     34 my $comment = $args->[2] || $who;
15536 2         20 $self->send_output(
15537             {
15538             prefix => $sid,
15539             command => 'KICK',
15540             params => [$chan, $wuid, $comment],
15541             },
15542             $self->_state_connected_peers(),
15543             );
15544 2         23 $self->_send_output_channel_local(
15545             $chan,
15546             {
15547             prefix => $server,
15548             command => 'KICK',
15549             params => [$chan, $who, $comment],
15550             },
15551             );
15552 2         14 $chan = uc_irc($chan);
15553 2         32 delete $self->{state}{chans}{$chan}{users}{$wuid};
15554 2         8 delete $self->{state}{uids}{$wuid}{chans}{$chan};
15555 2 50       5 if (!keys %{ $self->{state}{chans}{$chan}{users} }) {
  2         15  
15556 0         0 delete $self->{state}{chans}{$chan};
15557             }
15558             }
15559              
15560 2 50       7 return @$ref if wantarray;
15561 2         7 return $ref;
15562             }
15563              
15564             sub daemon_server_remove {
15565 1     1 1 3230 my $self = shift;
15566 1         5 my $server = $self->server_name();
15567 1         4 my $ref = [ ];
15568 1         4 my $args = [ @_ ];
15569 1         3 my $count = @$args;
15570              
15571             SWITCH: {
15572 1 50 33     2 if (!$count || $count < 2) {
  1         9  
15573 0         0 last SWITCH;
15574             }
15575 1         6 my $chan = (split /,/, $args->[0])[0];
15576 1         4 my $who = (split /,/, $args->[1])[0];
15577 1 50       4 if (!$self->state_chan_exists($chan)) {
15578 0         0 last SWITCH;
15579             }
15580 1         4 $chan = $self->_state_chan_name($chan);
15581 1 50       13 if (!$self->state_nick_exists($who)) {
15582 0         0 last SWITCH;
15583             }
15584 1         3 my $fullwho = $self->state_user_full($who);
15585 1         6 $who = (split /!/, $who)[0];
15586 1 50       5 if (!$self->state_is_chan_member($who, $chan)) {
15587 0         0 last SWITCH;
15588             }
15589 1         16 my $wuid = $self->state_user_uid($who);
15590 1         12 my $comment = 'Enforced PART';
15591 1 50       8 $comment .= " \"$args->[2]\"" if $args->[2];
15592 1         7 $self->send_output(
15593             {
15594             prefix => $wuid,
15595             command => 'PART',
15596             params => [$chan, $comment],
15597             },
15598             $self->_state_connected_peers(),
15599             );
15600 1         10 $self->_send_output_channel_local(
15601             $chan,
15602             {
15603             prefix => $fullwho,
15604             command => 'PART',
15605             params => [$chan, $comment],
15606             },
15607             );
15608 1         6 $chan = uc_irc($chan);
15609 1         15 delete $self->{state}{chans}{$chan}{users}{$wuid};
15610 1         4 delete $self->{state}{uids}{$wuid}{chans}{$chan};
15611 1 50       2 if (!keys %{ $self->{state}{chans}{$chan}{users} }) {
  1         7  
15612 1         4 delete $self->{state}{chans}{$chan};
15613             }
15614             }
15615              
15616 1 50       5 return @$ref if wantarray;
15617 1         5 return $ref;
15618             }
15619              
15620             sub daemon_server_wallops {
15621 0     0 1 0 my $self = shift;
15622 0         0 my $server = $self->server_name();
15623 0         0 my $sid = $self->server_sid();
15624 0         0 my $ref = [ ];
15625 0         0 my $args = [ @_ ];
15626 0         0 my $count = @$args;
15627              
15628 0 0       0 if ($count) {
15629 0         0 $self->send_output(
15630             {
15631             prefix => $sid,
15632             command => 'WALLOPS',
15633             params => [$args->[0]],
15634             },
15635             $self->_state_connected_peers(),
15636             );
15637             $self->send_output(
15638             {
15639             prefix => $server,
15640             command => 'WALLOPS',
15641             params => [$args->[0]],
15642             },
15643 0         0 keys %{ $self->{state}{wallops} },
  0         0  
15644             );
15645 0         0 $self->send_event("daemon_wallops", $server, $args->[0]);
15646             }
15647              
15648 0 0       0 return @$ref if wantarray;
15649 0         0 return $ref;
15650             }
15651              
15652             sub daemon_server_realops {
15653 0     0 1 0 my $self = shift;
15654 0         0 my $ref = [ ];
15655 0         0 my $args = [ @_ ];
15656 0         0 my $count = @$args;
15657              
15658 0 0       0 if ($count) {
15659 0         0 $self->_send_to_realops( @$args );
15660             }
15661              
15662 0 0       0 return @$ref if wantarray;
15663 0         0 return $ref;
15664             }
15665              
15666             sub add_spoofed_nick {
15667 41     41 1 22420 my ($kernel, $self) = @_[KERNEL, OBJECT];
15668 41         113 my $ref;
15669 41 50       317 if (ref $_[ARG0] eq 'HASH') {
15670 41         122 $ref = $_[ARG0];
15671             }
15672             else {
15673 0         0 $ref = { @_[ARG0..$#_] };
15674             }
15675              
15676 41         388 $ref->{ lc $_ } = delete $ref->{$_} for keys %$ref;
15677 41 50       206 return if !$ref->{nick};
15678 41 50       308 return if $self->state_nick_exists($ref->{nick});
15679 41         121 my $record = $ref;
15680 41         191 $record->{uid} = $self->_state_gen_uid();
15681 41         175 $record->{sid} = substr $record->{uid}, 0, 3;
15682 41 100       235 $record->{ts} = time if !$record->{ts};
15683 41         125 $record->{type} = 's';
15684 41         197 $record->{server} = $self->server_name();
15685 41         167 $record->{hops} = 0;
15686 41         153 $record->{route_id} = 'spoofed';
15687 41 50       193 $record->{umode} = 'i' if !$record->{umode};
15688 41 100       218 if (!defined $record->{ircname}) {
15689 31         104 $record->{ircname} = "* I'm too lame to read the documentation *";
15690             }
15691 41 100       275 $self->{state}{stats}{invisible}++ if $record->{umode} =~ /i/;
15692 41 100       312 $self->{state}{stats}{ops_online}++ if $record->{umode} =~ /o/;
15693 41         187 $record->{idle_time} = $record->{conn_time} = $record->{ts};
15694 41   33     404 $record->{auth}{ident} = delete $record->{user} || $record->{nick};
15695             $record->{auth}{hostname} = delete $record->{hostname}
15696 41   33     266 || $self->server_name();
15697 41         149 $record->{auth}{realhost} = $record->{auth}{hostname};
15698 41 50       206 $record->{account} = '*' if !$record->{account};
15699 41         129 $record->{ipaddress} = 0;
15700 41         210 $self->{state}{users}{uc_irc($record->{nick})} = $record;
15701 41 50       735 $self->{state}{uids}{ $record->{uid} } = $record if $record->{uid};
15702 41         283 $self->{state}{peers}{uc $record->{server}}{users}{uc_irc($record->{nick})} = $record;
15703 41 50       764 $self->{state}{peers}{uc $record->{server}}{uids}{ $record->{uid} } = $record if $record->{uid};
15704              
15705             $record->{full} = sub {
15706             return sprintf('%s!%s@%s',
15707             $record->{nick},
15708             $record->{auth}{ident},
15709 82     82   907 $record->{auth}{hostname});
15710 41         395 };
15711              
15712             my $arrayref = [
15713             $record->{nick},
15714             $record->{hops} + 1,
15715             $record->{ts},
15716             '+' . $record->{umode},
15717             $record->{auth}{ident},
15718             $record->{auth}{hostname},
15719             $record->{ipaddress},
15720             $record->{uid},
15721             $record->{account},
15722             $record->{ircname},
15723 41         362 ];
15724              
15725             my $rhostref = [
15726             $record->{nick},
15727             $record->{hops} + 1,
15728             $record->{ts},
15729             '+' . $record->{umode},
15730             $record->{auth}{ident},
15731             $record->{auth}{hostname},
15732             $record->{auth}{realhost},
15733             $record->{ipaddress},
15734             $record->{uid},
15735             $record->{account},
15736             $record->{ircname},
15737 41         308 ];
15738              
15739 41 50       231 if (my $whois = $record->{whois}) {
15740 0         0 $record->{svstags}{313} = {
15741             numeric => '313',
15742             umodes => '+',
15743             tagline => $whois,
15744             };
15745             }
15746              
15747 41         278 foreach my $peer_id ( $self->_state_connected_peers() ) {
15748 0 0       0 if ( $self->_state_peer_capab( $peer_id, 'RHOST' ) ) {
15749             $self->send_output(
15750             {
15751             prefix => $record->{sid},
15752 0         0 command => 'UID',
15753             params => $rhostref,
15754             },
15755             $peer_id,
15756             );
15757             }
15758             else {
15759             $self->send_output(
15760             {
15761             prefix => $record->{sid},
15762 0         0 command => 'UID',
15763             params => $arrayref,
15764             },
15765             $peer_id,
15766             );
15767             }
15768             $self->send_output(
15769             {
15770             prefix => $record->{sid},
15771             command => 'SVSTAG',
15772             params => [
15773             $record->{uid},
15774             $record->{ts},
15775             '313', '+', $record->{whois},
15776             ],
15777             },
15778             $peer_id,
15779 0 0       0 ) if $record->{whois};
15780             }
15781              
15782              
15783 41         336 $self->send_event('daemon_uid', @$arrayref);
15784 41   50     5317 $self->send_event('daemon_nick', @{ $arrayref }[0..5], $record->{server}, ( $arrayref->[9] || '' ) );
  41         405  
15785 41 100       4394 if ( $record->{umode} =~ /o/ ) {
15786 34         179 my $notice = sprintf("%s{%s} is now an operator",$record->{full}->(),$record->{nick});
15787 34         242 $self->_send_to_realops($notice);
15788             }
15789 41         245 $self->_state_update_stats();
15790 41         226 return;
15791             }
15792              
15793             sub del_spoofed_nick {
15794 9     9 1 32991 my ($kernel, $self, $nick) = @_[KERNEL, OBJECT, ARG0];
15795 9 50       69 if ( $nick =~ m!^\d! ) {
15796 0 0       0 return if !$self->state_uid_exists($nick);
15797 0 0       0 return if $self->_state_uid_route($nick) ne 'spoofed';
15798             }
15799             else {
15800 9 50       45 return if !$self->state_nick_exists($nick);
15801 9 50       48 return if $self->_state_user_route($nick) ne 'spoofed';
15802             }
15803 9         44 $nick = $self->state_user_nick($nick);
15804              
15805 9   100     146 my $message = $_[ARG1] || 'Client Quit';
15806             $self->send_output(
15807 9         23 @{ $self->_daemon_cmd_quit($nick, qq{"$message"}) },
  9         66  
15808             qq{"$message"},
15809             );
15810 9         53 return;
15811             }
15812              
15813             sub _spoofed_command {
15814 31     31   77840 my ($kernel, $self, $state, $nick) = @_[KERNEL, OBJECT, STATE, ARG0];
15815 31 50       152 return if !$self->state_nick_exists($nick);
15816 31 50       161 return if $self->_state_user_route($nick) ne 'spoofed';
15817              
15818 31         142 $nick = $self->state_user_nick($nick);
15819 31         451 my $uid = $self->state_user_uid($nick);
15820 31         544 $state =~ s/daemon_cmd_//;
15821 31         112 my $command = "_daemon_cmd_" . $state;
15822              
15823 31 50       237 if ($state =~ /^(privmsg|notice)$/) {
    100          
15824 0         0 my $type = uc $1;
15825 0         0 $self->_daemon_cmd_message($nick, $type, @_[ARG1 .. $#_]);
15826 0         0 return;
15827             }
15828             elsif ($state eq 'sjoin') {
15829 1         3 my $chan = $_[ARG1];
15830 1 50 33     35 return if !$chan || !$self->state_chan_exists($chan);
15831 1 50       7 return if $self->state_is_chan_member($nick, $chan);
15832 1         7 $chan = $self->_state_chan_name($chan);
15833 1         16 my $ts = $self->_state_chan_timestamp($chan) - 10;
15834 1         15 $self->_daemon_peer_sjoin(
15835             'spoofed',
15836             $self->server_sid(),
15837             $ts,
15838             $chan,
15839             '+nt',
15840             '@' . $uid,
15841             );
15842 1         9 return;
15843             }
15844              
15845 30 50       362 $self->$command($nick, @_[ARG1 .. $#_]) if $self->can($command);
15846 30         146 return;
15847             }
15848              
15849             1;
15850              
15851             =encoding utf8
15852              
15853             =head1 NAME
15854              
15855             POE::Component::Server::IRC - A fully event-driven networkable IRC server daemon module.
15856              
15857             =head1 SYNOPSIS
15858              
15859             # A fairly simple example:
15860             use strict;
15861             use warnings;
15862             use POE qw(Component::Server::IRC);
15863              
15864             my %config = (
15865             servername => 'simple.poco.server.irc',
15866             nicklen => 15,
15867             network => 'SimpleNET'
15868             );
15869              
15870             my $pocosi = POE::Component::Server::IRC->spawn( config => \%config );
15871              
15872             POE::Session->create(
15873             package_states => [
15874             'main' => [qw(_start _default)],
15875             ],
15876             heap => { ircd => $pocosi },
15877             );
15878              
15879             $poe_kernel->run();
15880              
15881             sub _start {
15882             my ($kernel, $heap) = @_[KERNEL, HEAP];
15883              
15884             $heap->{ircd}->yield('register', 'all');
15885              
15886             # Anyone connecting from the loopback gets spoofed hostname
15887             $heap->{ircd}->add_auth(
15888             mask => '*@localhost',
15889             spoof => 'm33p.com',
15890             no_tilde => 1,
15891             );
15892              
15893             # We have to add an auth as we have specified one above.
15894             $heap->{ircd}->add_auth(mask => '*@*');
15895              
15896             # Start a listener on the 'standard' IRC port.
15897             $heap->{ircd}->add_listener(port => 6667);
15898              
15899             # Add an operator who can connect from localhost
15900             $heap->{ircd}->add_operator(
15901             {
15902             username => 'moo',
15903             password => 'fishdont',
15904             }
15905             );
15906             }
15907              
15908             sub _default {
15909             my ($event, $args) = @_[ARG0 .. $#_];
15910              
15911             print "$event: ";
15912             for my $arg (@$args) {
15913             if (ref($arg) eq 'ARRAY') {
15914             print "[", join ( ", ", @$arg ), "] ";
15915             }
15916             elsif (ref($arg) eq 'HASH') {
15917             print "{", join ( ", ", %$arg ), "} ";
15918             }
15919             else {
15920             print "'$arg' ";
15921             }
15922             }
15923              
15924             print "\n";
15925             }
15926              
15927             =head1 DESCRIPTION
15928              
15929             POE::Component::Server::IRC is a POE component which implements an IRC
15930             server (also referred to as an IRC daemon or IRCd). It should be compliant
15931             with the pertient IRC RFCs and is based on reverse engineering Hybrid IRCd
15932             behaviour with regards to interactions with IRC clients and other IRC
15933             servers.
15934              
15935             Yes, that's right. POE::Component::Server::IRC is capable of linking to
15936             foreign IRC networks. It supports the TS6 server to server protocol and
15937             has been tested with linking to Hybrid-8 based networks. It should in
15938             theory work with any TS6-based IRC network.
15939              
15940             POE::Component::Server::IRC also has a services API, which enables one to
15941             extend the IRCd to create IRC Services. This is fully event-driven (of
15942             course =]). There is also a Plugin system, similar to that sported by
15943             L.
15944              
15945             B This is a subclass of
15946             L.
15947             You should read its documentation too.
15948              
15949             =head1 CONSTRUCTOR
15950              
15951             =head2 C
15952              
15953             Returns a new instance of the component. Takes the following parameters:
15954              
15955             =over 4
15956              
15957             =item * B<'config'>, a hashref of configuration options, see the
15958             L|/configure> method for details.
15959              
15960             =back
15961              
15962             Any other parameters will be passed along to
15963             L's
15964             L|POE::Component::Server::IRC::Backend/create> method.
15965              
15966             If the component is spawned from within another session then that session
15967             will automagically be registered with the component to receive events and
15968             be sent an L|POE::Component::IRC::Server::Backend/ircd_registered>
15969             event.
15970              
15971             =head1 METHODS
15972              
15973             =head2 Information
15974              
15975             =head3 C
15976              
15977             No arguments, returns the name of the ircd.
15978              
15979             =head3 C
15980              
15981             No arguments, returns the software version of the ircd.
15982              
15983             =head3 C
15984              
15985             No arguments, returns a string signifying when the ircd was created.
15986              
15987             =head3 C
15988              
15989             Takes one argument, the server configuration value to query.
15990              
15991             =head2 Configuration
15992              
15993             These methods provide mechanisms for configuring and controlling the IRCd
15994             component.
15995              
15996             =head3 C
15997              
15998             Configures your new shiny IRCd.
15999              
16000             Takes a number of parameters:
16001              
16002             =over 4
16003              
16004             =item * B<'servername'>, a name to bless your shiny new IRCd with,
16005             defaults to 'poco.server.irc';
16006              
16007             =item * B<'serverdesc'>, a description for your IRCd, defaults to
16008             'Poco? POCO? POCO!';
16009              
16010             =item * B<'network'>, the name of the IRC network you will be creating,
16011             defaults to 'poconet';
16012              
16013             =item * B<'nicklen'>, the max length of nicknames to support, defaults
16014             to 9. B: the nicklen must be the same on all servers on your IRC
16015             network;
16016              
16017             =item * B<'maxtargets'>, max number of targets a user can send
16018             PRIVMSG/NOTICE's to, defaults to 4;
16019              
16020             =item * B<'maxchannels'>, max number of channels users may join, defaults
16021             to 15;
16022              
16023             =item * B<'version'>, change the server version that is reported;
16024              
16025             =item * B<'admin'>, an arrayref consisting of the 3 lines that will be
16026             returned by ADMIN;
16027              
16028             =item * B<'info'>, an arrayref consisting of lines to be returned by INFO;
16029              
16030             =item * B<'ophacks'>, set to true to enable oper hacks. Default is false;
16031              
16032             =item * B<'whoisactually'>, setting this to a false value means that only
16033             opers can see 338. Defaults to true;
16034              
16035             =item * B<'sid'>, servers unique ID. This is three characters long and must be in
16036             the form [0-9][A-Z0-9][A-Z0-9]. Specifying this enables C.
16037              
16038             =back
16039              
16040             =head3 C
16041              
16042             By default the IRCd allows any user to connect to the server without a
16043             password. Configuring auths enables you to control who can connect and
16044             set passwords required to connect.
16045              
16046             Takes the following parameters:
16047              
16048             =over 4
16049              
16050             =item * B<'mask'>, a user@host or user@ipaddress mask to match against,
16051             mandatory;
16052              
16053             =item * B<'password'>, if specified, any client matching the mask must
16054             provide this to connect;
16055              
16056             =item * B<'spoof'>, if specified, any client matching the mask will have
16057             their hostname changed to this;
16058              
16059             =item * B<'no_tilde'>, if specified, the '~' prefix is removed from their
16060             username;
16061              
16062             =item * B<'exceed_limit'>, if specified, any client matching the mask will not
16063             have their connection limited, if the server is full;
16064              
16065             =item * B<'kline_exempt'>, if true, any client matching the mask will be exempt
16066             from KLINEs and RKLINEs;
16067              
16068             =item * B<'resv_exempt'>, if true, any client matching the mask will be exempt
16069             from RESVs;
16070              
16071             =item * B<'can_flood'>, if true, any client matching the mask will be exempt
16072             from flood protection;
16073              
16074             =item * B<'need_ident'>, if true, any client matching the mask will be
16075             required to have a valid response to C queries;
16076              
16077             =back
16078              
16079             Auth masks are processed in order of addition.
16080              
16081             If auth masks have been defined, then a connecting user *must* match one
16082             of the masks in order to be authorised to connect. This is a feature >;)
16083              
16084             =head3 C
16085              
16086             Takes a single argument, the mask to remove.
16087              
16088             =head3 C
16089              
16090             This adds an O line to the IRCd. Takes a number of parameters:
16091              
16092             =over 4
16093              
16094             =item * B<'username'>, the username of the IRC oper, mandatory;
16095              
16096             =item * B<'password'>, the password, mandatory;
16097              
16098             =item * B<'ipmask'>, either a scalar ipmask or an arrayref of addresses or CIDRs
16099             as understood by L::cidrvalidate;
16100              
16101             =item * B<'ssl_required'>, set to true to require that the oper is connected
16102             securely using SSL/TLS;
16103              
16104             =item * B<'certfp'>, specify the fingerprint of the oper's client certificate
16105             to verify;
16106              
16107             =back
16108              
16109             A scalar ipmask can contain '*' to match any number of characters or '?' to
16110             match one character. If no 'ipmask' is provided, operators are only allowed
16111             to OPER from the loopback interface.
16112              
16113             B<'password'> can be either plain-text, L|crypt>'d or unix/apache
16114             md5. See the C function in
16115             L
16116             for how to generate passwords.
16117              
16118             B<'ssl_required'> and B<'certfp'> obviously both require that the server
16119             supports SSL/TLS connections. B<'certfp'> is the SHA256 digest fingerprint
16120             of the client certificate. This can be obtained from the PEM formated cert
16121             using one of the following methods:
16122              
16123             OpenSSL/LibreSSL:
16124             openssl x509 -sha256 -noout -fingerprint -in cert.pem | sed -e 's/^.*=//;s/://g'
16125              
16126             GnuTLS:
16127             certtool -i < cert.pem | egrep -A 1 'SHA256 fingerprint'
16128              
16129             =head3 C
16130              
16131             Takes a single argument, the username to remove.
16132              
16133             =head3 C
16134              
16135             Adds peer servers that we will allow to connect to us and who we will
16136             connect to. Takes the following parameters:
16137              
16138             =over 4
16139              
16140             =item * B<'name'>, the name of the server. This is the IRC name, not
16141             hostname, mandatory;
16142              
16143             =item * B<'pass'>, the password they must supply to us, mandatory;
16144              
16145             =item * B<'rpass'>, the password we need to supply to them, mandatory;
16146              
16147             =item * B<'type'>, the type of server, 'c' for a connecting server, 'r'
16148             for one that we will connect to;
16149              
16150             =item * B<'raddress'>, the remote address to connect to, implies 'type'
16151             eq 'r';
16152              
16153             =item * B<'rport'>, the remote port to connect to, default is 6667;
16154              
16155             =item * B<'ipmask'>, either a scalar ipmask or an arrayref of addresses or CIDRs
16156             as understood by L::cidrvalidate;
16157              
16158             =item * B<'auto'>, if set to true value will automatically connect to
16159             remote server if type is 'r';
16160              
16161             =item * B<'zip'>, set to a true value to enable ziplink support. This must
16162             be done on both ends of the connection. Requires
16163             L;
16164              
16165             =item * B<'service'>, set to a true value to enable the peer to be
16166             accepted as a services peer.
16167              
16168             =item * B<'ssl'>, set to a true value to enable SSL/TLS support. This must
16169             be done on both ends of the connection. Requires L.
16170              
16171             =item * B<'certfp'>, specify the fingerprint of the peer's client certificate
16172             to verify;
16173              
16174             =back
16175              
16176             B<'certfp'> is the SHA256 digest fingerprint of the client certificate.
16177             This can be obtained from the PEM formated cert using one of the following
16178             methods:
16179              
16180             OpenSSL/LibreSSL:
16181             openssl x509 -sha256 -noout -fingerprint -in cert.pem | sed -e 's/^.*=//;s/://g'
16182              
16183             GnuTLS:
16184             certtool -i < cert.pem | egrep -A 1 'SHA256 fingerprint'
16185              
16186             =head3 C
16187              
16188             Takes a single argument, the peer to remove. This does not disconnect the
16189             said peer if it is currently connected.
16190              
16191             =head3 C
16192              
16193             Adds a service peer. A service peer is a peer that is accepted to send
16194             service commands C. Takes a single argument the service peer to add.
16195             This does not have to be a directly connected peer as defined with C.
16196              
16197             =head3 C
16198              
16199             Takes a single argument, the service peer to remove. This does not disconnect
16200             the said service peer, but it will deny the peer access to service commands.
16201              
16202             =head3 C
16203              
16204             Adds a pseudo command, also known as a service alias. The command is transformed
16205             by the server into a C and sent to the given target.
16206              
16207             Takes several arguments:
16208              
16209             =over 4
16210              
16211             =item * B<'cmd'>, (mandatory) command/alias to be added.
16212              
16213             =item * B<'name'>, (mandatory) the service name, eg. NickServ, this is
16214             used in error messages reported to users.
16215              
16216             =item * B<'target'>, (mandatory) the target for the command in nick!user@host
16217             format.
16218              
16219             =item * B<'prepend'>, (optional) text that will prepended to the user's
16220             message.
16221              
16222             =back
16223              
16224             =head3 C
16225              
16226             Removes a previously defined pseudo command/alias.
16227              
16228             =head2 State queries
16229              
16230             The following methods allow you to query state information regarding
16231             nicknames, channels, and peers.
16232              
16233             =head3 C
16234              
16235             Takes no arguments, returns a list of all nicknames in the state.
16236              
16237             =head3 C
16238              
16239             Takes no arguments, returns a list of all channels in the state.
16240              
16241             =head3 C
16242              
16243             Takes no arguments, returns a list of all irc servers in the state.
16244              
16245             =head3 C
16246              
16247             Takes one argument, a nickname, returns true or false dependent on whether
16248             the given nickname exists or not.
16249              
16250             =head3 C
16251              
16252             Takes one argument, a channel name, returns true or false dependent on
16253             whether the given channel exists or not.
16254              
16255             =head3 C
16256              
16257             Takes one argument, a peer server name, returns true or false dependent
16258             on whether the given peer exists or not.
16259              
16260             =head3 C
16261              
16262             Takes one argument, a nickname, returns that users full nick!user@host
16263             if they exist, undef if they don't.
16264              
16265             If a second argument is provided and the nickname provided is an oper,
16266             then the returned value will be nick!user@host{opuser}
16267              
16268             =head3 C
16269              
16270             Takes one argument, a nickname, returns the proper nickname for that user.
16271             Returns undef if the nick doesn't exist.
16272              
16273             =head3 C
16274              
16275             Takes one argument, a nickname, returns that users mode setting.
16276              
16277             =head3 C
16278              
16279             Takes one argument, a nickname, returns true or false dependent on whether
16280             the given nickname is an IRC operator or not.
16281              
16282             =head3 C
16283              
16284             Takes one argument, a nickname, returns a list of channels that that nick
16285             is a member of.
16286              
16287             =head3 C
16288              
16289             Takes one argument, a nickname, returns the name of the peer server that
16290             that user is connected from.
16291              
16292             =head3 C
16293              
16294             Takes one argument, a channel name, returns a list of the member nicks on
16295             that channel.
16296              
16297             =head3 C
16298              
16299             Takes one argument, a channel name, returns a list of the member nicks on
16300             that channel, nicknames will be prefixed with @%+ if they are +o +h or +v,
16301             respectively.
16302              
16303             =head3 C
16304              
16305             Takes one argument, a channel name, returns undef if no topic is set on
16306             that channel, or an arrayref consisting of the topic, who set it and the
16307             time they set it.
16308              
16309             =head3 C
16310              
16311             Takes two arguments, a channel name and a channel mode character. Returns
16312             true if that channel mode is set, false otherwise.
16313              
16314             =head3 C
16315              
16316             Takes two arguments, a nick and a channel name. Returns true if that nick
16317             is on channel, false otherwise.
16318              
16319             =head3 C
16320              
16321             Takes two arguments, a nick and a channel name. Returns that nicks status
16322             (+ohv or '') on that channel.
16323              
16324             =head3 C
16325              
16326             Takes two arguments, a nick and a channel name. Returns true if that nick
16327             is an channel operator, false otherwise.
16328              
16329             =head3 C
16330              
16331             Takes two arguments, a nick and a channel name. Returns true if that nick
16332             is an channel half-operator, false otherwise.
16333              
16334             =head3 C
16335              
16336             Takes two arguments, a nick and a channel name. Returns true if that nick
16337             has channel voice, false otherwise.
16338              
16339             =head2 Server actions
16340              
16341             =head3 C
16342              
16343             Takes two arguments, a nickname and a comment (which is optional); Issues
16344             a SERVER KILL of the given nick;
16345              
16346             =head3 C
16347              
16348             First argument is a channel name, remaining arguments are channel modes
16349             and their parameters to apply.
16350              
16351             =head3 C
16352              
16353             Takes two arguments that are mandatory: a nickname of a user and a channel
16354             name. The user will join the channel.
16355              
16356             =head3 C
16357              
16358             Takes two arguments that are mandatory and an optional one: channel name,
16359             nickname of the user to kick and a pithy comment.
16360              
16361             =head3 C
16362              
16363             Takes two arguments that are mandatory and an optional one: channel name,
16364             nickname of the user to remove and a pithy comment.
16365              
16366             =head3 C
16367              
16368             Takes one argument, the message text to send.
16369              
16370             =head3 C
16371              
16372             Sends server notices.
16373              
16374             Takes one mandatory argument, the message text to send.
16375              
16376             Second argument is the notice type, this can be C, C
16377             or C. Defaults to C.
16378              
16379             Third argument is a umode flag. The notice will be sent to OPERs who
16380             have this umode set. Default is none and the notice will be sent to
16381             all OPERs.
16382              
16383             =head1 INPUT EVENTS
16384              
16385             These are POE events that can be sent to the component.
16386              
16387             =head2 C
16388              
16389             Takes a single argument a hashref which should have the following keys:
16390              
16391             =over 4
16392              
16393             =item * B<'nick'>, the nickname to add, mandatory;
16394              
16395             =item * B<'user'>, the ident you want the nick to have, defaults to the
16396             same as the nick;
16397              
16398             =item * B<'hostname'>, the hostname, defaults to the server name;
16399              
16400             =item * B<'umode'>, specify whether this is to be an IRCop etc, defaults
16401             to 'i';
16402              
16403             =item * B<'ts'>, unixtime, default is time(), best not to meddle;
16404              
16405             =back
16406              
16407             B spoofed nicks are currently only really functional for use as IRC
16408             services.
16409              
16410             =head2 C
16411              
16412             Takes a single mandatory argument, the spoofed nickname to remove.
16413             Optionally, you may specify a quit message for the spoofed nick.
16414              
16415             =head2 Spoofed nick commands
16416              
16417             The following input events are for the benefit of spoofed nicks. All
16418             require a nickname of a spoofed nick as the first argument.
16419              
16420             =head3 C
16421              
16422             Takes two arguments, a spoofed nick and a channel name to join.
16423              
16424             =head3 C
16425              
16426             Takes two arguments, a spoofed nick and a channel name to part from.
16427              
16428             =head3 C
16429              
16430             Takes at least three arguments, a spoofed nick, a channel and a channel
16431             mode to apply. Additional arguments are parameters for the channel modes.
16432              
16433             =head3 C
16434              
16435             Takes at least three arguments, a spoofed nick, a channel name and the
16436             nickname of a user to kick from that channel. You may supply a fourth
16437             argument which will be the kick comment.
16438              
16439             =head3 C
16440              
16441             Takes three arguments, a spoofed nick, a channel name and the topic to
16442             set on that channel. If the third argument is an empty string then the
16443             channel topic will be unset.
16444              
16445             =head3 C
16446              
16447             Takes two arguments, a spoofed nick and a new nickname to change to.
16448              
16449             =head3 C
16450              
16451             Takes a number of arguments depending on where the KLINE is to be applied
16452             and for how long:
16453              
16454             To set a permanent KLINE:
16455              
16456             $ircd->yield(
16457             'daemon_cmd_kline',
16458             $spoofed_nick,
16459             $nick || $user_host_mask,
16460             $reason,
16461             );
16462              
16463             To set a temporary 10 minute KLINE:
16464              
16465             $ircd->yield(
16466             'daemon_cmd_kline',
16467             $spoofed_nick,
16468             10,
16469             $nick || $user_host_mask,
16470             $reason,
16471             );
16472              
16473             To set a temporary 10 minute KLINE on all servers:
16474              
16475             $ircd->yield(
16476             'daemon_cmd_kline',
16477             $spoofed_nick,
16478             10,
16479             $nick || $user_host_mask,
16480             'on',
16481             '*',
16482             $reason,
16483             );
16484              
16485             =head3 C
16486              
16487             Removes a KLINE as indicated by the user@host mask supplied.
16488              
16489             To remove a KLINE:
16490              
16491             $ircd->yield(
16492             'daemon_cmd_unkline',
16493             $spoofed_nick,
16494             $user_host_mask,
16495             );
16496              
16497             To remove a KLINE from all servers:
16498              
16499             $ircd->yield(
16500             'daemon_cmd_unkline',
16501             $spoofed_nick,
16502             $user_host_mask,
16503             'on',
16504             '*',
16505             );
16506              
16507             =head3 C
16508              
16509             Used to set a regex based KLINE. The regex given must be based on a
16510             user@host mask.
16511              
16512             To set a permanent RKLINE:
16513              
16514             $ircd->yield(
16515             'daemon_cmd_rkline',
16516             $spoofed_nick,
16517             '^.*$@^(yahoo|google|microsoft)\.com$',
16518             $reason,
16519             );
16520              
16521             To set a temporary 10 minute RKLINE:
16522              
16523             $ircd->yield(
16524             'daemon_cmd_rkline',
16525             $spoofed_nick,
16526             10,
16527             '^.*$@^(yahoo|google|microsoft)\.com$',
16528             $reason,
16529             );
16530              
16531             =head3 C
16532              
16533             Removes an RKLINE as indicated by the user@host mask supplied.
16534              
16535             To remove a RKLINE:
16536              
16537             $ircd->yield(
16538             'daemon_cmd_unrkline',
16539             $spoofed_nick,
16540             $user_host_mask,
16541             );
16542              
16543             =head3 C
16544              
16545             Takes two arguments a spoofed nickname and an existing channel name. This
16546             command will then manipulate the channel timestamp to clear all modes on
16547             that channel, including existing channel operators, reset the channel mode
16548             to '+nt', the spoofed nick will then join the channel and gain channel ops.
16549              
16550             =head3 C
16551              
16552             Takes three arguments, a spoofed nickname, a target (which can be a
16553             nickname or a channel name) and whatever text you wish to send.
16554              
16555             =head3 C
16556              
16557             Takes three arguments, a spoofed nickname, a target (which can be a
16558             nickname or a channel name) and whatever text you wish to send.
16559              
16560             =head3 C
16561              
16562             Takes two arguments, a spoofed nickname and the text message to send to
16563             local operators.
16564              
16565             =head3 C
16566              
16567             Takes two arguments, a spoofed nickname and the text message to send to
16568             all operators.
16569              
16570             =head3 C
16571              
16572             Takes two arguments, a spoofed nickname and the text message to send to
16573             all operators.
16574              
16575             =head1 OUTPUT EVENTS
16576              
16577             =head2 C
16578              
16579             =over
16580              
16581             =item Emitted: when we fail to register with a peer;
16582              
16583             =item Target: all plugins and registered sessions;
16584              
16585             =item Args:
16586              
16587             =over 4
16588              
16589             =item * C, the connection id;
16590              
16591             =item * C, the server name;
16592              
16593             =item * C, the reason;
16594              
16595             =back
16596              
16597             =back
16598              
16599             =head2 C
16600              
16601             =over
16602              
16603             =item Emitted: when a server is introduced onto the network;
16604              
16605             =item Target: all plugins and registered sessions;
16606              
16607             =item Args:
16608              
16609             =over 4
16610              
16611             =item * C, the server name;
16612              
16613             =item * C, the name of the server that is introducing them;
16614              
16615             =item * C, the hop count;
16616              
16617             =item * C, the server description;
16618              
16619             =back
16620              
16621             =back
16622              
16623             =head2 C
16624              
16625             =over
16626              
16627             =item Emitted: when a server quits the network;
16628              
16629             =item Target: all plugins and registered sessions;
16630              
16631             =item Args:
16632              
16633             =over 4
16634              
16635             =item * C, the server name;
16636              
16637             =back
16638              
16639             =back
16640              
16641             =head2 C
16642              
16643             =over
16644              
16645             =item Emitted: when a user is introduced onto the network or changes their
16646             nickname
16647              
16648             =item Target: all plugins and registered sessions;
16649              
16650             =item Args (new user):
16651              
16652             =over 4
16653              
16654             =item * C, the nickname;
16655              
16656             =item * C, the hop count;
16657              
16658             =item * C, the time stamp (TS);
16659              
16660             =item * C, the user mode;
16661              
16662             =item * C, the ident;
16663              
16664             =item * C, the hostname;
16665              
16666             =item * C, the server name;
16667              
16668             =item * C, the real name;
16669              
16670             =back
16671              
16672             =item Args (nick change):
16673              
16674             =over 4
16675              
16676             =item * C, the full nick!user@host;
16677              
16678             =item * C, the new nickname;
16679              
16680             =back
16681              
16682             =back
16683              
16684             =head2 C
16685              
16686             =over
16687              
16688             =item Emitted: when a user changes their user mode;
16689              
16690             =item Target: all plugins and registered sessions;
16691              
16692             =item Args:
16693              
16694             =over 4
16695              
16696             =item * C, the full nick!user@host;
16697              
16698             =item * C, the user mode change;
16699              
16700             =back
16701              
16702             =back
16703              
16704             =head2 C
16705              
16706             =over
16707              
16708             =item Emitted: when a user quits or the server they are on squits;
16709              
16710             =item Target: all plugins and registered sessions;
16711              
16712             =item Args:
16713              
16714             =over 4
16715              
16716             =item * C, the full nick!user@host;
16717              
16718             =item * C, the quit message;
16719              
16720             =back
16721              
16722             =back
16723              
16724             =head2 C
16725              
16726             =over
16727              
16728             =item Emitted: when a user joins a channel
16729              
16730             =item Target: all plugins and registered sessions;
16731              
16732             =item Args:
16733              
16734             =over 4
16735              
16736             =item * C, the full nick!user@host;
16737              
16738             =item * C, the channel name;
16739              
16740             =back
16741              
16742             =back
16743              
16744             =head2 C
16745              
16746             =over
16747              
16748             =item Emitted: when a user parts a channel;
16749              
16750             =item Target: all plugins and registered sessions;
16751              
16752             =item Args:
16753              
16754             =over 4
16755              
16756             =item * C, the full nick!user@host;
16757              
16758             =item * C, the channel name;
16759              
16760             =item * C, the part message;
16761              
16762             =back
16763              
16764             =back
16765              
16766             =head2 C
16767              
16768             =over
16769              
16770             =item Emitted: when a user is kicked from a channel;
16771              
16772             =item Target: all plugins and registered sessions;
16773              
16774             =item Args:
16775              
16776             =over 4
16777              
16778             =item * C, the full nick!user@host of the kicker;
16779              
16780             =item * C, the channel name;
16781              
16782             =item * C, the nick of the kicked user;
16783              
16784             =item * C, the kick message;
16785              
16786             =back
16787              
16788             =back
16789              
16790             =head2 C
16791              
16792             =over
16793              
16794             =item Emitted: when a channel mode is changed;
16795              
16796             =item Target: all plugins and registered sessions;
16797              
16798             =item Args:
16799              
16800             =over 4
16801              
16802             =item * C, the full nick!user@host or server name;
16803              
16804             =item * C, the channel name;
16805              
16806             =item * C, the modes and their arguments;
16807              
16808             =back
16809              
16810             =back
16811              
16812             =head2 C
16813              
16814             =over
16815              
16816             =item Emitted: when a channel topic is changed
16817              
16818             =item Target: all plugins and registered sessions;
16819              
16820             =item Args:
16821              
16822             =over 4
16823              
16824             =item * C, the full nick!user@host of the changer;
16825              
16826             =item * C, the channel name;
16827              
16828             =item * C, the new topic;
16829              
16830             =back
16831              
16832             =back
16833              
16834             =head2 C
16835              
16836             =over
16837              
16838             =item Emitted: when a channel message is sent (a spoofed nick must be in
16839             the channel)
16840              
16841             =item Target: all plugins and registered sessions;
16842              
16843             =item Args:
16844              
16845             =over 4
16846              
16847             =item * C, the full nick!user@host of the sender;
16848              
16849             =item * C, the channel name;
16850              
16851             =item * C, the message;
16852              
16853             =back
16854              
16855             =back
16856              
16857             =head2 C
16858              
16859             =over
16860              
16861             =item Emitted: when someone sends a private message to a spoofed nick
16862              
16863             =item Target: all plugins and registered sessions;
16864              
16865             =item Args:
16866              
16867             =over 4
16868              
16869             =item * C, the full nick!user@host of the sender;
16870              
16871             =item * C, the spoofed nick targeted;
16872              
16873             =item * C, the message;
16874              
16875             =back
16876              
16877             =back
16878              
16879             =head2 C
16880              
16881             =over
16882              
16883             =item Emitted: when someone sends a notice to a spoofed nick or channel
16884              
16885             =item Target: all plugins and registered sessions;
16886              
16887             =item Args:
16888              
16889             =over 4
16890              
16891             =item * C, the full nick!user@host of the sender;
16892              
16893             =item * C, the spoofed nick targeted or channel spoofed nick is in;
16894              
16895             =item * C, the message;
16896              
16897             =back
16898              
16899             =back
16900              
16901             =head2 C
16902              
16903             =over
16904              
16905             =item Emitted: when the server issues a notice for various reasons
16906              
16907             =item Target: all plugins and registered sessions;
16908              
16909             =item Args:
16910              
16911             =over 4
16912              
16913             =item * C, the message;
16914              
16915             =back
16916              
16917             =back
16918              
16919             =head2 C
16920              
16921             =over
16922              
16923             =item Emitted: when someone invites a spoofed nick to a channel;
16924              
16925             =item Target: all plugins and registered sessions;
16926              
16927             =item Args:
16928              
16929             =over 4
16930              
16931             =item * C, the full nick!user@host of the inviter;
16932              
16933             =item * C, the spoofed nick being invited;
16934              
16935             =item * C, the channel being invited to;
16936              
16937             =back
16938              
16939             =back
16940              
16941             =head2 C
16942              
16943             =over
16944              
16945             =item Emitted: when an oper issues a REHASH command;
16946              
16947             =item Target: all plugins and registered sessions;
16948              
16949             =item Args:
16950              
16951             =over 4
16952              
16953             =item * C, the full nick!user@host of the oper;
16954              
16955             =back
16956              
16957             =back
16958              
16959             =head2 C
16960              
16961             =over
16962              
16963             =item Emitted: when an oper issues a DIE command;
16964              
16965             =item Target: all plugins and registered sessions;
16966              
16967             =item Args:
16968              
16969             =over 4
16970              
16971             =item * C, the full nick!user@host of the oper;
16972              
16973             =back
16974              
16975             =back
16976              
16977             B the component will shutdown, this is a feature;
16978              
16979             =head2 C
16980              
16981             =over
16982              
16983             =item Emitted: when an oper issues a DLINE command;
16984              
16985             =item Target: all plugins and registered sessions;
16986              
16987             =item Args:
16988              
16989             =over 4
16990              
16991             =item * C, the full nick!user@host;
16992              
16993             =item * C, the duration;
16994              
16995             =item * C, the network mask;
16996              
16997             =item * C, the reason;
16998              
16999             =back
17000              
17001             =back
17002              
17003             =head2 C
17004              
17005             =over
17006              
17007             =item Emitted: when an oper issues a KLINE command;
17008              
17009             =item Target: all plugins and registered sessions;
17010              
17011             =item Args:
17012              
17013             =over 4
17014              
17015             =item * C, the full nick!user@host;
17016              
17017             =item * C, the target for the KLINE;
17018              
17019             =item * C, the duration in seconds;
17020              
17021             =item * C, the user mask;
17022              
17023             =item * C, the host mask;
17024              
17025             =item * C, the reason;
17026              
17027             =back
17028              
17029             =back
17030              
17031             =head2 C
17032              
17033             =over
17034              
17035             =item Emitted: when an oper issues an RKLINE command;
17036              
17037             =item Target: all plugins and registered sessions;
17038              
17039             =item Args:
17040              
17041             =over 4
17042              
17043             =item * C, the full nick!user@host;
17044              
17045             =item * C, the target for the RKLINE;
17046              
17047             =item * C, the duration in seconds;
17048              
17049             =item * C, the user mask;
17050              
17051             =item * C, the host mask;
17052              
17053             =item * C, the reason;
17054              
17055             =back
17056              
17057             =back
17058              
17059             =head2 C
17060              
17061             =over
17062              
17063             =item Emitted: when an oper issues an UNKLINE command;
17064              
17065             =item Target: all plugins and registered sessions;
17066              
17067             =item Args:
17068              
17069             =over 4
17070              
17071             =item * C, the full nick!user@host;
17072              
17073             =item * C, the target for the UNKLINE;
17074              
17075             =item * C, the user mask;
17076              
17077             =item * C, the host mask;
17078              
17079             =back
17080              
17081             =back
17082              
17083             =head2 C
17084              
17085             =over
17086              
17087             =item Emitted: when a temporary D-Line, X-Line, K-Line or RK-Line expires
17088              
17089             =item Target: all plugins and registered sessions;
17090              
17091             =item Args:
17092              
17093             =over 4
17094              
17095             =item * C, What expired, can be C, C, C or C;
17096              
17097             =item * C, the mask (D-Line and X-Line) or user@host (K-Line and RK-Line);
17098              
17099             =back
17100              
17101             =back
17102              
17103             =head2 C
17104              
17105             =over
17106              
17107             =item Emitted: when the server receives an C message;
17108              
17109             =item Target: all plugins and registered sessions;
17110              
17111             =item Args:
17112              
17113             =over 4
17114              
17115             =item * C, the server name or full nick!user@host;
17116              
17117             =item * C, peermask of targets for the C;
17118              
17119             =item * C, the sub command being propagated;
17120              
17121             =item * Subsequent ARGs are dependent on the sub command;
17122              
17123             =back
17124              
17125             =back
17126              
17127             =head2 C
17128              
17129             =over
17130              
17131             =item Emitted: when an oper issues a LOCOPS command;
17132              
17133             =item Target: all plugins and registered sessions;
17134              
17135             =item Args:
17136              
17137             =over 4
17138              
17139             =item * C, the full nick!user@host;
17140              
17141             =item * C, the locops message;
17142              
17143             =back
17144              
17145             =back
17146              
17147             =head2 C
17148              
17149             =over
17150              
17151             =item Emitted: when an oper or server issues a GLOBOPS;
17152              
17153             =item Target: all plugins and registered sessions;
17154              
17155             =item Args:
17156              
17157             =over 4
17158              
17159             =item * C, the full nick!user@host or server name;
17160              
17161             =item * C, the globops message;
17162              
17163             =back
17164              
17165             =back
17166              
17167             =head2 C
17168              
17169             =over
17170              
17171             =item Emitted: when a server issues a WALLOPS;
17172              
17173             =item Target: all plugins and registered sessions;
17174              
17175             =item Args:
17176              
17177             =over 4
17178              
17179             =item * C, the server name;
17180              
17181             =item * C, the wallops message;
17182              
17183             =back
17184              
17185             =back
17186              
17187             =head1 BUGS
17188              
17189             A few have turned up in the past and they are sure to again. Please use
17190             L to report any. Alternatively, email the current
17191             maintainer.
17192              
17193             =head1 DEVELOPMENT
17194              
17195             You can find the latest source on github:
17196             L
17197              
17198             The project's developers usually hang out in the C<#poe> IRC channel on
17199             irc.perl.org. Do drop us a line.
17200              
17201             =head1 MAINTAINER
17202              
17203             Hinrik Ern SigurEsson
17204              
17205             =head1 AUTHOR
17206              
17207             Chris 'BinGOs' Williams
17208              
17209             =head1 LICENSE
17210              
17211             Copyright C<(c)> Chris Williams
17212              
17213             This module may be used, modified, and distributed under the same terms as
17214             Perl itself. Please see the license that came with your Perl distribution
17215             for details.
17216              
17217             =head1 KUDOS
17218              
17219             Rocco Caputo for creating POE.
17220              
17221             Buu for pestering me when I started to procrastinate =]
17222              
17223             =head1 SEE ALSO
17224              
17225             L L
17226              
17227             L
17228              
17229             L
17230              
17231             Hybrid IRCD L
17232              
17233             RFC 2810 L
17234              
17235             RFC 2811 L
17236              
17237             RFC 2812 L
17238              
17239             RFC 2813 L
17240              
17241             =cut