File Coverage

blib/lib/POE/Component/Server/IRC.pm
Criterion Covered Total %
statement 5494 7730 71.0
branch 1963 3674 53.4
condition 1019 2415 42.1
subroutine 248 295 84.0
pod 46 67 68.6
total 8770 14181 61.8


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.62';
4 182     182   37347489 use strict;
  182         1957  
  182         7428  
5 182     182   1173 use warnings;
  182         428  
  182         6013  
6 182     182   1056 use Carp qw(carp croak);
  182         382  
  182         13793  
7 182         25894 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   103926 is_valid_chan_name has_color has_formatting parse_user);
  182         3625832  
10 182     182   1799 use List::Util qw(sum);
  182         446  
  182         12435  
11 182     182   9992 use POE;
  182         538129  
  182         1414  
12 182     182   1077613 use POE::Component::Server::IRC::Common qw(chkpasswd);
  182         625  
  182         12546  
13 182     182   88695 use POE::Component::Server::IRC::Plugin qw(:ALL);
  182         566  
  182         28279  
14 182     182   1388 use POSIX 'strftime';
  182         421  
  182         2946  
15 182     182   117528 use Net::CIDR ();
  182         1111813  
  182         6996  
16 182     182   1586 use base qw(POE::Component::Server::IRC::Backend);
  182         481  
  182         133442  
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 83651 my ($package, %args) = @_;
26 181         2168 $args{lc $_} = delete $args{$_} for keys %args;
27 181         700 my $config = delete $args{config};
28 181         604 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       1911 map { +"daemon_cmd_$_" => '_spoofed_command' }
  3982         13396  
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       2978 $self->configure($config ? $config : ());
43 181         553 $self->{debug} = $debug;
44 181         1256 $self->_state_create();
45 181         952 return $self;
46             }
47              
48             sub IRCD_connection {
49 524     524 0 1064035 my ($self, $ircd) = splice @_, 0, 2;
50 524         1459 pop @_;
51             my ($conn_id, $peeraddr, $peerport, $sockaddr, $sockport, $needs_auth, $secured, $filter)
52 524         1547 = map { ${ $_ } } @_;
  4192         5980  
  4192         9212  
53              
54 524 50       2674 if ($self->_connection_exists($conn_id)) {
55 0         0 delete $self->{state}{conns}{$conn_id};
56             }
57              
58 524         2126 $self->{state}{conns}{$conn_id}{registered} = 0;
59 524         1727 $self->{state}{conns}{$conn_id}{type} = 'u';
60 524         1784 $self->{state}{conns}{$conn_id}{seen} = time();
61 524         1458 $self->{state}{conns}{$conn_id}{conn_time} = time();
62 524         1493 $self->{state}{conns}{$conn_id}{secured} = $secured;
63 524         1432 $self->{state}{conns}{$conn_id}{stats} = $filter;
64             $self->{state}{conns}{$conn_id}{socket}
65 524         2188 = [$peeraddr, $peerport, $sockaddr, $sockport];
66              
67 524         2719 $self->_state_conn_stats();
68              
69 524 100       1752 if (!$needs_auth) {
70             $self->{state}{conns}{$conn_id}{auth} = {
71 523         3412 hostname => '',
72             ident => '',
73             };
74 523         2386 $self->_client_register($conn_id);
75             }
76              
77 524         2063 return PCSI_EAT_CLIENT;
78             }
79              
80             sub IRCD_connected {
81 3     3 0 703 my ($self, $ircd) = splice @_, 0, 2;
82 3         11 pop @_;
83             my ($conn_id, $peeraddr, $peerport, $sockaddr, $sockport, $name, $filter)
84 3         18 = map { ${ $_ } } @_;
  21         28  
  21         61  
85              
86 3 50       12 if ($self->_connection_exists($conn_id)) {
87 0         0 delete $self->{state}{conns}{$conn_id};
88             }
89              
90 3         13 $self->{state}{conns}{$conn_id}{peer} = $name;
91 3         18 $self->{state}{conns}{$conn_id}{registered} = 0;
92 3         11 $self->{state}{conns}{$conn_id}{cntr} = 1;
93 3         11 $self->{state}{conns}{$conn_id}{type} = 'u';
94 3         9 $self->{state}{conns}{$conn_id}{seen} = time();
95 3         9 $self->{state}{conns}{$conn_id}{conn_time} = time();
96 3         7 $self->{state}{conns}{$conn_id}{stats} = $filter;
97             $self->{state}{conns}{$conn_id}{socket}
98 3         15 = [$peeraddr, $peerport, $sockaddr, $sockport];
99              
100 3         22 $self->_state_conn_stats();
101 3         19 $self->_state_send_credentials($conn_id, $name);
102 3         15 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 253 my ($self, $ircd) = splice @_, 0, 2;
144 1         7 pop @_;
145 1         4 my ($conn_id, $ref) = map { ${ $_ } } @_;
  2         3  
  2         9  
146 1 50       3 return PCSI_EAT_CLIENT if !$self->_connection_exists($conn_id);
147              
148 1         5 $self->{state}{conns}{$conn_id}{auth} = $ref;
149 1         16 $self->_client_register($conn_id);
150 1         3 return PCSI_EAT_CLIENT;
151             }
152              
153             sub IRCD_disconnected {
154 487     487 0 403818 my ($self, $ircd) = splice @_, 0, 2;
155 487         1316 pop @_;
156 487         1452 my ($conn_id, $errstr) = map { ${ $_ } } @_;
  974         1686  
  974         3233  
157 487 50       2220 return PCSI_EAT_CLIENT if !$self->_connection_exists($conn_id);
158              
159 487 100       1971 if ($self->_connection_is_peer($conn_id)) {
    100          
160 227         920 my $peer = $self->{state}{conns}{$conn_id}{sid};
161             $self->send_output(
162 227         548 @{ $self->_daemon_peer_squit($conn_id, $peer, $errstr) }
  227         1266  
163             );
164             }
165             elsif ($self->_connection_is_client($conn_id)) {
166             $self->send_output(
167 217         696 @{ $self->_daemon_cmd_quit(
  217         1163  
168             $self->_client_nickname($conn_id,$errstr ),
169             $errstr,
170             )}
171             );
172             }
173              
174 487         7053 delete $self->{state}{conns}{$conn_id};
175 487         2020 return PCSI_EAT_CLIENT;
176             }
177              
178             sub IRCD_compressed_conn {
179 2     2 0 489 my ($self, $ircd) = splice @_, 0, 2;
180 2         5 pop @_;
181 2         5 my ($conn_id) = map { ${ $_ } } @_;
  2         3  
  2         7  
182 2         10 $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 13402     13402   4426654 my ($self, $ircd, $event) = splice @_, 0, 3;
206 13402 100       55980 return PCSI_EAT_NONE if $event !~ /^IRCD_cmd_/;
207 4161         8456 pop @_;
208 4161         9119 my ($conn_id, $input) = map { $$_ } @_;
  8322         21503  
209              
210 4161 50       12724 return PCSI_EAT_CLIENT if !$self->_connection_exists($conn_id);
211 4161 100       10694 return PCSI_EAT_CLIENT if $self->_connection_terminated($conn_id);
212 4140         11107 $self->{state}{conns}{$conn_id}{seen} = time;
213              
214 4140 100       11030 if (!$self->_connection_registered($conn_id)) {
    100          
    50          
215 1433         4497 $self->_cmd_from_unknown($conn_id, $input);
216             }
217             elsif ($self->_connection_is_peer($conn_id)) {
218 1906         5631 $self->_cmd_from_peer($conn_id, $input);
219             }
220             elsif ($self->_connection_is_client($conn_id)) {
221 801         1903 delete $input->{prefix};
222 801         4022 $self->_cmd_from_client($conn_id, $input);
223             }
224              
225 4140         14461 return PCSI_EAT_CLIENT;
226             }
227              
228             sub _auth_finished {
229 245     245   714 my $self = shift;
230 245   50     1260 my $conn_id = shift || return;
231 245 50       976 return if !$self->_connection_exists($conn_id);
232 245         880 return $self->{state}{conns}{$conn_id}{auth};
233             }
234              
235             sub _connection_exists {
236 23075     23075   38094 my $self = shift;
237 23075   50     49204 my $conn_id = shift || return;
238 23075 100       57154 return if !defined $self->{state}{conns}{$conn_id};
239 22547         55478 return 1;
240             }
241              
242             sub _connection_terminated {
243 4675     4675   8122 my $self = shift;
244 4675   50     11129 my $conn_id = shift || return;
245 4675 50       11666 return if !defined $self->{state}{conns}{$conn_id};
246 4675 100       19589 return 1 if defined $self->{state}{conns}{$conn_id}{terminated};
247             }
248              
249             sub _client_register {
250 1064     1064   2284 my $self = shift;
251 1064   50     3186 my $conn_id = shift || return;
252 1064 50       2745 return if !$self->_connection_exists($conn_id);
253 1064 100       4059 return if !$self->{state}{conns}{$conn_id}{nick};
254 501 100       1915 return if !$self->{state}{conns}{$conn_id}{user};
255 255 100       1923 return if $self->{state}{conns}{$conn_id}{capneg};
256 245         1274 my $server = $self->server_name();
257              
258 245         1256 my $auth = $self->_auth_finished($conn_id);
259 245 50       1083 return if !$auth;
260             # pass required for link
261 245 100       1519 if (!$self->_state_auth_client_conn($conn_id)) {
262 5         18 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         70 $crec->{socket}[2], $crec->{socket}[3],
268             ),
269             'Notice', 'u',
270             );
271 5         26 $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       1263 if ($self->{auth}) {
278 1 50 33     21 if ( $self->{state}{conns}{$conn_id}{need_ident} &&
279             !$self->{state}{conns}{$conn_id}{auth}{ident} ) {
280 1         23 $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         18 $self->_terminate_conn_error(
292             $conn_id,
293             'Install identd',
294             );
295 1         3 return;
296             }
297             }
298 239 100       1383 if (my $reason = $self->_state_user_matches_xline($conn_id)) {
299 5         19 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     100 $crec->{socket}[0],
307             ),
308             'Notice',
309             'j',
310             );
311 5         33 $self->_send_output_to_client( $conn_id, '465' );
312 5         51 $self->_terminate_conn_error($conn_id, "X-Lined: [$reason]");
313 5         12 return;
314             }
315 234 100       1386 if (my $reason = $self->_state_user_matches_kline($conn_id)) {
316 5         44 $self->_send_output_to_client( $conn_id, '465' );
317 5         40 $self->_terminate_conn_error($conn_id, "K-Lined: [$reason]");
318 5         18 return;
319             }
320 229 100       1281 if (my $reason = $self->_state_user_matches_rkline($conn_id)) {
321 2         21 $self->_send_output_to_client( $conn_id, '465' );
322 2         15 $self->_terminate_conn_error($conn_id, "K-Lined: [$reason]");
323 2         5 return;
324             }
325              
326 227 50 66     4049 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         681 my $clients = keys %{ $self->{state}{sids}{$self->server_sid()}{uids} };
  227         1281  
348 227 50       1382 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         1295 my $uid = $self->_state_register_client($conn_id);
359 227         869 my $umode = $self->{state}{conns}{$conn_id}{umode};
360 227         1125 my $nick = $self->_client_nickname($conn_id);
361 227         762 my $port = $self->{state}{conns}{$conn_id}{socket}[3];
362 227         949 my $version = $self->server_version();
363 227         1227 my $network = $self->server_config('NETWORK');
364 227         1216 my $server_is = "$server\[$server/$port]";
365              
366 227 100       1777 if (my $sslinfo = $self->connection_secured($conn_id)) {
367 8         84 $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         1460 $self->_state_auth_flags_notices($conn_id);
381              
382 227         3137 $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         2472 $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         1592 $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         2331 $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         836 for my $output (@{ $self->_daemon_do_isupport($uid) }) {
  227         1658  
430 454         1259 $output->{prefix} = $server;
431 454         1051 $output->{params}[0] = $nick;
432 454         1829 $self->_send_output_to_client($conn_id, $output);
433             }
434              
435 227         1434 $self->{state}{conns}{$conn_id}{registered} = 1;
436 227         785 $self->{state}{conns}{$conn_id}{type} = 'c';
437              
438 227         671 $self->send_output( $_, $conn_id ) for
439 1352         2419 map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  1352         2184  
  1352         3677  
440 227         1388 @{ $self->_daemon_do_lusers($uid) };
441              
442              
443 227         1584 $self->send_output( $_, $conn_id ) for
444 227         897 map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  227         682  
  227         1582  
445 227         1272 @{ $self->_daemon_do_motd($uid) };
446              
447 227 100       1272 if ( $umode ) {
448             $self->send_output(
449             {
450 8         42 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         2294 'cmd_mode',
460             $conn_id,
461             {
462             command => 'MODE',
463             params => [$nick, "+i"],
464             },
465             );
466              
467 227         33456 return 1;
468             }
469              
470             sub _connection_registered {
471 4281     4281   7778 my $self = shift;
472 4281   50     10951 my $conn_id = shift || return;
473 4281 50       9662 return if !$self->_connection_exists($conn_id);
474 4281         16447 return $self->{state}{conns}{$conn_id}{registered};
475             }
476              
477             sub _connection_is_peer {
478 6608     6608   11660 my $self = shift;
479 6608   50     15588 my $conn_id = shift || return;
480              
481 6608 50       14488 return if !$self->_connection_exists($conn_id);
482 6608 100       18883 return if !$self->{state}{conns}{$conn_id}{registered};
483 5070 100       18025 return 1 if $self->{state}{conns}{$conn_id}{type} eq 'p';
484 1980         7445 return;
485             }
486              
487             sub _connection_is_client {
488 1096     1096   2425 my $self = shift;
489 1096   50     3398 my $conn_id = shift || return;
490              
491 1096 50       3710 return if !$self->_connection_exists($conn_id);
492 1096 100       3757 return if !$self->{state}{conns}{$conn_id}{registered};
493 1053 100       5018 return 1 if $self->{state}{conns}{$conn_id}{type} eq 'c';
494 6         26 return;
495             }
496              
497             sub _cmd_from_unknown {
498 1433     1433   3483 my ($self, $wheel_id, $input) = @_;
499              
500 1433         4068 my $cmd = uc $input->{command};
501 1433   100     4050 my $params = $input->{params} || [ ];
502 1433         2709 my $pcount = @$params;
503 1433         2589 my $invalid = 0;
504              
505             SWITCH: {
506 1433 50       2474 if ($cmd eq 'ERROR') {
  1433         3875  
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       5495 if ($cmd eq 'QUIT') {
518 7         40 $self->_terminate_conn_error($wheel_id, 'Client Quit');
519 7         23 last SWITCH;
520             }
521              
522 1426 100       3546 if ($cmd eq 'CAP' ) {
523 141         638 $self->_daemon_cmd_cap($wheel_id, @$params);
524 141         266 last SWITCH;
525             }
526              
527             # PASS or NICK cmd but no parameters.
528 1285 50 66     9165 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     4865 if ($cmd eq 'PASS' && $pcount) {
535 264         2835 $self->{state}{conns}{$wheel_id}{lc $cmd} = $params->[0];
536              
537 264 100 66     2727 if ($params->[1] && $params->[1] =~ /TS$/) {
538 262         919 $self->{state}{conns}{$wheel_id}{ts_server} = 1;
539 262         1523 $self->antiflood($wheel_id, 0);
540              
541             # TS6 server
542             # PASS password TS 6 6FU
543 262 100 66     2258 if ($params->[2] && $params->[3]) {
544 261         728 $self->{state}{conns}{$wheel_id}{ts_data} = [ @{$params}[2,3] ];
  261         1283  
545 261         775 my $ts = $params->[2];
546 261         1008 my $sid = $params->[3];
547 261         588 my $errstr;
548 261 100 66     3913 if ($sid !~ $sid_re || $ts ne '6') {
    100          
549 1         3 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         14 $crec->{socket}[0], $sid,
554             ), qw[Notice s],
555             );
556 1         9 $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       1059 if ($errstr) {
569 2         11 $self->_terminate_conn_error($wheel_id, $errstr);
570 2         8 last SWITCH;
571             }
572             }
573             else {
574 1         5 $self->_terminate_conn_error($wheel_id, 'Incompatible TS version' );
575 1         5 last SWITCH;
576             }
577             }
578 261         735 last SWITCH;
579             }
580              
581             # SERVER stuff.
582 1021 100 66     4511 if ($cmd eq 'CAPAB' && $pcount) {
583             $self->{state}{conns}{$wheel_id}{capab}
584 259         4331 = [split /\s+/, $params->[0]];
585 259         1056 last SWITCH;
586             }
587 762 50 66     3359 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       2273 if ($cmd eq 'SERVER') {
592 259         760 my $conn = $self->{state}{conns}{$wheel_id};
593 259         878 $conn->{name} = $params->[0];
594 259   50     1242 $conn->{hops} = $params->[1] || 1;
595 259   50     1201 $conn->{desc} = $params->[2] || '(unknown location)';
596              
597 259 50 33     2329 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       1062 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         1610 $conn->{name}, $conn->{pass});
608 259 100 66     1986 if (!$result || $result <= 0) {
609 2         6 my $errstr; my $snotice;
610 2 50 33     29 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         4 $snotice = 'Bad password';
616 1         2 $errstr = 'Invalid password.';
617             }
618             elsif ($result == -2) {
619 1         4 $snotice = 'Invalid certificate fingerprint';
620 1         2 $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         34 ),
631             'Notice', 's',
632             );
633 2         13 $self->_terminate_conn_error(
634             $wheel_id,
635             $errstr,
636             );
637 2         7 last SWITCH;
638             }
639 257 50       1491 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         1502 $self->_state_register_peer($wheel_id);
650              
651 257 100 100     1801 if ($conn->{zip} && grep { $_ eq 'ZIP' } @{ $conn->{capab} }) {
  4029         7686  
  253         933  
652 2         15 $self->compressed_link($wheel_id, 1, $conn->{cntr});
653             }
654             else {
655 255         1765 $self->_state_send_burst($wheel_id);
656             }
657              
658             $self->send_event(
659             "daemon_capab",
660             $conn->{name},
661 257         822 @{ $conn->{capab} },
  257         1622  
662             );
663 257         39854 last SWITCH;
664             }
665              
666 503 100 66     2625 if ($cmd eq 'NICK' && $pcount) {
667 252         1453 my $nicklen = $self->server_config('NICKLEN');
668 252 50       1334 if (length($params->[0]) > $nicklen) {
669 0         0 $params->[0] = substr($params->[0], 0, $nicklen);
670             }
671              
672 252 50       1775 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       4934 if ($self->state_nick_exists($params->[0])) {
682 1         5 $self->_send_output_to_client(
683             $wheel_id,
684             '433',
685             $params->[0],
686             );
687 1         3 last SWITCH;
688             }
689              
690 251 100       1650 if ( my $reason = $self->_state_is_resv( $params->[0], $wheel_id ) ) {
691 5         32 $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         24 last SWITCH;
703             }
704              
705 246         1262 $self->{state}{conns}{$wheel_id}{lc $cmd} = $params->[0];
706 246         1270 $self->{state}{pending}{uc_irc($params->[0])} = $wheel_id;
707 246         4724 $self->_client_register($wheel_id);
708 246         760 last SWITCH;
709             }
710 251 50 33     2184 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       1420 if ($cmd eq 'USER') {
715 251         1183 $self->{state}{conns}{$wheel_id}{user} = $params->[0];
716 251   50     1593 $self->{state}{conns}{$wheel_id}{ircname} = $params->[3] || '';
717 251         1299 $self->_client_register($wheel_id);
718 251         703 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       4334 return 1 if $invalid;
727 1433         6323 $self->_state_cmd_stat($cmd, $input->{raw_line});
728 1433         3502 return 1;
729             }
730              
731             sub _cmd_from_peer {
732 1906     1906   4357 my ($self, $conn_id, $input) = @_;
733              
734 1906         4892 my $cmd = uc $input->{command};
735 1906         3787 my $params = $input->{params};
736 1906         3600 my $prefix = $input->{prefix};
737 1906         4844 my $sid = $self->server_sid();
738 1906         3539 my $invalid = 0;
739              
740             SWITCH: {
741 1906         3257 my $method = '_daemon_peer_' . lc $cmd;
  1906         5126  
742 1906 100 66     6116 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 1905 50 66     7285 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 1905 100 66     5482 if ($cmd =~ /\d{3}/ && $params->[0] =~ m!^$sid!) {
760 11         39 $input->{prefix} = $self->_state_sid_name($prefix);
761 11         25 my $uid = $params->[0];
762 11         32 $input->{params}[0] = $self->state_user_nick($uid);
763 11         39 $self->send_output(
764             $input,
765             $self->_state_uid_route($uid),
766             );
767 11         40 last SWITCH;
768             }
769 1894 100       4661 if ($cmd eq 'QUIT') {
770             $self->send_output(
771 5         16 @{ $self->_daemon_peer_quit(
  5         30  
772             $prefix, @$params, $conn_id
773             )}
774             );
775 5         16 last SWITCH;
776             }
777              
778 1889 100       5161 if ($cmd =~ /^(PRIVMSG|NOTICE)$/) {
779             $self->_send_output_to_client(
780             $conn_id,
781             $prefix,
782 0         0 (ref $_ eq 'ARRAY' ? @{ $_ } : $_)
783 7 0       72 ) for $self->_daemon_peer_message(
784             $conn_id,
785             $prefix,
786             $cmd,
787             @$params
788             );
789 7         17 last SWITCH;
790             }
791              
792 1882 100       6070 if ($cmd =~ /^(VERSION|TIME|LINKS|ADMIN|INFO|MOTD|STATS)$/i ) {
793 6         13 my $client_method = '_daemon_peer_miscell';
794 6 100       18 $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       29 ) for $self->$client_method($cmd, $prefix, @$params);
800 6         43 last SWITCH;
801             }
802              
803 1876 100 66     7091 if ($cmd =~ /^(PING|PONG)$/i && $self->can($method)) {
804 255         779 $self->$method($conn_id, $prefix, @{ $params });
  255         1245  
805 255         704 last SWITCH;
806             }
807              
808 1621 100 66     6238 if ($cmd =~ /^SVINFO$/i && $self->can($method)) {
809 257         1516 $self->$method($conn_id, @$params);
810 257         811 my $conn = $self->{state}{conns}{$conn_id};
811             $self->send_event(
812             "daemon_svinfo",
813             $conn->{name},
814 257         1488 @$params,
815             );
816 257         35761 last SWITCH;
817             }
818              
819 1364 100       3613 if ( $cmd =~ m!^E?TRACE$!i ) {
820 4         23 $self->send_output( $_, $conn_id ) for
821             $self->_daemon_peer_tracing($cmd, $conn_id, $prefix, @$params);
822 4         26 last SWITCH;
823             }
824              
825             # Chanmode and umode have distinct commands now
826             # No need for check, MODE is always umode
827 1360 50       3435 if ($cmd eq 'MODE') {
828 0         0 $method = '_daemon_peer_umode';
829             }
830              
831 1360 100       3947 if ($cmd =~ m!^(UN)?([DKX]LINE|RESV)$!i ) {
832 12         84 $self->send_output( $_, $conn_id ) for
833             $self->$method($conn_id, $prefix, @$params);
834 12         59 last SWITCH;
835             }
836              
837 1348 100       3405 if ($cmd =~ m!^WHO(IS|WAS)$!i ) {
838 4         30 $self->send_output( $_, $conn_id ) for
839             $self->$method($conn_id, $prefix, @$params);
840 4         88 last SWITCH;
841             }
842              
843 1344 50       6128 if ($self->can($method)) {
844 1344         6393 $self->$method($conn_id, $prefix, @$params);
845 1344         3202 last SWITCH;
846             }
847 0         0 $invalid = 1;
848             }
849              
850 1906 50       5184 return 1 if $invalid;
851 1906         7545 $self->_state_cmd_stat($cmd, $input->{raw_line}, 1);
852 1906         4242 return 1;
853             }
854              
855             sub _cmd_from_client {
856 801     801   2493 my ($self, $wheel_id, $input) = @_;
857              
858 801         2647 my $cmd = uc $input->{command};
859 801   100     3374 my $params = $input->{params} || [ ];
860 801         1668 my $pcount = @$params;
861 801         2976 my $server = $self->server_name();
862 801         2836 my $nick = $self->_client_nickname($wheel_id);
863 801         2848 my $uid = $self->_client_uid($wheel_id);
864 801         2188 my $invalid = 0;
865 801         1822 my $pseudo = 0;
866              
867             SWITCH: {
868 801         1638 my $method = '_daemon_cmd_' . lc $cmd;
  801         2768  
869 801 100       2811 if ($cmd eq 'QUIT') {
870 200         646 my $qmsg = $params->[0];
871 200         684 delete $self->{state}{localops}{ $wheel_id };
872 200 100 100     1661 if ( $qmsg and my $msgtime = $self->{config}{anti_spam_exit_message_time} ) {
873             $qmsg = '' if
874 7 50       50 time - $self->{state}{conns}{$wheel_id}->{conn_time} < $msgtime;
875             }
876             $self->_terminate_conn_error(
877 200 100       1931 $wheel_id,
878             ($qmsg ? qq{Quit: "$qmsg"} : 'Client Quit'),
879             );
880 200         658 last SWITCH;
881             }
882              
883 601 50 66     5553 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       2178 if ($cmd =~ /^(USERHOST)$/) {
888             $self->_send_output_to_client($wheel_id, $_)
889 1 50       9 for $self->$method(
890             $nick,
891             ($pcount <= 5
892             ? @$params
893 0         0 : @{ $params }[0..5]
894             )
895             );
896 1         4 last SWITCH;
897             }
898              
899 600 100       2144 if ($cmd =~ /^(PRIVMSG|NOTICE)$/) {
900 30         171 $self->{state}{conns}{$wheel_id}{idle_time} = time;
901             $self->_send_output_to_client(
902             $wheel_id,
903 7         37 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
904 30 100       165 ) for $self->_daemon_cmd_message($nick, $cmd, @$params);
905 30         99 last SWITCH;
906             }
907              
908 570 100 100     3206 if ($cmd eq 'MODE' && $self->state_nick_exists($params->[0])) {
909 231 50       908 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       5747 for $self->_daemon_cmd_umode($nick, @{ $params }[1..$#{ $params }]);
  231         1518  
  231         713  
916 231         1219 last SWITCH;
917             }
918              
919 339 50       1382 if ($cmd eq 'CAP') {
920 0         0 $self->_daemon_cmd_cap($wheel_id, @$params);
921 0         0 last SWITCH;
922             }
923              
924 339 100       1686 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       28 ) for $self->_daemon_client_miscell($cmd, $nick, @$params);
929 6         44 last SWITCH;
930             }
931              
932 333 100       1422 if ( $cmd =~ m!^E?TRACE$!i ) {
933             $self->_send_output_to_client(
934             $wheel_id,
935 1         3 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
936 6 100       43 ) for $self->_daemon_client_tracing($cmd, $nick, @$params);
937 6         34 last SWITCH;
938             }
939              
940 327 100       2396 if ($self->can($method)) {
941             $self->_send_output_to_client(
942             $wheel_id,
943 34         219 (ref $_ eq 'ARRAY' ? @{ $_ } : $_),
944 323 100       1875 ) for $self->$method($nick, @$params);
945 323         1237 last SWITCH;
946             }
947              
948 4 100       15 if (defined $self->{config}{pseudo}{$cmd}) {
949 3         6 $pseudo = 1;
950 3         7 my $pseudo = $self->{config}{pseudo}{$cmd};
951 3 100       7 if (!$params->[0]) {
952 1         5 $self->_send_output_to_client($wheel_id, '412');
953 1         3 last SWITCH;
954             }
955 2         10 my $targ = $self->state_user_nick($pseudo->{nick});
956 2         18 my $serv = $self->_state_peer_name($pseudo->{host});
957 2 100 66     11 if ( !$targ || !$serv ) {
958 1         6 $self->_send_output_to_client($wheel_id, '440', $pseudo->{name});
959 1         3 last SWITCH;
960             }
961 1         3 my $msg;
962 1 50       4 if ($pseudo->{prepend}) {
963 1 50       6 my $join = ($pseudo->{prepend} =~ m! $! ? '' : ' ');
964 1         4 $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       7 ) for $self->_daemon_cmd_message($nick, 'PRIVMSG', $pseudo->{nick}, $msg);
973 1         3 last SWITCH;
974             }
975              
976 1         3 $invalid = 1;
977 1         4 $self->_send_output_to_client($wheel_id, '421', $cmd);
978             }
979              
980 801 100 100     4699 return 1 if $invalid || $pseudo;
981 797         4643 $self->_state_cmd_stat($cmd, $input->{raw_line});
982 797         2202 return 1;
983             }
984              
985             sub _daemon_cmd_help {
986 5     5   15 my $self = shift;
987 5   50     19 my $nick = shift || return;
988 5         17 my $server = $self->server_name();
989 5         14 my $ref = [ ];
990 5         26 my $args = [@_];
991 5         16 my $count = @$args;
992              
993             SWITCH: {
994 5 100       10 if (!$self->state_user_is_operator($nick)) {
  5         24  
995 2         34 my $lastuse = $self->{state}{lastuse}{help};
996 2         5 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         4 $self->{state}{lastuse}{help} = time();
1002             }
1003 4   100     20 my $item = shift @$args || 'index';
1004 4 100       22 if (!$self->{_help}) {
1005 2         1781 require POE::Component::Server::IRC::Help;
1006 2         22 $self->{_help} = POE::Component::Server::IRC::Help->new();
1007             }
1008 4         13 $item = lc $item;
1009 4         22 my @lines = $self->{_help}->topic($item);
1010 4 100       18 if (!scalar @lines) {
1011 1         6 push @$ref, [ '524', $item ];
1012 1         5 last SWITCH;
1013             }
1014 3         9 my $reply = '704';
1015 3         11 foreach my $line (@lines) {
1016 43         150 push @$ref, {
1017             prefix => $server,
1018             command => $reply,
1019             params => [
1020             $nick,
1021             $item,
1022             $line,
1023             ],
1024             };
1025 43         80 $reply = '705';
1026             }
1027 3         18 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   10 my $self = shift;
1044 4   50     25 my $nick = shift || return;
1045 4         12 my $server = $self->server_name();
1046 4         12 my $ref = [ ];
1047 4         13 my $args = [@_];
1048 4         9 my $count = @$args;
1049              
1050             SWITCH: {
1051 4 50       9 if (!$count) {
  4         12  
1052 0         0 $args->[0] = 'l';
1053             }
1054 4         19 my $uid = $self->state_user_uid($nick);
1055 4   100     78 my $watches = $self->{state}{uids}{$uid}{watches} || { };
1056 4         11 my $list = 0;
1057 4         22 ITEM: foreach my $item ( split m!,!, $args->[0] ) {
1058 6 100       24 if ( $item =~ m!^\+! ) {
1059 4         14 $item =~ s!^\+!!;
1060 4 50       19 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     19 next ITEM if !$item || !is_valid_nick_name($item);
1065             # Add_to_watch_list
1066 4         64 $watches->{uc_irc $item} = $item;
1067 4         55 $self->{state}{watches}{uc_irc $item}{uids}{$uid} = 1;
1068             # Show_watch possible refactor here
1069 4 50       54 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         69 push @$ref, {
1087             prefix => $server,
1088             command => '605',
1089             params => [
1090             $nick, $item, '*', '*', $laston, 'is offline'
1091             ],
1092             };
1093             }
1094 4         28 next ITEM;
1095             }
1096 2 50       13 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       10 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       12 if ( $item =~ m!^S!i ) {
1141 2 50       11 next ITEM if $list & 0x1;
1142 2         8 $item = substr $item, 0, 1;
1143 2         6 $list |= 0x1;
1144 2         29 my @watching = sort keys %$watches;
1145 2         7 my $wcount = 0;
1146 2         5 my $mcount = @watching;
1147 2 50       11 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         42 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         8 my $len = length($server) + length($nick) + 8;
1159 2         5 my $buf = '';
1160 2         6 WATCHED: foreach my $watched ( @watching ) {
1161 4         12 $watched = $watches->{$watched};
1162 4 50       17 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         12 $buf = join ' ', $buf, $watched;
1172 4         16 $buf =~ s!^\s+!!;
1173             }
1174 2 50       10 if ($buf) {
1175 2         11 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         7 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         16 $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   297 my $self = shift;
1241 141   50     382 my $wheel_id = shift || return;
1242 141         272 my $subcmd = shift;
1243 141         372 my $args = [@_];
1244 141         519 my $server = $self->server_name();
1245              
1246 141         355 my $registered = $self->_connection_registered($wheel_id);
1247              
1248             SWITCH: {
1249 141 50       258 if (!$subcmd) {
  141         412  
1250 0         0 $self->_send_output_to_client($wheel_id, '461', 'CAP');
1251 0         0 last SWITCH;
1252             }
1253 141         376 $subcmd = uc $subcmd;
1254 141 50       891 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     750 if ( $subcmd eq 'END' && $registered ) { #NOOP
1259 0         0 last SWITCH;
1260             }
1261 141 100 66     587 if ( $subcmd eq 'END' && !$registered ) {
1262 43         177 my $capneg = delete $self->{state}{conns}{$wheel_id}{capneg};
1263 43 50       327 $self->_client_register($wheel_id) if $capneg;
1264 43         116 last SWITCH;
1265             }
1266 98 50 33     827 $self->{state}{conns}{$wheel_id}{capneg} = 1 if !$registered && $subcmd =~ m!^(LS|REQ)$!;
1267 98 100       382 if ( $subcmd eq 'LS' ) {
1268 32         166 my $output = {
1269             prefix => $server,
1270             command => 'CAP',
1271             params => [ $self->_client_nickname($wheel_id), $subcmd, ],
1272             };
1273 32         96 push @{ $output->{params} }, join ' ', sort keys %{ $self->{state}{caps} };
  32         104  
  32         406  
1274 32         185 $self->_send_output_to_client($wheel_id, $output);
1275 32         103 last SWITCH;
1276             }
1277 66 50       269 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       209 if ( $subcmd eq 'REQ' ) {
1288 66         289 foreach my $cap ( split ' ', $args->[0] ) {
1289 73         165 my $ocap = $cap;
1290 73         211 my $neg = $cap =~ s!^\-!!;
1291 73         171 $cap = lc $cap;
1292 73 100       341 if ( !$self->{state}{caps}{$cap} ) {
1293 23         549 my $output = {
1294             prefix => $server,
1295             command => 'CAP',
1296             params => [ $self->_client_nickname($wheel_id), 'NAK', $args->[0] ],
1297             };
1298 23         153 $self->_send_output_to_client($wheel_id, $output);
1299 23         126 last SWITCH;
1300             }
1301 50 50       222 if ( $neg ) {
1302 0         0 delete $self->{state}{conns}{$wheel_id}{caps}{$cap};
1303             }
1304             else {
1305 50         219 $self->{state}{conns}{$wheel_id}{caps}{$cap} = 1;
1306             }
1307             }
1308 43         231 my $output = {
1309             prefix => $server,
1310             command => 'CAP',
1311             params => [ $self->_client_nickname($wheel_id), 'ACK', $args->[0] ],
1312             };
1313 43         235 $self->_send_output_to_client($wheel_id, $output);
1314 43         162 last SWITCH;
1315             }
1316             }
1317              
1318 141         380 return 1;
1319             }
1320              
1321             sub _daemon_cmd_message {
1322 31     31   71 my $self = shift;
1323 31   50     131 my $nick = shift || return;
1324 31   50     98 my $type = shift || return;
1325 31         80 my $ref = [ ];
1326 31         85 my $args = [@_];
1327 31         74 my $count = @$args;
1328              
1329             SWITCH: {
1330 31 50       63 if (!$count) {
  31         89  
1331 0         0 push @$ref, ['461', $type];
1332 0         0 last SWITCH;
1333             }
1334 31 50 33     212 if ($count < 2 || !$args->[1]) {
1335 0         0 push @$ref, ['412'];
1336 0         0 last SWITCH;
1337             }
1338              
1339 31         77 my $targets = 0;
1340 31         99 my $max_targets = $self->server_config('MAXTARGETS');
1341 31         118 my $uid = $self->state_user_uid($nick);
1342 31         437 my $sid = $self->server_sid();
1343 31         109 my $full = $self->state_user_full($nick);
1344 31         219 my $targs = $self->_state_parse_msg_targets($args->[0]);
1345              
1346 31         154 LOOP: for my $target (keys %$targs) {
1347 31         63 my $targ_type = shift @{ $targs->{$target} };
  31         85  
1348              
1349 31 50 33     127 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     136 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     129 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     120 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     151 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     202 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     182 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       102 if ($targets > $max_targets) {
1393 0         0 push @$ref, ['407', $target];
1394 0         0 last SWITCH;
1395             }
1396              
1397             # $$whatever
1398 31 50       122 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       106 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       135 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         149 my ($channel, $status_msg);
1579 31 100       116 if ($targ_type eq 'channel') {
1580 17         74 $channel = $self->_state_chan_name($target);
1581             }
1582 31 50       333 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     160 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       136 if ($channel) {
1592 17         91 my $res = $self->state_can_send_to_channel($nick,$channel,$args->[1],$type);
1593 17 50       104 if ( !$res ) {
    100          
1594 0         0 next LOOP;
1595             }
1596             elsif ( ref $res eq 'ARRAY' ) {
1597 7         30 push @$ref, $res;
1598 7         51 next LOOP;
1599             }
1600 10 100 100     96 if ( $res != 2 && $self->state_flood_attack_channel($nick,$channel,$type) ) {
1601 1         6 next LOOP;
1602             }
1603 9         26 my $common = { };
1604 9 50       54 my $msg = {
1605             command => $type,
1606             params => [
1607             ($status_msg ? $target : $channel), $args->[1]
1608             ],
1609             };
1610 9         54 for my $member ($self->state_chan_list($channel, $status_msg)) {
1611 27 50       74 next if $self->_state_user_is_deaf($member);
1612 27         375 $common->{ $self->_state_user_route($member) }++;
1613             }
1614 9         35 delete $common->{ $self->_state_user_route($nick) };
1615 9         49 for my $route_id (keys %$common) {
1616 18         46 $msg->{prefix} = $uid;
1617 18 100       53 if ($self->_connection_is_client($route_id)) {
1618 17         66 $msg->{prefix} = $full;
1619             }
1620 18 50       58 if ($route_id ne 'spoofed') {
1621 18         114 $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         68 next LOOP;
1634             }
1635              
1636 14         48 my $server = $self->server_name();
1637 14 50       38 if ($self->state_nick_exists($target)) {
1638 14         60 $target = $self->state_user_nick($target);
1639              
1640             # Flood check
1641 14 100       218 next LOOP if $self->state_flood_attack_client($nick,$target,$type);
1642              
1643 13 50       62 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         226 my $targ_umode = $self->state_user_umode($target);
1652              
1653             # Target user has CALLERID on
1654 13 100 66     264 if ($targ_umode && $targ_umode =~ /[Gg]/) {
1655 1         6 my $targ_rec = $self->{state}{users}{uc_irc($target)};
1656 1         14 my $targ_uid = $targ_rec->{uid};
1657 1         3 my $local = $targ_uid =~ m!^sid!;
1658 1 50 0     15 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         20 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     5 if (!$targ_rec->{last_caller}
1675             || time() - $targ_rec->{last_caller} >= 60) {
1676              
1677 1         4 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         13 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         3 $targ_rec->{last_caller} = time();
1702 1         7 next LOOP;
1703             }
1704             }
1705              
1706 12         42 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         52 my $route_id = $self->_state_user_route($target);
1713              
1714 12 100       44 if ($route_id eq 'spoofed') {
1715 2         5 $msg->{prefix} = $full;
1716 2         10 $self->send_event(
1717             "daemon_" . lc $type,
1718             $full,
1719             $target,
1720             $args->[1],
1721             );
1722             }
1723             else {
1724 10 100       35 if ($self->_connection_is_client($route_id)) {
1725 5         11 $msg->{prefix} = $full;
1726 5         16 $msg->{params}[0] = $target;
1727             }
1728 10         51 $self->send_output($msg, $route_id);
1729             }
1730 12         287 next LOOP;
1731             }
1732             }
1733             }
1734              
1735 31 50       225 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   644 my $self = shift;
1854 226   50     1057 my $nick = shift || return;
1855 226         662 my $qmsg = shift;
1856 226         726 my $ref = [ ];
1857 226         883 my $name = uc $self->server_name();
1858 226         911 my $sid = $self->server_sid();
1859              
1860 226         1290 $nick = uc_irc($nick);
1861 226         4451 my $record = delete $self->{state}{peers}{$name}{users}{$nick};
1862 226 50       1000 $qmsg = 'Client Quit' if !$qmsg;
1863 226         1013 my $full = $record->{full}->();
1864 226         1117 delete $self->{state}{peers}{$name}{uids}{ $record->{uid} };
1865 226         744 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       2406 ) if !$record->{killed};
1874              
1875 226         1770 push @$ref, {
1876             prefix => $full,
1877             command => 'QUIT',
1878             params => [$qmsg],
1879             };
1880 226         1506 $self->send_event("daemon_quit", $full, $qmsg);
1881              
1882             # Remove from peoples accept lists
1883 226         27166 for my $user (keys %{ $record->{accepts} }) {
  226         1841  
1884 0         0 delete $self->{state}{users}{$user}{accepts}{uc_irc($nick)};
1885             }
1886              
1887 226 100       1570 if ( defined $self->{state}{watches}{$nick} ) {
1888 1         4 my $laston = time();
1889 1         4 $self->{state}{watches}{$nick}{laston} = $laston;
1890 1         2 foreach my $wuid ( keys %{ $self->{state}{watches}{$nick}{uids} } ) {
  1         6  
1891 1 50       6 next if !defined $self->{state}{uids}{$wuid};
1892 1         4 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         13 );
1908             }
1909             }
1910             # clear WATCH list
1911 226         601 foreach my $watched ( keys %{ $record->{watches} } ) {
  226         1084  
1912 4         14 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         23  
1915             }
1916              
1917             # Okay, all 'local' users who share a common channel with user.
1918 226         707 my $common = { };
1919 226         617 for my $uchan (keys %{ $record->{chans} }) {
  226         1061  
1920 92         435 delete $self->{state}{chans}{$uchan}{users}{$uid};
1921 92         240 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  92         386  
1922 81 100       1248 next if $user !~ m!^$sid!;
1923 56         277 $common->{$user} = $self->_state_uid_route($user);
1924             }
1925              
1926 92 100       252 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  92         573  
1927 39         276 delete $self->{state}{chans}{$uchan};
1928             }
1929             }
1930              
1931 226         1033 push @$ref, $common->{$_} for keys %$common;
1932 226 100       1380 $self->{state}{stats}{ops_online}-- if $record->{umode} =~ /o/;
1933 226 100       1479 $self->{state}{stats}{invisible}-- if $record->{umode} =~ /i/;
1934 226 100       1434 delete $self->{state}{users}{$nick} if !$record->{nick_collision};
1935 226         889 delete $self->{state}{uids}{ $record->{uid} };
1936 226         778 delete $self->{state}{localops}{$record->{route_id}};
1937 226         3671 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         540 server => $name,
1947             };
1948 226 50       1079 return @$ref if wantarray;
1949 226         1772 return $ref;
1950             }
1951              
1952             sub _daemon_cmd_ping {
1953 3     3   6 my $self = shift;
1954 3   50     7 my $nick = shift || return;
1955 3         8 my $server = $self->server_name();
1956 3         7 my $sid = $self->server_sid();
1957 3         8 my $args = [ @_ ];
1958 3         6 my $count = @$args;
1959 3         4 my $ref = [ ];
1960              
1961             SWITCH: {
1962 3 100       7 if (!$count) {
  3         7  
1963 1         3 push @$ref, [ '409' ];
1964 1         3 last SWITCH;
1965             }
1966              
1967 2 100 66     11 if ($count >= 2 && !$self->state_peer_exists($args->[1])) {
1968 1         5 push @$ref, ['402', $args->[1]];
1969 1         2 last SWITCH;
1970             }
1971 1 50 33     10 if ($count >= 2 && (uc $args->[1] ne uc $server)) {
1972 1         5 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       18 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   79 my $self = shift;
2049 25   50     102 my $nick = shift || return;
2050 25         86 my $server = $self->server_name();
2051 25         92 my $sid = $self->server_sid();
2052 25         71 my $ref = [ ];
2053 25         77 my $args = [@_];
2054 25         69 my $count = @$args;
2055              
2056             SWITCH: {
2057 25 50       69 last SWITCH if $self->state_user_is_operator($nick);
  25         223  
2058 25 50 33     662 if (!$count || $count < 2) {
2059 0         0 push @$ref, ['461', 'OPER'];
2060 0         0 last SWITCH;
2061             }
2062              
2063 25         134 my $record = $self->{state}{users}{uc_irc($nick)};
2064 25         400 my $result = $self->_state_o_line($nick, @$args);
2065 25 100 100     250 if (!$result || $result <= 0) {
2066 3         8 my $omsg; my $errcode = '491';
  3         9  
2067 3 100       20 if (!defined $result) {
    50          
    100          
    50          
2068 1         21 $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         3 $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         18 $args->[0], $nick, (split /!/, $record->{full}->())[1], $omsg),
2087             'Notice',
2088             's',
2089             );
2090 3         10 push @$ref, [$errcode];
2091 3         11 last SWITCH;
2092             }
2093 22         89 my $opuser = $args->[0];
2094 22         167 $self->{stats}{ops}++;
2095 22         76 $record->{umode} .= 'o';
2096 22         72 $record->{opuser} = $opuser;
2097 22         74 $self->{state}{stats}{ops_online}++;
2098 22         172 push @$ref, {
2099             prefix => $server,
2100             command => '381',
2101             params => [$nick, 'You are now an IRC operator'],
2102             };
2103              
2104 22         123 my @peers = $self->_state_connected_peers();
2105              
2106 22 50       155 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     136 my $umode = $self->{config}{ops}{$opuser}{umode} || $self->{config}{oper_umode};
2127 22         80 $record->{umode} .= $umode;
2128 22         61 $umode .= 'o';
2129 22         210 $umode = join '', sort split //, $umode;
2130              
2131 22         84 my $uid = $record->{uid};
2132 22         96 my $full = $record->{full}->();
2133              
2134 22         128 my $notice = sprintf("%s{%s} is now an operator",$full,$opuser);
2135              
2136 22         229 $self->send_output(
2137             {
2138             prefix => $sid,
2139             command => 'GLOBOPS',
2140             params => [ $notice ],
2141             },
2142             @peers,
2143             );
2144              
2145 22         161 $self->_send_to_realops( $notice );
2146              
2147 22         184 my $reply = {
2148             prefix => $uid,
2149             command => 'MODE',
2150             params => [$uid, "+$umode"],
2151             };
2152              
2153 22         153 $self->send_output(
2154             $reply,
2155             @peers,
2156             );
2157 22         166 $self->send_event(
2158             "daemon_umode",
2159             $full,
2160             "+$umode",
2161             );
2162              
2163              
2164 22         2915 my $route_id = $record->{route_id};
2165 22         92 $self->{state}{localops}{$route_id} = time;
2166 22         148 $self->antiflood($route_id, 0);
2167 22         130 $reply->{prefix} = $full;
2168 22         104 $reply->{params}[0] = $record->{nick};
2169 22         112 push @$ref, $reply;
2170             }
2171              
2172 25 50       321 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         3 my $server = $self->server_name();
2180 1         3 my $ref = [ ];
2181              
2182             SWITCH: {
2183 1 50       2 if (!$self->state_user_is_operator($nick)) {
  1         4  
2184 0         0 push @$ref, ['481'];
2185 0         0 last SWITCH;
2186             }
2187 1         6 $self->send_event("daemon_die", $nick);
2188 1         107 $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   2 my $self = shift;
2196 1   50     4 my $nick = shift || return;
2197 1         3 my $server = $self->server_name();
2198 1         3 my $ref = [ ];
2199              
2200             SWITCH: {
2201 1 50       3 if (!$self->state_user_is_operator($nick)) {
  1         5  
2202 0         0 push @$ref, ['723','close'];
2203 0         0 last SWITCH;
2204             }
2205 1         6 $self->send_event("daemon_close", $nick);
2206 1         100 my $count = 0;
2207 1         2 foreach my $conn_id ( keys %{ $self->{state}{conns} } ) {
  1         6  
2208 6 100       18 next if $self->{state}{conns}{$conn_id}{type} ne 'u';
2209 1         2 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     36 $crec->{socket}[0],
      50        
2220             ),
2221             'Closed: status = unknown',
2222             ],
2223             };
2224 1         4 $count++;
2225 1         7 $self->_terminate_conn_error($conn_id,'Oper Closing');
2226             }
2227 1         6 push @$ref, {
2228             prefix => $server,
2229             command => '363',
2230             params => [
2231             $nick,
2232             $count,
2233             'Connections closed',
2234             ],
2235             };
2236             }
2237 1 50       10 return @$ref if wantarray;
2238 0         0 return $ref;
2239             }
2240              
2241             sub _daemon_cmd_set {
2242 5     5   11 my $self = shift;
2243 5   50     12 my $nick = shift || return;
2244 5         10 my $server = $self->server_name();
2245 5         11 my $ref = [ ];
2246 5         11 my $args = [@_];
2247 5         10 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   5 my $val = shift;
2327 2 100 66     32 if ( $val && $val >= 0 ) {
2328 1 50       5 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         3 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         10 ),
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     10 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         9 ),
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         99 );
2489              
2490             SWITCH: {
2491 5 50       11 if (!$self->state_user_is_operator($nick)) {
  5         14  
2492 0         0 push @$ref, ['481'];
2493 0         0 last SWITCH;
2494             }
2495 5 100       15 if ($count > 0) {
2496 4 50       13 if ( defined $vars{ uc $args->[0] } ) {
2497 4         17 $vars{ uc $args->[0] }->( $args->[1] );
2498 4         10 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         8 push @$ref, {
2511             prefix => $server,
2512             command => 'NOTICE',
2513             params => [
2514             $nick,
2515             'Available QUOTE SET commands:',
2516             ],
2517             };
2518 1         3 my @names;
2519 1         9 foreach my $var ( sort keys %vars ) {
2520 8         14 push @names, $var;
2521 8 100       19 if ( scalar @names == 4 ) {
2522 2         38 push @$ref, {
2523             prefix => $server,
2524             command => 'NOTICE',
2525             params => [
2526             $nick,
2527             join(' ',@names),
2528             ],
2529             };
2530 2         13 @names = ();
2531             }
2532             }
2533 1 50       21 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       130 return @$ref if wantarray;
2545 0         0 return $ref;
2546             }
2547              
2548             sub _daemon_cmd_rehash {
2549 1     1   4 my $self = shift;
2550 1   50     4 my $nick = shift || return;
2551 1         4 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         4  
2556 0         0 push @$ref, ['481'];
2557 0         0 last SWITCH;
2558             }
2559 1         5 $self->send_event("daemon_rehash", $nick);
2560 1         108 push @$ref, {
2561             prefix => $server,
2562             command => '383',
2563             params => [$nick, 'ircd.conf', 'Rehashing'],
2564             };
2565             }
2566 1 50       9 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     9 my $nick = shift || return;
2817 2         10 my $server = $self->server_name();
2818 2         5 my $ref = [ ];
2819 2         6 my $args = [@_];
2820 2         5 my $count = @$args;
2821              
2822             SWITCH: {
2823 2 50       4 if (!$self->state_user_is_operator($nick)) {
  2         10  
2824 0         0 push @$ref, ['481'];
2825 0         0 last SWITCH;
2826             }
2827 2 50 33     19 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       22 if ($args->[0] =~ /^\d+$/) {
2833 1         3 $duration = shift @$args;
2834 1 50       3 $duration = 14400 if $duration > 14400;
2835             }
2836 2         6 my $mask = shift @$args;
2837 2 50       7 if (!$mask) {
2838 0         0 push @$ref, ['461', 'RKLINE'];
2839 0         0 last SWITCH;
2840             }
2841 2         9 my ($user, $host) = split /\@/, $mask;
2842 2 50 33     12 if (!$user || !$host) {
2843 0         0 last SWITCH;
2844             }
2845 2         11 my $full = $self->state_user_full($nick);
2846 2         6 my $reason;
2847              
2848             {
2849 2 50       4 if (!$reason) {
  2         7  
2850 2   50     6 $reason = pop @$args || '';
2851             }
2852             $self->send_event(
2853 2         14 "daemon_rkline",
2854             $full,
2855             $server,
2856             $duration,
2857             $user,
2858             $host,
2859             $reason,
2860             );
2861              
2862 2 50       240 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         8 my $reply_notice = "Added ${temp}RK-Line [$user\@host]";
2869 2         9 my $locop_notice = "$full added ${temp}RK-Line for [$user\@$host] [$reason]";
2870              
2871 2         13 push @$ref, {
2872             prefix => $server,
2873             command => 'NOTICE',
2874             params => [ $nick, $reply_notice ],
2875             };
2876              
2877 2         12 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
2878              
2879 2         9 $self->_state_do_local_users_match_rkline($user, $host, $reason);
2880             }
2881             }
2882              
2883 2 50       24 return @$ref if wantarray;
2884 2         9 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         7 my $server = $self->server_name();
2891 1         4 my $ref = [ ];
2892 1         4 my $args = [@_];
2893 1         3 my $count = @$args;
2894              
2895             SWITCH: {
2896 1 50       5 if (!$self->state_user_is_operator($nick)) {
  1         6  
2897 0         0 push @$ref, ['481'];
2898 0         0 last SWITCH;
2899             }
2900 1 50 33     9 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     8 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       3 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         32 my $full = $self->state_user_full($nick);
2917              
2918 1         9 $self->send_event(
2919             "daemon_unrkline", $full, $server, $user, $host,
2920             );
2921              
2922 1         116 push @$ref, {
2923             prefix => $server,
2924             command => 'NOTICE',
2925             params => [ $nick, "RK-Line for [$user\@$host] is removed" ],
2926             };
2927              
2928 1         9 $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   11 my $self = shift;
2937 4   50     15 my $nick = shift || return;
2938 4         15 my $server = $self->server_name();
2939 4         10 my $ref = [ ];
2940 4         14 my $args = [@_];
2941 4         53 my $count = @$args;
2942             # KLINE [time] [ ON ] :[reason]
2943              
2944             SWITCH: {
2945 4 50       33 if (!$self->state_user_is_operator($nick)) {
  4         19  
2946 0         0 push @$ref, ['481'];
2947 0         0 last SWITCH;
2948             }
2949 4 50 33     181 if (!$count || $count < 1) {
2950 0         0 push @$ref, ['461', 'KLINE'];
2951 0         0 last SWITCH;
2952             }
2953 4         81 my $duration = 0;
2954 4 100       42 if ($args->[0] =~ /^\d+$/) {
2955 2         7 $duration = shift @$args;
2956 2 50       11 $duration = 14400 if $duration > 14400;
2957             }
2958 4         13 my $mask = shift @$args;
2959 4 50       24 if (!$mask) {
2960 0         0 push @$ref, ['461', 'KLINE'];
2961 0         0 last SWITCH;
2962             }
2963 4         14 my ($user, $host);
2964 4 50       19 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         21 ($user, $host) = split /\@/, $mask;
2975             }
2976              
2977 4         36 my $full = $self->state_user_full($nick);
2978 4         10 my $us = 0;
2979 4         22 my $ucserver = uc $server;
2980 4 50 66     77 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         14 my ($target, $reason);
2986 4 100 66     39 if ($args->[0] && uc $args->[0] eq 'ON') {
2987 1         4 my $on = shift @$args;
2988 1         3 $target = shift @$args;
2989 1   50     73 $reason = shift @$args || 'No Reason';
2990 1         6 my %targets;
2991              
2992 1         3 for my $peer (keys %{ $self->{state}{peers} }) {
  1         9  
2993 4 50       12 if (matches_mask($target, $peer)) {
2994 4 100       195 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         6 grep { $self->_state_peer_capab($_, 'KLN') } keys %targets,
  2         28  
3016             );
3017             }
3018             else {
3019 3         8 $us = 1;
3020             }
3021              
3022 4 50       19 if ($us) {
3023 4 100       15 $target = $server if !$target;
3024 4 100       14 if (!$reason) {
3025 3   50     12 $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         40 $self->send_event(
3031             "daemon_kline",
3032             $full,
3033             $target,
3034             $duration,
3035             $user,
3036             $host,
3037             $reason,
3038             );
3039              
3040 4 100       507 my $temp = $duration ? "temporary $duration min. " : '';
3041              
3042 4         18 my $reply_notice = "Added ${temp}K-Line [$user\@host]";
3043 4         23 my $locop_notice = "$full added ${temp}K-Line for [$user\@$host] [$reason]";
3044              
3045 4         34 push @$ref, {
3046             prefix => $server,
3047             command => 'NOTICE',
3048             params => [ $nick, $reply_notice ],
3049             };
3050              
3051 4         26 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3052              
3053 4         25 $self->_state_do_local_users_match_kline($user, $host, $reason);
3054             }
3055             }
3056              
3057 4 50       15 return @$ref if wantarray;
3058 4         28 return $ref;
3059             }
3060              
3061             sub _daemon_cmd_unkline {
3062 2     2   6 my $self = shift;
3063 2   50     10 my $nick = shift || return;
3064 2         11 my $server = $self->server_name();
3065 2         7 my $ref = [ ];
3066 2         7 my $args = [@_];
3067 2         7 my $count = @$args;
3068             # UNKLINE [ ON ]
3069              
3070             SWITCH: {
3071 2 50       4 if (!$self->state_user_is_operator($nick)) {
  2         11  
3072 0         0 push @$ref, ['481'];
3073 0         0 last SWITCH;
3074             }
3075 2 50 33     18 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       13 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         13 ($user, $host) = split /\@/, $args->[0];
3091             }
3092              
3093 2         10 my $full = $self->state_user_full($nick);
3094 2         6 my $us = 0;
3095 2         7 my $ucserver = uc $server;
3096 2 50 66     18 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     19 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         6 $us = 1;
3126             }
3127              
3128 2 50       8 last SWITCH if !$us;
3129              
3130 2   33     24 my $target = $args->[3] || $server;
3131              
3132 2         11 my $result = $self->_state_del_drkx_line( 'kline', $user, $host );
3133              
3134 2 50       9 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         13 "daemon_unkline", $full, $target, $user, $host,
3141             );
3142              
3143 2         253 push @$ref, {
3144             prefix => $server,
3145             command => 'NOTICE',
3146             params => [ $nick, "K-Line for [$user\@$host] is removed" ],
3147             };
3148              
3149 2         24 $self->_send_to_realops( "$full has removed the K-Line for: [$user\@$host]", 'Notice', 's' );
3150             }
3151              
3152 2 50       9 return @$ref if wantarray;
3153 2         8 return $ref;
3154             }
3155              
3156             sub _daemon_cmd_resv {
3157 6     6   19 my $self = shift;
3158 6   50     24 my $nick = shift || return;
3159 6         26 my $server = $self->server_name();
3160 6         25 my $sid = $self->server_sid();
3161 6         71 my $ref = [ ];
3162 6         22 my $args = [ @_ ];
3163 6         14 my $count = @$args;
3164              
3165             SWITCH: {
3166 6 50       12 if (!$self->state_user_is_operator($nick)) {
  6         27  
3167 0         0 push @$ref, ['481'];
3168 0         0 last SWITCH;
3169             }
3170 6 50 33     93 if (!$count || $count < 2) {
3171 0         0 push @$ref, ['461', 'RESV'];
3172 0         0 last SWITCH;
3173             }
3174 6         19 my $duration = 0;
3175 6 100       52 if ($args->[0] =~ /^\d+$/) {
3176 2         7 $duration = shift @$args;
3177 2 50       12 $duration = 14400 if $duration > 14400;
3178             }
3179 6         23 my $mask = shift @$args;
3180 6 50       33 if (!$mask) {
3181 0         0 push @$ref, ['461', 'RESV'];
3182 0         0 last SWITCH;
3183             }
3184 6 50 66     56 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         16 my ($peermask,$reason);
3190 6         14 my $us = 0;
3191 6 100 66     99 if ($args->[0] && uc $args->[0] eq 'ON') {
3192 1         4 my $on = shift @$args;
3193 1         3 $peermask = shift @$args;
3194 1   50     3 $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         9  
3197 4 50       19 if (matches_mask($peermask, $peer)) {
3198 4 100       210 if ($ucserver eq $peer) {
3199 1         75 $us = 1;
3200             }
3201             else {
3202 3         13 $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         6 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         25  
3218             );
3219             }
3220             else {
3221 5         24 $us = 1;
3222             }
3223              
3224 6 50       22 last SWITCH if !$us;
3225              
3226 6 50       57 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       29 if ( !$reason ) {
3236 5   50     36 $reason = shift @$args || '';
3237             }
3238              
3239 6         50 my $full = $self->state_user_full($nick);
3240              
3241 6 50       64 last SWITCH if !$self->_state_add_drkx_line( 'resv', $full, time(), $server,
3242             $duration * 60, $mask, $reason );
3243 6         47 $self->send_event(
3244             "daemon_resv",
3245             $full,
3246             $mask,
3247             $duration,
3248             $reason,
3249             );
3250              
3251 6 100       731 my $temp = $duration ? "temporary $duration min. " : '';
3252              
3253 6         31 my $reply_notice = "Added ${temp}RESV [$mask]";
3254 6         29 my $locop_notice = "$full added ${temp}RESV for [$mask] [$reason]";
3255              
3256 6         51 push @$ref, {
3257             prefix => $server,
3258             command => 'NOTICE',
3259             params => [ $nick, $reply_notice ],
3260             };
3261              
3262 6         36 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3263              
3264             }
3265              
3266 6 50       27 return @$ref if wantarray;
3267 6         30 return $ref;
3268             }
3269              
3270             sub _daemon_cmd_unresv {
3271 4     4   15 my $self = shift;
3272 4   50     19 my $nick = shift || return;
3273 4         28 my $server = $self->server_name();
3274 4         16 my $sid = $self->server_sid();
3275 4         12 my $ref = [ ];
3276 4         13 my $args = [ @_ ];
3277 4         12 my $count = @$args;
3278              
3279             SWITCH: {
3280 4 50       11 if (!$self->state_user_is_operator($nick)) {
  4         37  
3281 0         0 push @$ref, ['481'];
3282 0         0 last SWITCH;
3283             }
3284 4 50       20 if (!$count ) {
3285 0         0 push @$ref, ['461', 'UNRESV'];
3286 0         0 last SWITCH;
3287             }
3288 4         26 my $unmask = shift @$args;
3289 4 50 66     33 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         2 my %targpeers; my $ucserver = uc $server;
  1         4  
3299 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         7  
3300 4 50       13 if (matches_mask($peermask, $peer)) {
3301 4 100       194 if ($ucserver eq $peer) {
3302 1         4 $us = 1;
3303             }
3304             else {
3305 3         24 $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         5 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         27  
3320             );
3321             }
3322             else {
3323 3         8 $us = 1;
3324             }
3325              
3326 4 50       18 last SWITCH if !$us;
3327              
3328 4         23 my $result = $self->_state_del_drkx_line( 'resv', $unmask );
3329              
3330 4 50       15 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         20 my $full = $self->state_user_full($nick);
3336 4         26 $self->send_event(
3337             "daemon_unresv",
3338             $full,
3339             $unmask,
3340             );
3341              
3342 4         476 push @$ref, {
3343             prefix => $server,
3344             command => 'NOTICE',
3345             params => [ $nick, "RESV for [$unmask] is removed" ],
3346             };
3347              
3348 4         82 $self->_send_to_realops( "$full has removed the RESV for: [$unmask]", 'Notice', 's' );
3349             }
3350              
3351 4 50       17 return @$ref if wantarray;
3352 4         17 return $ref;
3353             }
3354              
3355             sub _daemon_cmd_xline {
3356 3     3   9 my $self = shift;
3357 3   50     12 my $nick = shift || return;
3358 3         12 my $server = $self->server_name();
3359 3         19 my $sid = $self->server_sid();
3360 3         10 my $ref = [ ];
3361 3         10 my $args = [ @_ ];
3362 3         8 my $count = @$args;
3363              
3364             SWITCH: {
3365 3 50       6 if (!$self->state_user_is_operator($nick)) {
  3         17  
3366 0         0 push @$ref, ['481'];
3367 0         0 last SWITCH;
3368             }
3369 3 50 33     34 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       27 if ($args->[0] =~ /^\d+$/) {
3375 2         7 $duration = shift @$args;
3376 2 50       11 $duration = 14400 if $duration > 14400;
3377             }
3378 3         8 my $mask = shift @$args;
3379 3 50       14 if (!$mask) {
3380 0         0 push @$ref, ['461', 'XLINE'];
3381 0         0 last SWITCH;
3382             }
3383 3 50 66     30 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         8 my ($peermask,$reason);
3389 3         8 my $us = 0;
3390 3 100 66     27 if ($args->[0] && uc $args->[0] eq 'ON') {
3391 1         3 my $on = shift @$args;
3392 1         2 $peermask = shift @$args;
3393 1   50     4 $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         8  
3396 4 50       17 if (matches_mask($peermask, $peer)) {
3397 4 100       204 if ($ucserver eq $peer) {
3398 1         74 $us = 1;
3399             }
3400             else {
3401 3         23 $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         5 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         27  
3417             );
3418             }
3419             else {
3420 2         5 $us = 1;
3421             }
3422              
3423 3 50       12 last SWITCH if !$us;
3424              
3425 3 100       11 if ( !$reason ) {
3426 2   50     7 $reason = shift @$args || '';
3427             }
3428              
3429 3         19 my $full = $self->state_user_full($nick);
3430              
3431 3 50       26 last SWITCH if !$self->_state_add_drkx_line( 'xline', $full, time(), $server,
3432             $duration * 60, $mask, $reason );
3433 3         22 $self->send_event(
3434             "daemon_xline",
3435             $full,
3436             $mask,
3437             $duration,
3438             $reason,
3439             );
3440              
3441 3 100       371 my $temp = $duration ? "temporary $duration min. " : '';
3442              
3443 3         15 my $reply_notice = "Added ${temp}X-Line [$mask]";
3444 3         16 my $locop_notice = "$full added ${temp}X-Line for [$mask] [$reason]";
3445              
3446 3         20 push @$ref, {
3447             prefix => $server,
3448             command => 'NOTICE',
3449             params => [ $nick, $reply_notice ],
3450             };
3451              
3452 3         21 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3453              
3454 3         22 $self->_state_do_local_users_match_xline($mask,$reason);
3455             }
3456              
3457 3 50       12 return @$ref if wantarray;
3458 3         15 return $ref;
3459             }
3460              
3461             sub _daemon_cmd_unxline {
3462 2     2   7 my $self = shift;
3463 2   50     11 my $nick = shift || return;
3464 2         12 my $server = $self->server_name();
3465 2         9 my $sid = $self->server_sid();
3466 2         7 my $ref = [ ];
3467 2         6 my $args = [ @_ ];
3468 2         8 my $count = @$args;
3469              
3470             SWITCH: {
3471 2 50       5 if (!$self->state_user_is_operator($nick)) {
  2         10  
3472 0         0 push @$ref, ['481'];
3473 0         0 last SWITCH;
3474             }
3475 2 50       8 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     21 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         5 my $us = 0;
3486 2 100 66     16 if ($args->[0] && uc $args->[0] eq 'ON') {
3487 1         4 my $on = shift @$args;
3488 1         3 my $peermask = shift @$args;
3489 1         2 my %targpeers; my $ucserver = uc $server;
  1         3  
3490 1         3 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         7  
3491 4 50       13 if (matches_mask($peermask, $peer)) {
3492 4 100       197 if ($ucserver eq $peer) {
3493 1         3 $us = 1;
3494             }
3495             else {
3496 3         10 $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         5 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         25  
3511             );
3512             }
3513             else {
3514 1         2 $us = 1;
3515             }
3516              
3517 2 50       11 last SWITCH if !$us;
3518              
3519 2         13 my $result = $self->_state_del_drkx_line( 'xline', $unmask );
3520              
3521 2 50       9 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         10 my $full = $self->state_user_full($nick);
3527 2         16 $self->send_event(
3528             "daemon_unxline",
3529             $full,
3530             $unmask,
3531             );
3532              
3533 2         235 push @$ref, {
3534             prefix => $server,
3535             command => 'NOTICE',
3536             params => [ $nick, "X-Line for [$unmask] is removed" ],
3537             };
3538              
3539 2         18 $self->_send_to_realops( "$full has removed the X-Line for: [$unmask]", 'Notice', 's' );
3540             }
3541              
3542 2 50       56 return @$ref if wantarray;
3543 2         10 return $ref;
3544             }
3545              
3546             sub _daemon_cmd_dline {
3547 3     3   9 my $self = shift;
3548 3   50     10 my $nick = shift || return;
3549 3         11 my $server = $self->server_name();
3550 3         51 my $sid = $self->server_sid();
3551 3         12 my $ref = [ ];
3552 3         11 my $args = [ @_ ];
3553 3         13 my $count = @$args;
3554              
3555             SWITCH: {
3556 3 50       14 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     36 if (!$count || $count < 2) {
3561 0         0 push @$ref, ['461', 'DLINE'];
3562 0         0 last SWITCH;
3563             }
3564 3         15 my $duration = 0;
3565 3 100       29 if ($args->[0] =~ /^\d+$/) {
3566 2         17 $duration = shift @$args;
3567 2 50       10 $duration = 14400 if $duration > 14400;
3568             }
3569 3         8 my $mask = shift @$args;
3570 3 50       10 if (!$mask) {
3571 0         0 push @$ref, ['461', 'KLINE'];
3572 0         0 last SWITCH;
3573             }
3574 3         8 my $netmask;
3575 3 50 33     32 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       14 if ( !$netmask ) {
3594 3         19 $netmask = Net::CIDR::cidrvalidate($mask);
3595 3 50       2076 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         8 my $us = 0;
3607 3 100 66     22 if ($args->[0] && uc $args->[0] eq 'ON') {
3608 1         3 $on = shift @$args;
3609 1         2 $peermask = shift @$args;
3610 1   50     4 $reason = shift @$args || '';
3611 1         2 my %targpeers; my $ucserver = uc $server;
  1         3  
3612 1         2 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         5  
3613 4 50       15 if (matches_mask($peermask, $peer)) {
3614 4 100       206 if ($ucserver eq $peer) {
3615 1         2 $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         34  
3634             );
3635             }
3636             else {
3637 2         5 $us = 1;
3638             }
3639              
3640 3 50       14 last SWITCH if !$us;
3641              
3642 3 100       9 if ( !$reason ) {
3643 2   50     8 $reason = shift @$args || '';
3644             }
3645              
3646 3         40 my $full = $self->state_user_full($nick);
3647              
3648 3 50       25 last SWITCH if !$self->_state_add_drkx_line( 'dline',
3649             $full, time, $server, $duration * 60,
3650             $netmask, $reason );
3651              
3652 3         31 $self->send_event(
3653             "daemon_dline",
3654             $full,
3655             $netmask,
3656             $duration,
3657             $reason,
3658             );
3659              
3660 3         389 $self->add_denial( $netmask, 'You have been D-lined.' );
3661              
3662 3 100       17 my $temp = $duration ? "temporary $duration min. " : '';
3663              
3664 3         13 my $reply_notice = "Added ${temp}D-Line [$netmask]";
3665 3         26 my $locop_notice = "$full added ${temp}D-Line for [$netmask] [$reason]";
3666              
3667 3         18 push @$ref, {
3668             prefix => $server,
3669             command => 'NOTICE',
3670             params => [ $nick, $reply_notice ],
3671             };
3672              
3673 3         17 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
3674              
3675 3         20 $self->_state_do_local_users_match_dline($netmask,$reason);
3676             }
3677              
3678 3 50       12 return @$ref if wantarray;
3679 3         13 return $ref;
3680             }
3681              
3682             sub _daemon_cmd_undline {
3683 2     2   6 my $self = shift;
3684 2   50     9 my $nick = shift || return;
3685 2         9 my $server = $self->server_name();
3686 2         9 my $sid = $self->server_sid();
3687 2         5 my $ref = [ ];
3688 2         10 my $args = [ @_ ];
3689 2         5 my $count = @$args;
3690              
3691             SWITCH: {
3692 2 50       5 if (!$self->state_user_is_operator($nick)) {
  2         8  
3693 0         0 push @$ref, ['481'];
3694 0         0 last SWITCH;
3695             }
3696 2 50       9 if (!$count ) {
3697 0         0 push @$ref, ['461', 'UNDLINE'];
3698 0         0 last SWITCH;
3699             }
3700 2         8 my $unmask = shift @$args;
3701 2 50 66     17 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     12 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         2  
3711 1         3 foreach my $peer ( keys %{ $self->{state}{peers} } ) {
  1         6  
3712 4 50       22 if (matches_mask($peermask, $peer)) {
3713 4 100       148 if ($ucserver eq $peer) {
3714 1         6 $us = 1;
3715             }
3716             else {
3717 3         13 $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         4 grep { $self->_state_peer_capab($_, 'UNDLN') } keys %targpeers,
  2         24  
3732             );
3733             }
3734             else {
3735 1         2 $us = 1;
3736             }
3737              
3738 2 50       8 last SWITCH if !$us;
3739              
3740 2         10 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         8 my $full = $self->state_user_full($nick);
3748 2         14 $self->send_event(
3749             "daemon_undline",
3750             $full,
3751             $unmask,
3752             );
3753              
3754 2         225 $self->del_denial( $unmask );
3755              
3756 2         17 push @$ref, {
3757             prefix => $server,
3758             command => 'NOTICE',
3759             params => [ $nick, "D-Line for [$unmask] is removed" ],
3760             };
3761              
3762 2         22 $self->_send_to_realops(
3763             "$full has removed the D-Line for: [$unmask]",
3764             'Notice',
3765             's',
3766             );
3767             }
3768              
3769 2 50       8 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   10 my $self = shift;
3861 4         8 my $cmd = shift;
3862 4   50     14 my $peer_id = shift || return;
3863 4   50     14 my $uid = shift || return;
3864 4         12 my $server = $self->server_name();
3865 4         10 my $sid = $self->server_sid();
3866 4         11 my $args = [@_];
3867 4         10 my $count = @$args;
3868 4         9 my $ref = [ ];
3869 4         11 $cmd = uc $cmd;
3870              
3871             SWITCH: {
3872 4 50       6 if ($count > 1) {
  4         16  
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       14 if ($args->[0]) {
3902 4   33     18 my $targ = ( $self->state_user_uid($args->[0]) || $self->_state_peer_sid($args->[0] ) );
3903 4 50       16 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       53 if ($targ !~ m!^$sid!) {
3915 2         10 my $name;
3916             my $route_id;
3917 2 50       30 if ( length $targ == 3 ) {
3918 2         12 $name = $self->{state}{sids}{$targ}{name};
3919 2         6 $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         11 ],
3935             };
3936 2         39 $self->send_output(
3937             {
3938             prefix => $uid,
3939             command => $cmd,
3940             params => [
3941             $targ,
3942             ],
3943             },
3944             $route_id,
3945             );
3946 2         10 last SWITCH;
3947             }
3948             }
3949 2 100       14 my $method = ( $cmd eq 'ETRACE' ? '_daemon_do_etrace' : '_daemon_do_trace' );
3950 2         5 push @$ref, $_ for @{ $self->$method($uid, @$args) };
  2         15  
3951             }
3952 4 50       36 return @$ref if wantarray;
3953 0         0 return $ref;
3954             }
3955              
3956             sub _state_find_peer {
3957 3     3   9 my $self = shift;
3958 3   50     13 my $targ = shift || return;
3959 3         8 my $connid = shift;
3960 3         11 my $server = $self->server_name();
3961 3         9 my $sid = $self->server_sid();
3962 3         32 my $ume = uc $server;
3963 3         8 my $result;
3964              
3965 3 50       12 if ($self->state_nick_exists($targ)) {
3966 0         0 $result = $self->state_user_uid($targ);
3967             }
3968 3 50 33     40 if (!$result && $self->state_peer_exists($targ)) {
3969 0         0 $result = $self->_state_peer_sid($targ);
3970             }
3971 3 50 33     31 if (!$result && $targ =~ m![\x2A\x3F]!) {
3972 3         17 PEERS: foreach my $peer ( sort keys %{ $self->{state}{peers} } ) {
  3         32  
3973 9 100       336 if ( matches_mask($targ,$peer,'ascii') ) {
3974 1 50       78 return $sid if $ume eq $peer;
3975 1         4 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       90 if (!$result) {
3983 2         6 USERS: foreach my $user ( sort keys %{ $self->{state}{users} } ) {
  2         17  
3984 10 100       310 if ( matches_mask($targ,$user) ) {
3985 2         87 my $rec = $self->{state}{users}{$user};
3986 2 50       38 return $sid if $rec->{uid} =~ m!^$sid!;
3987             next USERS if $connid && $connid eq $rec->{route_id}
3988 2 0 33     12 && $self->{state}{sids}{ $rec->{sid} }{type} eq 'r';
      33        
3989 2         8 $result = $rec->{uid};
3990             last USERS
3991 2         20 }
3992             }
3993             }
3994             }
3995 3 50       35 return $result if $result;
3996 0         0 return;
3997             }
3998              
3999             sub _daemon_client_tracing {
4000 6     6   19 my $self = shift;
4001 6         15 my $cmd = shift;
4002 6   50     27 my $nick = shift || return;
4003 6         21 my $server = $self->server_name();
4004 6         25 my $sid = $self->server_sid();
4005 6         18 my $args = [@_];
4006 6         17 my $count = @$args;
4007 6         15 my $ref = [ ];
4008 6         20 $cmd = uc $cmd;
4009              
4010             SWITCH: {
4011 6 100       15 if (!$self->state_user_is_operator($nick)) {
  6         31  
4012 2 100       59 if ( $cmd eq 'ETRACE' ) {
4013 1         4 push @$ref, ['481'];
4014 1         4 last SWITCH;
4015             }
4016 1         10 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       21 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         22 my $uid = $self->state_user_uid($nick);
4048 4 100       77 if ($args->[0]) {
4049 2         15 my $targ = $self->_state_find_peer($args->[0]);
4050 2 50       10 if (!$targ) {
4051 0         0 push @$ref, [ '402', $args->[0] ];
4052 0         0 last SWITCH;
4053             }
4054 2 50       50 if ($targ !~ m!^$sid!) {
4055 2         7 my $name;
4056             my $route_id;
4057 2 50       16 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         11 $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         11 ],
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       10 my $method = ( $cmd eq 'ETRACE' ? '_daemon_do_etrace' : '_daemon_do_trace' );
4090 2         5 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  14         26  
  14         24  
  14         31  
4091 2         12 @{ $self->$method($uid, @$args) };
4092             }
4093 6 50       70 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     21 my $uid = shift || return;
4100 2         9 my $server = $self->server_name();
4101 2         8 my $sid = $self->server_sid();
4102 2         7 my $args = [@_];
4103 2         6 my $count = @$args;
4104 2         4 my $ref = [ ];
4105              
4106             SWITCH: {
4107 2         18 my $rec = $self->{state}{uids}{$uid};
  2         7  
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         25 ),
4116             'Notice',
4117             'y',
4118             );
4119 2         6 my $doall = 0;
4120 2 100       16 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         5 my $name = $args->[0];
4130 2 100 66     13 if ($name && $name =~ m!^[0-9]!) {
4131 1         6 $name = $self->state_user_nick($name);
4132             }
4133 2 50       26 $name = uc_irc $name if $name;
4134             # Local clients
4135 2         13 my @connects;
4136 2         8 my $conns = $self->{state}{conns};
4137 2         11 foreach my $conn_id ( keys %$conns ) {
4138 12 100       48 next if $conns->{$conn_id}{type} ne 'c';
4139 6 100       16 next if defined $self->{state}{localops}{ $conn_id };
4140 4         13 push @connects, $conn_id;
4141             }
4142 2         14 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  2         13  
4143             @connects ) {
4144 4 50 33     22 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{nick} );
      33        
4145 4         8 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         30 ],
4158             };
4159             }
4160 2         5 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  0         0  
4161 2         10 keys %{ $self->{state}{localops} } ) {
4162 2 50 33     20 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         18 ],
4176             };
4177             }
4178             # End of ETRACE
4179 2         14 push @$ref, {
4180             prefix => $sid,
4181             command => '759',
4182             params => [
4183             $uid, $server, 'End of ETRACE',
4184             ],
4185             };
4186             }
4187              
4188 2 50       15 return @$ref if wantarray;
4189 2         11 return $ref;
4190             }
4191              
4192             sub _daemon_do_trace {
4193 2     2   6 my $self = shift;
4194 2   50     9 my $uid = shift || return;
4195 2         9 my $server = $self->server_name();
4196 2         6 my $sid = $self->server_sid();
4197 2         6 my $args = [@_];
4198 2         4 my $count = @$args;
4199 2         6 my $ref = [ ];
4200              
4201             SWITCH: {
4202 2         4 my $rec = $self->{state}{uids}{$uid};
  2         7  
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         35 ),
4211             'Notice',
4212             'y',
4213             );
4214 2         7 my $doall = 0;
4215 2 100       21 if (!$args->[0]) {
    50          
    50          
4216 1         3 $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         4 $doall = 1;
4223             }
4224 2         15 my $name = $args->[0];
4225 2 100 66     31 if ($name && $name =~ m!^[0-9]!) {
4226 1         9 $name = $self->state_user_nick($name);
4227             }
4228 2 50       8 $name = uc_irc $name if $name;
4229             # Local clients
4230 2         6 my $conns = $self->{state}{conns};
4231 2         5 my %connects;
4232 2         10 foreach my $conn_id ( keys %$conns ) {
4233 12 100       29 next if defined $self->{state}{localops}{ $conn_id };
4234 10         18 push @{ $connects{ $conns->{$conn_id}{type} } }, $conn_id;
  10         39  
4235             }
4236 2         6 foreach my $conn_id ( sort { $conns->{$a}{nick} cmp $conns->{$b}{nick} }
  2         12  
4237 2         16 @{ $connects{c} } ) {
4238 4 50 33     23 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         51 ],
4252             colonify => 0,
4253             };
4254             }
4255 2         8 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     13 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{nick} );
      33        
4258 2         21 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         41 ],
4271             colonify => 0,
4272             };
4273             }
4274             # Servers
4275 2         15 foreach my $conn_id ( sort { $conns->{$a}{name} cmp $conns->{$b}{name} }
  2         18  
4276 2         9 @{ $connects{p} } ) {
4277 4 50 33     21 next if !$doall || ( $name && $name ne uc_irc $conns->{$conn_id}{name} );
      33        
4278 4         10 my $connrec = $conns->{$conn_id};
4279 4         7 my $srvcnt = 0; my $clicnt = 0;
  4         8  
4280 4         19 $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     74 ],
      33        
4295             colonify => 0,
4296             };
4297             }
4298             # Unknowns
4299 2         7 foreach my $conn_id ( sort { $conns->{$a}{nick} <=> $conns->{$b}{nick} }
  0         0  
4300 2         7 @{ $connects{u} } ) {
4301 2 50       8 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     64 ],
      33        
4315             colonify => 0,
4316             };
4317             }
4318 2 50       9 if ($doall) {
4319 2 50       22 my $users = ( defined $connects{c} ? @{ $connects{c} } : 0 );
  2         8  
4320 2 50       8 my $opers = ( defined $self->{state}{localops} ? keys %{ $self->{state}{localops} } : 0 );
  2         9  
4321 2 50       6 my $servers = ( defined $connects{p} ? @{ $connects{p} } : 0 );;
  2         6  
4322 2         12 $users -= $opers;
4323             # 209
4324 2 50       9 if ($servers) {
4325 2         25 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       7 if ($opers) {
4336 2         10 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       7 if ($users) {
4347 2         12 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         13 push @$ref, {
4360             prefix => $sid,
4361             command => '262',
4362             params => [
4363             $uid, $server, 'End of TRACE',
4364             ],
4365             };
4366             }
4367              
4368 2 50       19 return @$ref if wantarray;
4369 2         17 return $ref;
4370             }
4371              
4372             sub _state_peer_dependents {
4373 6     6   14 my $self = shift;
4374 6   50     15 my $sid = shift || return;
4375 6         10 my $srvcnt = shift;
4376 6         18 my $clicnt = shift;
4377              
4378 6         12 $$srvcnt++;
4379 6         8 $$clicnt += keys %{ $self->{state}{sids}{$sid}{uids} };
  6         28  
4380 6         43 foreach my $psid ( keys %{ $self->{state}{sids}{$sid}{sids} } ) {
  6         41  
4381 2         16 $self->_state_peer_dependents($psid,$srvcnt,$clicnt);
4382             }
4383 6         15 return;
4384             }
4385             sub _daemon_cmd_nick {
4386 23     23   60 my $self = shift;
4387 23   50     88 my $nick = shift || return;
4388 23         55 my $new = shift;
4389 23         75 my $server = uc $self->server_name();
4390 23         83 my $sid = $self->server_sid();
4391 23         74 my $ref = [ ];
4392              
4393             SWITCH: {
4394 23 50       52 if (!$new) {
  23         205  
4395 0         0 push @$ref, ['431'];
4396 0         0 last SWITCH;
4397             }
4398 23         89 my $nicklen = $self->server_config('NICKLEN');
4399 23 50       90 $new = substr($new, 0, $nicklen) if length($new) > $nicklen;
4400 23 100       89 if ($nick eq $new) {
4401 2         7 last SWITCH;
4402             }
4403 21 50       116 if (!is_valid_nick_name($new)) {
4404 0         0 push @$ref, ['432', $new];
4405 0         0 last SWITCH;
4406             }
4407 21         366 my $unick = uc_irc($nick);
4408 21         368 my $record = $self->{state}{users}{$unick};
4409 21 100       116 if ( my $reason = $self->_state_is_resv( $new, $record->{route_id} ) ) {
4410 1         10 $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         87 my $unew = uc_irc($new);
4431 20 50 33     316 if ($self->state_nick_exists($new) && $unick ne $unew) {
4432 0         0 push @$ref, ['433', $new];
4433 0         0 last SWITCH;
4434             }
4435 20         83 my $full = $record->{full}->();
4436 20         107 my $common = { $record->{uid} => $record->{route_id} };
4437              
4438 20         85 my $nonickchange = '';
4439 20         52 CHANS: for my $chan (keys %{ $record->{chans} }) {
  20         222  
4440 4         17 my $chanrec = $self->{state}{chans}{$chan};
4441 4 100       29 if ( $chanrec->{mode} =~ /N/ ) {
4442 2 50       18 if ( $record->{chans} !~ /[oh]/ ) {
4443 2         9 $nonickchange = $chanrec->{name};
4444 2         10 last CHANS;
4445             }
4446             }
4447 2         5 USER: for my $user ( keys %{ $chanrec->{users} } ) {
  2         7  
4448 4 50       47 next USER if $user !~ m!^$sid!;
4449 4         14 $common->{$user} = $self->_state_uid_route($user);
4450             }
4451             }
4452              
4453 20 100       79 if ($nonickchange) {
4454 2         90 push @$ref,['447',$nonickchange];
4455 2         15 last SWITCH;
4456             }
4457              
4458 18         125 my $lastattempt = $record->{_nick_last};
4459 18 50 66     100 if ( $lastattempt && ( $lastattempt + $self->{config}{max_nick_time} < time() ) ) {
4460 0         0 $record->{_nick_count} = 0;
4461             }
4462              
4463 18 100 33     305 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         4 push @$ref,['438',$new,$self->{config}{max_nick_time}];
4466 1         4 last SWITCH;
4467             }
4468              
4469 17         61 $record->{_nick_last} = time();
4470 17         51 $record->{_nick_count}++;
4471              
4472 17 50       81 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         45 $record->{ts} = time;
4479             # Remove from peoples accept lists
4480 17         37 for (keys %{ $record->{accepts} }) {
  17         104  
4481 0         0 delete $self->{state}{users}{$_}{accepts}{$unick};
4482             }
4483 17         63 delete $record->{accepts};
4484             # WATCH ON/OFF
4485 17 100       90 if ( defined $self->{state}{watches}{$unick} ) {
4486 1         4 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         7  
4487 1 50       8 next if !defined $self->{state}{uids}{$wuid};
4488 1         3 my $wrec = $self->{state}{uids}{$wuid};
4489 1         4 my $laston = time();
4490 1         4 $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         14 );
4506             }
4507             }
4508 17 100       99 if ( defined $self->{state}{watches}{$unew} ) {
4509 1         3 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         14 );
4527             }
4528             }
4529 17         60 delete $self->{state}{users}{$unick};
4530 17         55 $self->{state}{users}{$unew} = $record;
4531 17         65 delete $self->{state}{peers}{$server}{users}{$unick};
4532 17         48 $self->{state}{peers}{$server}{users}{$unew} = $record;
4533 17 100       101 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         12 );
4546             }
4547 17         307 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         57 };
4558             }
4559              
4560 17         243 $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         144 params => [$new, $record->{ts}],
4574             },
4575             $self->_state_connected_peers(),
4576             );
4577              
4578 17         117 $self->send_event("daemon_nick", $full, $new);
4579              
4580 17         2172 $self->send_output(
4581             {
4582             prefix => $full,
4583             command => 'NICK',
4584             params => [$new],
4585             },
4586             values %$common,
4587             );
4588             }
4589              
4590 23 50       174 return @$ref if wantarray;
4591 0         0 return $ref;
4592             }
4593              
4594             sub _daemon_cmd_away {
4595 5     5   16 my $self = shift;
4596 5   50     25 my $nick = shift || return;
4597 5         11 my $msg = shift;
4598 5         16 my $server = $self->server_name();
4599 5         31 my $ref = [ ];
4600              
4601             SWITCH: {
4602 5         15 my $rec = $self->{state}{users}{uc_irc($nick)};
  5         41  
4603 5 100       110 if (!$msg) {
4604 2         8 delete $rec->{away};
4605             $self->send_output(
4606             {
4607             prefix => $rec->{uid},
4608 2         23 command => 'AWAY',
4609             },
4610             $self->_state_connected_peers(),
4611             );
4612             push @$ref, {
4613             prefix => $server,
4614             command => '305',
4615 2         20 params => [ $rec->{nick}, 'You are no longer marked as being away' ],
4616             };
4617 2         19 $self->_state_do_away_notify($rec->{uid},'*',$msg);
4618 2         6 last SWITCH;
4619             }
4620              
4621 3         12 $rec->{away} = $msg;
4622              
4623             $self->send_output(
4624             {
4625             prefix => $rec->{uid},
4626 3         31 command => 'AWAY',
4627             params => [$msg],
4628             },
4629             $self->_state_connected_peers(),
4630             );
4631             push @$ref, {
4632             prefix => $server,
4633             command => '306',
4634 3         24 params => [ $rec->{nick}, 'You have been marked as being away' ],
4635             };
4636 3         23 $self->_state_do_away_notify($rec->{uid},'*',$msg);
4637             }
4638              
4639 5 50       59 return @$ref if wantarray;
4640 0         0 return $ref;
4641             }
4642              
4643             sub _daemon_client_miscell {
4644 6     6   13 my $self = shift;
4645 6         13 my $cmd = shift;
4646 6   50     19 my $nick = shift || return;
4647 6         11 my $target = shift;
4648 6         17 my $server = $self->server_name();
4649 6         14 my $ref = [ ];
4650              
4651             SWITCH: {
4652 6 50 33     10 if ($target && !$self->state_peer_exists($target)) {
  6         30  
4653 0         0 push @$ref, ['402', $target];
4654 0         0 last SWITCH;
4655             }
4656 6 50 33     81 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       49 if ($cmd =~ m!^(ADMIN|INFO|MOTD)$!i) {
4669 3         16 $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         22 my $method = '_daemon_do_' . lc $cmd;
4677 6         25 my $uid = $self->state_user_uid($nick);
4678 6         82 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  30         64  
  30         47  
  30         69  
4679 6         23 @{ $self->$method($uid) };
4680             }
4681              
4682 6 50       52 return @$ref if wantarray;
4683 0         0 return $ref;
4684             }
4685              
4686             sub _daemon_peer_miscell {
4687 5     5   9 my $self = shift;
4688 5         11 my $cmd = shift;
4689 5   50     15 my $uid = shift || return;
4690 5         12 my $sid = $self->server_sid();
4691 5         12 my $args = [@_];
4692 5         10 my $count = @$args;
4693 5         12 my $ref = [ ];
4694              
4695             SWITCH: {
4696 5 50 33     6 if ($cmd ne 'STATS' && $args->[0] !~ m!^$sid!) {
  5         54  
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     18 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       21 if ($cmd =~ m!^(ADMIN|INFO|MOTD)$!i) {
4719 3         11 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         12 ), qw[Notice y],
4725             );
4726             }
4727 5         19 my $method = '_daemon_do_' . lc $cmd;
4728 5         36 $ref = $self->$method($uid, @$args);
4729             }
4730              
4731 5 50       65 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   748 my $self = shift;
4738 229   50     1044 my $uid = shift || return;
4739 229         941 my $sid = $self->server_sid();
4740 229         701 my $ref = [ ];
4741              
4742             push @$ref, {
4743             prefix => $sid,
4744             command => '005',
4745             params => [
4746             $uid,
4747             join(' ', map {
4748 229         1066 (defined $self->{config}{isupport}{$_}
4749 2519 100       11140 ? 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         1441 (defined $self->{config}{isupport}{$_}
4766 1603 100       6774 ? 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       1304 return @$ref if wantarray;
4775 229         1013 return $ref;
4776             }
4777              
4778             sub _daemon_do_info {
4779 2     2   6 my $self = shift;
4780 2   50     7 my $uid = shift || return;
4781 2         19 my $sid = $self->server_sid();
4782 2         4 my $ref = [ ];
4783              
4784             {
4785 2         5 for my $info (@{ $self->server_config('Info') }) {
  2         3  
  2         12  
4786 20         77 push @$ref, {
4787             prefix => $sid,
4788             command => '371',
4789             params => [$uid, $info],
4790             };
4791             }
4792              
4793 2         14 push @$ref, {
4794             prefix => $sid,
4795             command => '374',
4796             params => [$uid, 'End of /INFO list.'],
4797             };
4798             }
4799              
4800 2 50       9 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     7 my $uid = shift || return;
4807 2         6 my $sid = $self->server_sid();
4808 2         4 my $ref = [ ];
4809              
4810 2         8 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         7  
4822              
4823 2 50       6 return @$ref if wantarray;
4824 2         6 return $ref;
4825             }
4826              
4827             sub _daemon_do_admin {
4828 2     2   4 my $self = shift;
4829 2   50     7 my $uid = shift || return;
4830 2         6 my $sid = $self->server_sid();
4831 2         3 my $ref = [ ];
4832 2         8 my $admin = $self->server_config('Admin');
4833              
4834             {
4835 2         4 push @$ref, {
  2         7  
4836             prefix => $sid,
4837             command => '256',
4838             params => [$uid, $self->server_name(), 'Administrative Info'],
4839             };
4840              
4841 2         9 push @$ref, {
4842             prefix => $sid,
4843             command => '257',
4844             params => [$uid, $admin->[0]],
4845             };
4846              
4847 2         8 push @$ref, {
4848             prefix => $sid,
4849             command => '258',
4850             params => [$uid, $admin->[1]],
4851             };
4852              
4853 2         8 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         6 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   8 my $self = shift;
4876 3   50     12 my $uid = shift || return;
4877 3         12 my $sid = $self->server_sid();
4878 3         8 my $ref = [ ];
4879              
4880             {
4881 3         23 push @$ref, {
  3         19  
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       20 return @$ref if wantarray;
4893 3         13 return $ref;
4894             }
4895              
4896             sub _daemon_do_users {
4897 229     229   630 my $self = shift;
4898 229   50     1099 my $uid = shift || return;
4899 229         582 my $hidden = shift;
4900 229         858 my $sid = $self->server_sid();
4901 229         686 my $ref = [ ];
4902 229         576 my $global = keys %{ $self->{state}{uids} };
  229         908  
4903 229 100       878 my $local = $hidden ? $global : scalar keys %{ $self->{state}{sids}{$sid}{uids} };
  223         950  
4904 229 100       1025 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         2364 . $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         2280 ],
4924             };
4925              
4926 229 50       2056 return @$ref if wantarray;
4927 0         0 return $ref;
4928             }
4929              
4930             sub _daemon_cmd_lusers {
4931 2     2   7 my $self = shift;
4932 2   50     9 my $nick = shift || return;
4933 2         10 my $server = $self->server_name();
4934 2         7 my $ref = [ ];
4935 2         6 my $args = [@_];
4936 2         7 my $count = @$args;
4937              
4938             SWITCH: {
4939 2 50 33     6 if ($count && $count > 1) {
  2         13  
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         14 my $uid = $self->state_user_uid($nick);
4963 2         28 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  13         23  
  13         21  
  13         30  
4964 2         13 @{ $self->_daemon_do_lusers($uid) };
4965             }
4966              
4967 2 50       26 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   678 my $self = shift;
5009 229   50     973 my $uid = shift || return;
5010 229         911 my $sid = $self->server_sid();
5011 229         751 my $ref = [ ];
5012 229   66     1464 my $hidden = ( $self->{config}{'hidden_servers'} && $self->{state}{uids}{$uid}{umode} !~ /o/ );
5013 229         837 my $invisible = $self->{state}{stats}{invisible};
5014 229         526 my $users = keys(%{ $self->{state}{uids} }) - $invisible;
  229         1103  
5015 229 100       1034 my $servers = $hidden ? 1 : scalar keys %{ $self->{state}{sids} };
  223         951  
5016 229         606 my $chans = keys %{ $self->{state}{chans} };
  229         962  
5017 229 100       1010 my $local = $hidden ? ( $users + $invisible ) : scalar keys %{ $self->{state}{sids}{$sid}{uids} };
  223         964  
5018 229 100       914 my $peers = $hidden ? 0 : scalar keys %{ $self->{state}{sids}{$sid}{sids} };
  223         1090  
5019 229         894 my $totalconns = $self->{state}{stats}{conns_cumlative};
5020 229         710 my $mlocal = $self->{state}{stats}{maxlocal};
5021 229         684 my $conns = $self->{state}{stats}{maxconns};
5022              
5023 229         2476 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         737 $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       1721 } if $self->{state}{stats}{ops_online};
5044              
5045 229 100       1191 push @$ref, {
5046             prefix => $sid,
5047             command => '254',
5048             params => [$uid, $chans, "channels formed"],
5049             } if $chans;
5050              
5051 229         2185 push @$ref, {
5052             prefix => $sid,
5053             command => '255',
5054             params => [$uid, "I have $local clients and $peers servers"],
5055             };
5056              
5057 229         1487 push @$ref, $_ for $self->_daemon_do_users($uid, $hidden);
5058              
5059 229 100       2765 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       1002 return @$ref if wantarray;
5069 229         1019 return $ref;
5070             }
5071              
5072             sub _daemon_do_motd {
5073 229     229   679 my $self = shift;
5074 229   50     987 my $uid = shift || return;
5075 229         947 my $sid = $self->server_sid();
5076 229         1011 my $server = $self->server_name();
5077 229         700 my $ref = [ ];
5078 229         1015 my $motd = $self->server_config('MOTD');
5079              
5080             {
5081 229 100 66     733 if ($motd && ref $motd eq 'ARRAY') {
  229         1833  
5082 2         25 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         42 } for @$motd;
5092 2         8 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         1759 params => [$uid, $self->{Error_Codes}{'422'}[1]],
5103             };
5104             }
5105             }
5106              
5107 229 50       992 return @$ref if wantarray;
5108 229         958 return $ref;
5109             }
5110              
5111             sub _daemon_cmd_stats {
5112 22     22   64 my $self = shift;
5113 22   50     88 my $nick = shift || return;
5114 22         49 my $char = shift;
5115 22         71 my $target = shift;
5116 22         65 my $server = $self->server_name();
5117 22         94 my $sid = $self->server_sid();
5118 22         90 my $ref = [ ];
5119              
5120             SWITCH: {
5121 22 50       57 if (!$char) {
  22         83  
5122 0         0 push @$ref, ['461', 'STATS'];
5123 0         0 last SWITCH;
5124             }
5125 22         82 $char = substr $char, 0, 1;
5126 22 100       166 if (!$self->state_user_is_operator($nick)) {
5127 21         445 my $lastuse = $self->{state}{lastuse}{stats};
5128 21         81 my $pacewait = $self->{config}{pace_wait};
5129 21 100 100     168 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      66        
5130 1         4 push @$ref, ['263', 'STATS'];
5131 1         3 last SWITCH;
5132             }
5133 20         89 $self->{state}{lastuse}{stats} = time();
5134             }
5135 21 100 66     149 if ($char =~ /^[Ll]$/ && !$target) {
5136 2         30 push @$ref, ['461', 'STATS'];
5137 2         15 last SWITCH;
5138             }
5139 19 100       57 if ($target) {
5140 1         6 my $targ = $self->_state_find_peer($target);
5141 1 50       5 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         4 last SWITCH;
5159             }
5160             }
5161 18         107 my $uid = $self->state_user_uid($nick);
5162 18         326 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  42         95  
  42         80  
  42         188  
5163 18         204 @{ $self->_daemon_do_stats($uid, $char, $target) };
5164             }
5165              
5166 22 50       239 return @$ref if wantarray;
5167 0         0 return $ref;
5168             }
5169              
5170             sub _rbytes {
5171 4     4   31 my $bytes=shift;
5172 4         10 my $d=2;
5173 4 50       17 return undef if !defined $bytes;
5174 4 100       25 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   54 my $self = shift;
5184 18   50     75 my $uid = shift || return;
5185 18         52 my $char = shift;
5186 18         40 my $targ = shift;
5187 18         59 my $server = $self->server_name();
5188 18         60 my $sid = $self->server_sid();
5189 18         46 my $ref = [ ];
5190              
5191 18         93 my $rec = $self->{state}{uids}{$uid};
5192 18         89 my $is_oper = ( $rec->{umode} =~ /o/ );
5193 18         52 my $is_admin = ( $rec->{umode} =~ /a/ );
5194              
5195 18         250 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         340 ), qw[Notice y],
5206             );
5207              
5208             SWITCH: {
5209 18 100 66     63 if (($char =~ $perms{admin} && !$is_admin) ||
  18   66     375  
      100        
5210             ($char =~ $perms{oper} && !$is_oper)) {
5211 17         125 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         54 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       5 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       6 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       4 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       3 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       4 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       13 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       7 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       8 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       5 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       6 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       6 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         3 my $trecv = my $tsent = 0; my $scnt = 0;
  1         3  
5631 1         10 foreach my $link ( sort keys %{ $self->{state}{sids}{$sid}{sids} } ) {
  1         10  
5632 2         4 $scnt++;
5633 2         6 my $srec = $self->{state}{sids}{$link};
5634 2         8 my $send = $srec->{stats}->send();
5635 2         14 my $recv = $srec->{stats}->recv();
5636 2         18 my $msgs = $self->connection_msgs($srec->{route_id});
5637 2         5 $trecv += $recv; $tsent += $send;
  2         3  
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       18 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         3 $uid, '?', sprintf('Sent total: %s %s', @{ _rbytes($tsent) }),
  1         5  
5664             ],
5665             };
5666             push @$ref, {
5667             prefix => $sid,
5668             command => '249',
5669             params => [
5670 1         6 $uid, '?', sprintf('Recv total: %s %s', @{ _rbytes($trecv) }),
  1         2  
5671             ],
5672             };
5673 1         5 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         4 @{ _rbytes($self->{_globalstats}{recv}) },
5694             ( $uptime == 0 ? 0 :
5695 1 50       5 ( ($self->{_globalstats}{sent} >> 10) / $uptime )
5696             ),
5697             ),
5698             ],
5699             };
5700 1         4 last SWITCH;
5701             }
5702             }
5703              
5704 18         115 push @$ref, {
5705             prefix => $sid,
5706             command => '219',
5707             params => [$uid, $char, 'End of /STATS report'],
5708             };
5709              
5710 18 50       71 return @$ref if wantarray;
5711 18         123 return $ref;
5712             }
5713              
5714             sub _daemon_cmd_userhost {
5715 1     1   3 my $self = shift;
5716 1   50     3 my $nick = shift || return;
5717 1         4 my $server = $self->server_name();
5718 1         3 my $ref = [ ];
5719 1         2 my $str = '';
5720 1         3 my $cnt = 0;
5721              
5722 1         3 for my $query (@_) {
5723 3 50       8 last if $cnt >= 5;
5724 3         5 $cnt++;
5725 3         10 my $uid = $self->state_user_uid($query);
5726 3 50       39 next if !$uid;
5727 3         7 my $urec = $self->{state}{uids}{$uid};
5728 3         8 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     43 if ( $urec->{umode} =~ /o/ && ( $urec->{umode} !~ /H/ ||
      66        
5734             $self->state_user_is_operator($nick) ) ) {
5735 1         4 $status .= '*';
5736             }
5737 3         6 $status .= '=';
5738 3 50       8 $status .= ( defined $urec->{away} ? '-' : '+' );
5739 3         12 $str = join ' ', $str, $name . $status . $uh;
5740 3         12 $str =~ s!^ !!g;
5741             }
5742              
5743 1 50       6 push @$ref, {
5744             prefix => $server,
5745             command => '302',
5746             params => [$nick, ($str ? $str : ':')],
5747             };
5748              
5749 1 50       8 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 128     128   38278 my ($kernel,$self,$client) = @_[KERNEL,OBJECT,ARG0];
5784 128         402 my $server = $self->server_name();
5785 128         277 my $mask = $client->{safelist};
5786 128 100       343 return if !$mask;
5787 127         251 my $start = delete $mask->{start};
5788              
5789 127 100       330 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         186 );
5798 7         26 $mask->{chans} = [ keys %{ $self->{state}{chans} } ];
  7         141  
5799 7         38 $kernel->yield('_daemon_do_safelist',$client);
5800 7         525 return;
5801             }
5802             else {
5803 120         186 my $chan = shift @{ $mask->{chans} };
  120         291  
5804 120 100       302 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         69 );
5813 6         26 delete $client->{safelist};
5814 6         35 return;
5815             }
5816 114         207 my $show = 0;
5817             SWITCH: {
5818 114 50       239 last SWITCH if !defined $self->{state}{chans}{$chan};
  114         390  
5819 114 100       277 if ($mask->{all}) {
5820 28         45 $show = 1;
5821 28         63 last SWITCH;
5822             }
5823 86 50       216 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       197 if ($mask->{show}) {
5829 30         128 my $match = matches_mask_array($mask->{show},[$chan]);
5830 30 100       1889 if ( keys %$match ) {
5831 8         35 $show = 1;
5832             }
5833             else {
5834 22         44 $show = 0;
5835 22         65 last SWITCH;
5836             }
5837             }
5838 64 100 66     302 if ($mask->{users_max} || $mask->{users_min}) {
5839 28         57 my $usercnt = keys %{ $self->{state}{chans}{$chan}{users} };
  28         180  
5840 28 50       76 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       60 if ($mask->{users_min}) {
5849 28 100       73 if ($usercnt < $mask->{users_min}) {
5850 6         14 $show = 1;
5851             }
5852             else {
5853 22         41 $show = 0;
5854             }
5855             }
5856             }
5857 64 50 33     353 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     340 if ($mask->{topic_max} || $mask->{topic_min} || $mask->{topic_msk}) {
      66        
5877 28         74 my $chantopic = $self->{state}{chans}{$chan}{topic};
5878 28 100       61 if (!$chantopic) {
5879 24         45 $show = 0;
5880             }
5881             else {
5882 4 50       14 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       12 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       15 if ($mask->{topic_msk}) {
5899 4 100       29 if(matches_mask($mask->{topic_msk},$chantopic->[0],'ascii')) {
5900 2         164 $show = 1;
5901             }
5902             else {
5903 2         124 $show = 0;
5904             }
5905             }
5906             }
5907             }
5908             }
5909 114         536 my $hidden = ( $self->{state}{chans}{$chan}{mode} =~ m![ps]! );
5910 114 100 100     489 if ($show && $hidden && !defined $client->{chans}{$chan}) {
      66        
5911 2         7 $show = 0;
5912             }
5913 114 100       255 if ($show) {
5914 42         93 my $chanrec = $self->{state}{chans}{$chan};
5915 42         256 my $bluf = sprintf('[+%s]', $chanrec->{mode});
5916 42 100       160 if ( defined $chanrec->{topic} ) {
5917 10         56 $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 42         428 scalar keys %{ $chanrec->{users} },
5927             $bluf,
5928             ],
5929             },
5930             $client->{route_id},
5931 42         146 );
5932             }
5933 114         430 $kernel->yield('_daemon_do_safelist',$client);
5934             }
5935 114         8798 return;
5936             }
5937              
5938             sub _daemon_cmd_list {
5939 8     8   23 my $self = shift;
5940 8   50     33 my $nick = shift || return;
5941 8         29 my $server = $self->server_name();
5942 8         22 my $ref = [ ];
5943 8         25 my $args = [@_];
5944 8         23 my $count = @$args;
5945              
5946             SWITCH: {
5947 8         20 my $rec = $self->{state}{users}{uc_irc $nick};
  8         63  
5948 8         186 my $task = { start => 1 };
5949 8         19 my $errors;
5950 8 100       28 if (!$count) {
5951 3 100       15 if ($rec->{safelist}) {
5952 1         7 delete $rec->{safelist};
5953 1         8 push @$ref, {
5954             prefix => $server,
5955             command => '323',
5956             params => [$nick, 'End of /LIST'],
5957             };
5958 1         7 last SWITCH;
5959             }
5960 2         8 $task->{all} = 1;
5961             }
5962             else {
5963 5         32 OPTS: foreach my $opt ( split /,/, $args->[0] ) {
5964 5 100       47 if ($opt =~ m!^T!i) {
5965 1 0 33     6 if ($opt !~ m!^T:!i && $opt !~ m!^T[<>]\d+$!i) {
5966 0         0 $errors++;
5967 0         0 last OPTS;
5968             }
5969 1         11 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         4 next OPTS;
5980             }
5981 4 50       31 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       25 if ($opt =~ m!^\
5996 1 50       8 if ($opt !~ m!^\<\d+$!) {
5997 0         0 $errors++;
5998 0         0 last OPTS;
5999             }
6000 1         9 my ($act,$users) = $opt =~ m!^(\<)(\d+)$!;
6001 1         5 $task->{users_min} = $users;
6002 1         6 next OPTS;
6003             }
6004 3 50       15 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     38 if ($opt !~ m![\x2A\x3F]! && $opt !~ m!^[#&]! ) {
6015 0         0 $errors++;
6016 0         0 last OPTS;
6017             }
6018 3 50       14 if ( $hide ) {
6019 0         0 push @{ $task->{hide} }, $opt;
  0         0  
6020             }
6021             else {
6022 3         8 push @{ $task->{show} }, $opt;
  3         23  
6023             }
6024             }
6025             }
6026 7 50       27 if ( $errors ) {
6027 0         0 push @$ref, ['521'];
6028 0         0 last SWITCH;
6029             }
6030 7         28 $rec->{safelist} = $task;
6031 7         63 $poe_kernel->yield('_daemon_do_safelist',$rec);
6032             }
6033              
6034 8 50       580 return @$ref if wantarray;
6035 0         0 return $ref;
6036             }
6037              
6038             sub _daemon_cmd_names {
6039 110     110   303 my $self = shift;
6040 110   50     440 my $nick = shift || return;
6041 110         430 my $server = $self->server_name();
6042 110         326 my $ref = [ ];
6043 110         417 my $args = [@_];
6044 110         455 my $count = @$args;
6045              
6046             # TODO: hybrid only seems to support NAMES #channel so fix this
6047             SWITCH: {
6048 110         265 my (@chans, $query);
  110         267  
6049 110 50       691 if (!$count) {
6050 0         0 @chans = $self->state_user_chans($nick);
6051 0         0 $query = '*';
6052             }
6053 110         317 my $last = pop @$args;
6054 110 50 33     1493 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     1216 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     995 if ($count && $last !~ /^[#&]/ && @$args == 0) {
      33        
6071 0         0 @chans = $self->state_user_chans($nick);
6072 0         0 $query = '*';
6073             }
6074 110 50 33     1151 if ($count && $last !~ /^[#&]/ && @$args == 1) {
      33        
6075 0         0 $last = pop @$args;
6076             }
6077 110 50 33     825 if ($count && $last =~ /^[#&]/) {
6078             my ($chan) = grep {
6079 110 50 33     597 $_ && $self->state_chan_exists($_)
  110         713  
6080             && $self->state_is_chan_member($nick, $_)
6081             } split /,/, $last;
6082 110         1902 @chans = ();
6083              
6084 110 50       979 if ($chan) {
6085 110         319 push @chans, $chan;
6086 110         571 $query = $self->_state_chan_name($chan);
6087             }
6088             else {
6089 0         0 $query = '*';
6090             }
6091             }
6092              
6093 110         1528 my $chan_prefix_method = 'state_chan_list_prefixed';
6094 110         450 my $uid = $self->state_user_uid($nick);
6095             $chan_prefix_method = 'state_chan_list_multi_prefixed'
6096 110 100       1842 if $self->{state}{uids}{$uid}{caps}{'multi-prefix'};
6097              
6098 110 100       737 my $flag = ( $self->{state}{uids}{$uid}{caps}{'userhost-in-names'} ? 'FULL' : '' );
6099              
6100 110         635 for my $chan (@chans) {
6101 110         446 my $record = $self->{state}{chans}{uc_irc($chan)};
6102 110         1434 my $type = '=';
6103 110 50       671 $type = '@' if $record->{mode} =~ /s/;
6104 110 50       587 $type = '*' if $record->{mode} =~ /p/;
6105 110         432 my $length = length($server)+3+length($chan)+length($nick)+7;
6106 110         252 my $buffer = '';
6107              
6108 110         790 for my $name (sort $self->$chan_prefix_method($record->{name},$flag)) {
6109 193 50       920 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       580 if ($buffer) {
6119 83         300 $buffer = join ' ', $buffer, $name;
6120             }
6121             else {
6122 110         324 $buffer = $name;
6123             }
6124             }
6125             push @$ref, {
6126             prefix => $server,
6127             command => '353',
6128 110         993 params => [$nick, $type, $record->{name}, $buffer],
6129             };
6130             }
6131 110         746 push @$ref, {
6132             prefix => $server,
6133             command => '366',
6134             params => [$nick, $query, 'End of NAMES list'],
6135             };
6136             }
6137              
6138 110 50       1296 return @$ref if wantarray;
6139 0         0 return $ref;
6140             }
6141              
6142             sub _daemon_cmd_whois {
6143 6     6   19 my $self = shift;
6144 6   50     28 my $nick = shift || return;
6145 6         23 my $server = $self->server_name();
6146 6         16 my $ref = [ ];
6147 6         23 my ($first, $second) = @_;
6148              
6149             SWITCH: {
6150 6 0 33     15 if (!$first && !$second) {
  6         27  
6151 0         0 push @$ref, ['431'];
6152 0         0 last SWITCH;
6153             }
6154 6 100 66     37 if (!$second && $first) {
6155 5         25 $second = (split /,/, $first)[0];
6156 5         15 $first = $server;
6157             }
6158 6 50 33     34 if ($first && $second) {
6159 6         40 $second = (split /,/, $second)[0];
6160             }
6161 6 100 66     27 if (uc_irc($first) eq uc_irc($second)
6162             && $self->state_nick_exists($second)) {
6163 1         5 $first = $self->state_user_server($second);
6164             }
6165 6         147 my $query;
6166             my $target;
6167 6 50       66 $query = $first if !$second;
6168 6 50       22 $query = $second if $second;
6169 6 100 66     41 $target = $first if $second && uc $first ne uc $server;
6170 6 50 66     26 if ($target && !$self->state_peer_exists($target)) {
6171 0         0 push @$ref, ['402', $target];
6172 0         0 last SWITCH;
6173             }
6174 6 100       29 if ($target) {
6175             }
6176             # Okay we got here *phew*
6177 6 50       24 if (!$self->state_nick_exists($query)) {
6178 0         0 push @$ref, ['401', $query];
6179             }
6180             else {
6181 6         27 my $uid = $self->state_user_uid($nick);
6182 6         81 my $who = $self->state_user_uid($query);
6183 6 100       95 if ( $target ) {
6184 1         5 my $tsid = $self->_state_peer_sid($target);
6185 1 50       24 if ( $who =~ m!^$tsid! ) {
6186 1         5 $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         6 last SWITCH;
6198             }
6199             }
6200 5         36 $ref = $self->_daemon_do_whois($uid,$who);
6201 5         17 foreach my $reply ( @$ref ) {
6202 30         58 $reply->{prefix} = $server;
6203 30         70 $reply->{params}[0] = $nick;
6204             }
6205             }
6206             }
6207              
6208 6 50       59 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         4 my $peer_id = shift;
6215 2   50     42 my $uid = shift || return;
6216 2         10 my $sid = $self->server_sid();
6217 2         6 my $ref = [ ];
6218 2         6 my ($first, $second) = @_;
6219              
6220 2         7 my $targ = substr $first, 0, 3;
6221             SWITCH: {
6222 2 100       4 if ( $targ !~ m!^$sid! ) {
  2         36  
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         4 my $who = $self->state_user_uid($second);
6237 1         16 $ref = $self->_daemon_do_whois($uid,$who);
6238             }
6239              
6240 2 50       16 return @$ref if wantarray;
6241 0         0 return $ref;
6242             }
6243              
6244             sub _daemon_do_whois {
6245 6     6   13 my $self = shift;
6246 6   50     22 my $uid = shift || return;
6247 6         19 my $sid = $self->server_sid();
6248 6         20 my $server = $self->server_name();
6249 6         20 my $nicklen = $self->server_config('NICKLEN');
6250 6         16 my $ref = [ ];
6251 6         17 my $query = shift;
6252              
6253 6         18 my $querier = $self->{state}{uids}{$uid};
6254 6         20 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         54 ],
6267             };
6268 6         18 my @chans;
6269 6   33     41 my $noshow = ( $record->{umode} =~ m!p! && $querier->{umode} !~ m!o! && $uid ne $query );
6270 6         13 LOOP: for my $chan (keys %{ $record->{chans} }) {
  6         36  
6271 6 50       37 next LOOP if $noshow;
6272 6 50 33     67 if ($self->{state}{chans}{$chan}{mode} =~ /[ps]/
6273             && !defined $self->{state}{chans}{$chan}{users}{$uid}) {
6274 0         0 next LOOP;
6275             }
6276 6         19 my $prefix = '';
6277 6 50       85 $prefix .= '@' if $record->{chans}{$chan} =~ /o/;
6278 6 50       67 $prefix .= '%' if $record->{chans}{$chan} =~ /h/;
6279 6 50       41 $prefix .= '+' if $record->{chans}{$chan} =~ /v/;
6280 6         37 push @chans, $prefix . $self->{state}{chans}{$chan}{name};
6281             }
6282 6 50       26 if (@chans) {
6283 6         18 my $buffer = '';
6284             my $length = length($server) + 3 + $nicklen
6285 6         30 + length($record->{nick}) + 7;
6286              
6287 6         17 LOOP2: for my $chan (@chans) {
6288 6 50       97 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       31 if ($buffer) {
6298 0         0 $buffer = join ' ', $buffer, $chan;
6299             }
6300             else {
6301 6         18 $buffer = $chan;
6302             }
6303             }
6304             push @$ref, {
6305             prefix => $sid,
6306             command => '319',
6307 6         51 params => [$uid, $record->{nick}, $buffer],
6308             };
6309             }
6310             # RPL_WHOISSERVER
6311 6   66     64 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       64 ( $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       37 } 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       45 } 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     35 } if $record->{type} eq 'c' && $record->{away};
6353 6 50 33     41 if ($record->{umode} !~ m!H! || $querier->{umode} =~ m!o!) {
6354 6         14 my $operstring;
6355 6 100       41 if ( $record->{svstags}{313} ) {
6356 1         3 $operstring = $record->{svstags}{313}{tagline};
6357             }
6358             else {
6359 5 50       30 $operstring = 'is a Network Service' if $self->_state_sid_serv($record->{sid});
6360 5 100 66     73 $operstring = 'is a Server Administrator' if $record->{umode} =~ m!a! && !$operstring;
6361 5 50 66     134 $operstring = 'is an IRC Operator' if $record->{umode} =~ m!o! && !$operstring;
6362             }
6363             push @$ref, {
6364             prefix => $sid,
6365             command => '313',
6366 6 100       47 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         15 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         16 "is using modes $umodes"
6378             ],
6379             };
6380             }
6381 6 100 66     35 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     11 ( $record->{ipaddress} || 'fake.hidden' ),
6392             'Actual user@host, actual IP',
6393             ],
6394             };
6395             }
6396 6 100       25 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     21 } 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         54 params => [$uid, $record->{nick}, 'End of /WHOIS list.'],
6413             };
6414              
6415 6 100 66     78 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       81 );
    50          
6432             }
6433 6 50       40 return @$ref if wantarray;
6434 6         24 return $ref;
6435             }
6436              
6437             sub _daemon_cmd_whowas {
6438 3     3   10 my $self = shift;
6439 3   50     15 my $nick = shift || return;
6440 3         11 my $server = $self->server_name();
6441 3         50 my $sid = $self->server_sid();
6442 3         9 my $ref = [ ];
6443 3         11 my $args = [@_];
6444 3         11 my $count = @$args;
6445              
6446             SWITCH: {
6447 3 50       8 if (!$args->[0]) {
  3         42  
6448 0         0 push @$ref, ['431'];
6449 0         0 last SWITCH;
6450             }
6451 3 50       23 if (!$self->state_user_is_operator($nick)) {
6452 3         69 my $lastuse = $self->{state}{lastuse}{whowas};
6453 3         9 my $pacewait = $self->{config}{pace_wait};
6454 3 0 33     17 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         17 my $query = (split /,/, $args->[0])[0];
6461 3 50       13 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         21 my $uid = $self->state_user_uid($nick);
6483 3         42 push @$ref, $_ for map { $_->{prefix} = $server; $_->{params}[0] = $nick; $_ }
  22         35  
  22         40  
  22         51  
6484 3         26 @{ $self->_daemon_do_whowas($uid,@$args) };
6485             }
6486              
6487 3 50       38 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     9 my $peer_id = shift || return;
6494 2   50     9 my $uid = shift || return;
6495 2         11 my $server = $self->server_name();
6496 2         7 my $sid = $self->server_sid();
6497 2         5 my $ref = [ ];
6498 2         10 my ($first, $second, $third) = @_;
6499              
6500 2         8 my $targ = substr $third, 0, 3;
6501             SWITCH: {
6502 2 100       7 if ( $targ !~ m!^$sid! ) {
  2         47  
6503 1         8 $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       37 return @$ref if wantarray;
6521 0         0 return $ref;
6522             }
6523              
6524             sub _daemon_do_whowas {
6525 4     4   14 my $self = shift;
6526 4   50     17 my $uid = shift || return;
6527 4         17 my $server = $self->server_name();
6528 4         16 my $sid = $self->server_sid();
6529 4         11 my $ref = [ ];
6530 4         13 my $args = [@_];
6531 4         11 my $query = shift @$args;
6532              
6533             SWITCH: {
6534 4         10 my $is_oper = ( $self->{state}{uids}{$uid}{umode} =~ /o/ );
  4         33  
6535 4         12 my $max = shift @$args;
6536 4 50 33     112 if ( $uid !~ m!^$sid! && ( !$max || $max < 0 || $max > 20 ) ) {
      66        
6537 1         3 $max = 20;
6538             }
6539 4 100       57 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         6 last SWITCH;
6546             }
6547 3         57 my $cnt = 0;
6548 3         10 WASNOTWAS: foreach my $was ( @{ $self->{state}{whowas}{uc_irc $query} } ) {
  3         16  
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         200 ],
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       198 '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       177 } 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     1319 strftime("%a %b %e %T %Y", localtime($was->{logoff})),
6588             ],
6589             };
6590 26         160 ++$cnt;
6591 26 100 100     145 last WASNOTWAS if $max && $cnt >= $max;
6592             }
6593             }
6594              
6595 4         23 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   18 my $self = shift;
6607 6   50     24 my $nick = shift || return;
6608 6         17 my ($who, $op_only) = @_;
6609 6         18 my $server = $self->server_name();
6610 6         15 my $ref = [ ];
6611 6         14 my $orig = $who;
6612              
6613             SWITCH: {
6614 6 50       12 if (!$who) {
  6         24  
6615 0         0 push @$ref, ['461', 'WHO'];
6616 0         0 last SWITCH;
6617             }
6618 6 50 33     19 if ($self->state_chan_exists($who)
6619             && $self->state_is_chan_member($nick, $who)) {
6620 6         89 my $uid = $self->state_user_uid($nick);
6621 6         80 my $multiprefix = $self->{state}{uids}{$uid}{caps}{'multi-prefix'};
6622 6         21 my $record = $self->{state}{chans}{uc_irc($who)};
6623 6         71 $who = $record->{name};
6624 6         14 for my $member (keys %{ $record->{users} }) {
  6         29  
6625 15         60 my $rpl_who = {
6626             prefix => $server,
6627             command => '352',
6628             params => [$nick, $who],
6629             };
6630 15         36 my $memrec = $self->{state}{uids}{$member};
6631 15         25 push @{ $rpl_who->{params} }, $memrec->{auth}{ident};
  15         41  
6632 15         26 push @{ $rpl_who->{params} }, $memrec->{auth}{hostname};
  15         39  
6633 15         25 push @{ $rpl_who->{params} }, $memrec->{server};
  15         41  
6634 15         23 push @{ $rpl_who->{params} }, $memrec->{nick};
  15         32  
6635 15 50       43 my $status = ($memrec->{away} ? 'G' : 'H');
6636 15 50       52 $status .= '*' if $memrec->{umode} =~ /o/;
6637             {
6638 15         24 my $stat = $record->{users}{$member};
  15         27  
6639 15 100       38 if ( $stat ) {
6640 6 100       19 if ( !$multiprefix ) {
6641 2 50       16 $stat =~ s![vh]!!g if $stat =~ /o/;
6642 2 50       8 $stat =~ s![v]!!g if $stat =~ /h/;
6643             }
6644             else {
6645 4         12 my $ostat = join '', grep { $stat =~ m!$_! } qw[o h v];
  12         127  
6646 4         11 $stat = $ostat;
6647             }
6648 6         11 $stat =~ tr/ohv/@%+/;
6649 6         16 $status .= $stat;
6650             }
6651             }
6652 15         25 push @{ $rpl_who->{params} }, $status;
  15         38  
6653 15         52 push @{ $rpl_who->{params} }, "$memrec->{hops} "
6654 15         26 . $memrec->{ircname};
6655 15         40 push @$ref, $rpl_who;
6656             }
6657             }
6658 6 50       23 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         34 push @$ref, {
6678             prefix => $server,
6679             command => '315',
6680             params => [$nick, $orig, 'End of WHO list'],
6681             };
6682             }
6683              
6684 6 50       50 return @$ref if wantarray;
6685 0         0 return $ref;
6686             }
6687              
6688             sub _daemon_cmd_mode {
6689 54     54   185 my $self = shift;
6690 54   50     245 my $nick = shift || return;
6691 54         139 my $chan = shift;
6692 54         221 my $server = $self->server_name();
6693 54         213 my $sid = $self->server_sid();
6694 54         234 my $maxmodes = $self->server_config('MODES');
6695 54         176 my $ref = [ ];
6696 54         192 my $args = [@_];
6697 54         160 my $count = @$args;
6698              
6699             SWITCH: {
6700 54 50       121 if (!$self->state_chan_exists($chan)) {
  54         253  
6701 0         0 push @$ref, ['403', $chan];
6702 0         0 last SWITCH;
6703             }
6704              
6705 54         280 my $record = $self->{state}{chans}{uc_irc($chan)};
6706 54         742 $chan = $record->{name};
6707              
6708 54 50 66     300 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       390 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     245 ($record->{climit} || ()),
      33        
6733             ],
6734             colonify => 0,
6735             };
6736             push @$ref, {
6737             prefix => $server,
6738             command => '329',
6739 13         112 params => [$nick, $chan, $record->{ts}],
6740             colonify => 0,
6741             };
6742 13         47 last SWITCH;
6743             }
6744              
6745 41         103 my $unknown = 0;
6746 41         87 my $notop = 0;
6747 41         109 my $notoper = 0;
6748 41         296 my $nick_is_op = $self->state_is_chan_op($nick, $chan);
6749 41         827 my $nick_is_hop = $self->state_is_chan_hop($nick, $chan);
6750 41         286 my $nick_is_oper = $self->state_user_is_operator($nick);
6751 41   100     734 my $no_see_bans = ( $record->{mode} =~ /u/ && !( $nick_is_op || $nick_is_hop ) );
6752 41         169 my $mode_u_set = ( $record->{mode} =~ /u/ );
6753 41         154 my $reply;
6754 41         0 my @reply_args; my %subs;
6755 41         203 my $parsed_mode = parse_mode_line(@$args);
6756 41         2890 my $mode_count = 0;
6757              
6758 41         111 while (my $mode = shift @{ $parsed_mode->{modes} }) {
  101         437  
6759 60 50       307 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         142 my $arg;
6770 60 100       359 if ($mode =~ /^(\+[ohvklbIe]|-[ohvbIe])/) {
6771 45         123 $arg = shift @{ $parsed_mode->{args} };
  45         149  
6772             }
6773 60 100 100     317 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         8 } for grep { !$no_see_bans } keys %{ $record->{bans} };
  2         9  
  2         9  
6783 2         27 push @$ref, {
6784             prefix => $server,
6785             command => '368',
6786             params => [$nick, $chan, 'End of Channel Ban List'],
6787             };
6788 2         7 next;
6789             }
6790 58 100 100     299 if ($mode =~ m![OL]! && !$nick_is_oper) {
6791 1 50       37 push @$ref, ['481'] if !$notoper;
6792 1         4 $notoper++;
6793 1         5 next;
6794             }
6795 57 0 33     236 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     264 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     251 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     242 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     290 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     710 if (($mode =~ /^[-+][ohv]/ || $mode =~ /^\+[lk]/)
      66        
6846             && !defined $arg) {
6847 0         0 next;
6848             }
6849 57 50 66     394 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     498 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       960 if (my ($flag, $char) = $mode =~ /^([-+])([ohv])/ ) {
6861 42 50       182 next if ++$mode_count > $maxmodes;
6862              
6863 42 100 66     334 if ($flag eq '+'
6864             && $record->{users}{$self->state_user_uid($arg)} !~ /$char/) {
6865             # Update user and chan record
6866 30         916 $arg = $self->state_user_uid($arg);
6867             $record->{users}{$arg} = join('', sort
6868 30         575 split //, $record->{users}{$arg} . $char);
6869             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
6870 30         165 = $record->{users}{$arg};
6871 30         422 $reply .= $mode;
6872 30         136 my $anick = $self->state_user_nick($arg);
6873 30         128 $subs{$anick} = $arg;
6874 30         115 push @reply_args, $anick;
6875             }
6876              
6877 42 50 33     518 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         125 next;
6890             }
6891 15 0 33     84 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     69 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     106 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     81 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       106 my $maxbans = ( $record->{mode} =~ m!L! ? $self->{config}{max_bans_large} : $self->{config}{MAXBANS} );
6928 15 100       78 if (my ($flag) = $mode =~ /([-+])b/) {
6929 1 50       7 next if ++$mode_count > $maxmodes;
6930 1         6 my $mask = normalize_mask($arg);
6931 1         45 my $umask = uc_irc $mask;
6932 1 50 33     23 if ($flag eq '+' && !$record->{bans}{$umask}) {
6933 1 50       4 if ( keys %{ $record->{bans} } >= $maxbans ) {
  1         6  
6934 0         0 push @$ref, [ '478', $record->{name}, 'b' ];
6935 0         0 next;
6936             }
6937 1         10 $record->{bans}{$umask}
6938             = [$mask, $self->state_user_full($nick), time];
6939 1         28 $reply .= $mode;
6940 1         5 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       77 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       63 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         92 my ($flag, $char) = split //, $mode;
6997 14 100 66     262 if ($flag eq '+' && $record->{mode} !~ /$char/) {
6998 11         37 $reply .= $mode;
6999             $record->{mode} = join('', sort
7000 11         136 split //, $record->{mode} . $char);
7001 11         46 next;
7002             }
7003 3 50 33     96 if ($flag eq '-' && $record->{mode} =~ /$char/) {
7004 3         12 $reply .= $mode;
7005 3         28 $record->{mode} =~ s/$char//g;
7006 3         14 next;
7007             }
7008             } # while
7009              
7010 41 100       192 if ($reply) {
7011 32         180 $reply = unparse_mode_line($reply);
7012             my @reply_args_peer = map {
7013 32 100       1162 ( defined $subs{$_} ? $subs{$_} : $_ )
  31         234  
7014             } @reply_args;
7015             $self->send_output(
7016             {
7017             prefix => $self->state_user_uid($nick),
7018             command => 'TMODE',
7019 32         197 params => [$record->{ts}, $chan, $reply, @reply_args_peer],
7020             colonify => 0,
7021             },
7022             $self->_state_connected_peers(),
7023             );
7024 32         253 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       460 $reply,
7034             @reply_args,
7035             ],
7036             },
7037             '', ( $mode_u_set ? 'oh' : '' ),
7038             );
7039 32 100       288 if ($mode_u_set) {
7040 2         10 my $bparse = parse_mode_line( $reply, @reply_args );
7041 2         105 my $breply; my @breply_args;
7042 2         4 while (my $bmode = shift (@{ $bparse->{modes} })) {
  4         16  
7043 2         7 my $arg;
7044 2 100       13 $arg = shift @{ $bparse->{args} }
  1         39  
7045             if $bmode =~ /^(\+[ohvklbIe]|-[ohvbIe])/;
7046 2 100       14 next if $bmode =~ m!^[+-][beI]$!;
7047 1         4 $breply .= $bmode;
7048 1 50       5 push @breply_args, $arg if $arg;
7049             }
7050 2 100       19 if ($breply) {
7051 1         4 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         33 $parsed_line,
7061             @breply_args,
7062             ],
7063             },
7064             '','-oh',
7065             );
7066             }
7067             }
7068             }
7069             } # SWITCH
7070              
7071 54 50       451 return @$ref if wantarray;
7072 0         0 return $ref;
7073             }
7074              
7075             sub _daemon_cmd_join {
7076 117     117   364 my $self = shift;
7077 117   50     447 my $nick = shift || return;
7078 117         390 my $server = $self->server_name();
7079 117         516 my $sid = $self->server_sid();
7080 117         323 my $ref = [ ];
7081 117         339 my $args = [@_];
7082 117         343 my $count = @$args;
7083 117         499 my $route_id = $self->_state_user_route($nick);
7084 117         623 my $uid = $self->state_user_uid($nick);
7085 117         1684 my $unick = uc_irc($nick);
7086              
7087             SWITCH: {
7088 117         1390 my (@channels, @chankeys);
  117         342  
7089 117 50       449 if (!$count) {
7090 0         0 push @$ref, ['461', 'JOIN'];
7091 0         0 last SWITCH;
7092             }
7093              
7094 117         655 @channels = split /,/, $args->[0];
7095 117 50       598 @chankeys = split /,/, $args->[1] if $args->[1];
7096 117         500 my $channel_length = $self->server_config('CHANNELLEN');
7097 117         652 my $nick_is_oper = $self->state_user_is_operator($nick);
7098              
7099 117         2027 LOOP: for my $channel (@channels) {
7100 117         390 my $uchannel = uc_irc($channel);
7101 117 50 33     1778 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     688 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     6676 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       587 if (my $reason = $self->_state_is_resv($channel,$route_id)) {
7132 1 50       4 if ( !$nick_is_oper ) {
7133 1         4 $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         5 $self->_send_output_to_client(
7143             $route_id,
7144             '485',
7145             $channel,
7146             $reason,
7147             );
7148 1         5 next LOOP;
7149             }
7150             }
7151             # Channel doesn't exist
7152 116 100       683 if (!$self->state_chan_exists($channel)) {
7153 56         1326 my $record = {
7154             name => $channel,
7155             ts => time,
7156             mode => 'nt',
7157             users => { $uid => 'o' },
7158             };
7159 56         314 $self->{state}{chans}{$uchannel} = $record;
7160 56         231 $self->{state}{users}{$unick}{chans}{$uchannel} = 'o';
7161 56         302 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       1013 '@' . $uid,
7171             ],
7172             },
7173             @peers,
7174             ) if $channel !~ /^&/;
7175 56         454 my $output = {
7176             prefix => $self->state_user_full($nick),
7177             command => 'JOIN',
7178             params => [$channel],
7179             };
7180 56         336 $self->send_output($output, $route_id);
7181             $self->send_event(
7182             "daemon_join",
7183             $output->{prefix},
7184 56         401 $channel,
7185             );
7186             $self->send_output(
7187             {
7188             prefix => $server,
7189             command => 'MODE',
7190 56         6660 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       504 ) for $self->_daemon_cmd_names($nick, $channel);
7198 56         431 next LOOP;
7199             }
7200             # Numpty user is already on channel
7201 60 50       365 if ($self->state_is_chan_member($nick, $channel)) {
7202 0         0 next LOOP;
7203             }
7204 60         271 my $chanrec = $self->{state}{chans}{$uchannel};
7205 60         137 my $bypass;
7206 60 50 66     270 if ($nick_is_oper && $self->{config}{OPHACKS}) {
7207 0         0 $bypass = 1;
7208             }
7209             # OPER only channel +O
7210 60 50 33     800 if ($chanrec->{mode} =~ /O/ && !$nick_is_oper) {
7211 0         0 push @$ref, ['520',$chanrec->{name}];
7212 0         0 next LOOP;
7213             }
7214 60         316 my $umode = $self->state_user_umode($nick);
7215             # SSL only channel +S
7216 60 100 100     1097 if ($chanrec->{mode} =~ /S/ && $umode !~ /S/) {
7217 1         7 push @$ref, ['489',$chanrec->{name}];
7218 1         5 next LOOP;
7219             }
7220             # Registered users only +R
7221 59 100 66     440 if($chanrec->{mode} =~ /R/ && $umode !~ /r/) {
7222 2         10 push @$ref, ['477',$chanrec->{name}];
7223 2         10 next LOOP;
7224             }
7225             # Channel is full
7226 57 50 33     514 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         153 my $chankey;
7232 57 50       338 $chankey = shift @chankeys if $chanrec->{mode} =~ /k/;
7233             # Channel +k and no key or invalid key provided
7234 57 0 33     484 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     570 if (!$bypass && $chanrec->{mode} =~ /i/
      100        
7241             && !$self->_state_user_invited($nick, $channel)) {
7242 3         20 $self->_send_output_to_client($route_id, '473', $channel);
7243 3         15 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       449 $self->state_check_spambot_warning($nick,$channel) if !$nick_is_oper;
7252 54 100       353 $self->state_check_joinflood_warning($nick,$channel) if !$nick_is_oper;
7253             # JOIN the channel
7254 54         300 delete $self->{state}{users}{$unick}{invites}{$uchannel};
7255 54         233 delete $self->{state}{chans}{$uchannel}{invites}{$uid};
7256             # Add user
7257 54         233 $self->{state}{uids}{$uid}{chans}{$uchannel} = '';
7258 54         223 $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       728 params => [$chanrec->{ts}, $channel, '+'],
7265             },
7266             $self->_state_connected_peers(),
7267             ) if $channel !~ /^&/;
7268              
7269 54         421 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         247 ],
7282             };
7283 54         317 $self->_send_output_to_client($route_id, $output);
7284 54         480 $self->_send_output_channel_local($channel, $output, $route_id, '', '', 'extended-join');
7285 54         259 $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       506 ) for $self->_daemon_cmd_names($nick, $channel);
7292             $self->_send_output_to_client(
7293             $route_id,
7294             (ref $_ eq 'ARRAY' ? @$_ : $_),
7295 54 50       493 ) for $self->_daemon_cmd_topic($nick, $channel);
7296              
7297 54 100       852 if ( $self->{state}{uids}{$uid}{away} ) {
7298 1         6 $self->_state_do_away_notify($uid,$channel,$self->{state}{uids}{$uid}{away});
7299             }
7300             }
7301             }
7302              
7303 117 100       758 return @$ref if wantarray;
7304 1         3 return $ref;
7305             }
7306              
7307             sub _daemon_cmd_part {
7308 8     8   25 my $self = shift;
7309 8   50     49 my $nick = shift || return;
7310 8         27 my $chan = shift;
7311 8         31 my $server = $self->server_name();
7312 8         28 my $ref = [ ];
7313 8         28 my $args = [@_];
7314 8         28 my $count = @$args;
7315              
7316             SWITCH: {
7317 8 50       17 if (!$chan) {
  8         35  
7318 0         0 push @$ref, ['461', 'PART'];
7319 0         0 last SWITCH;
7320             }
7321 8 50       45 if (!$self->state_chan_exists($chan)) {
7322 0         0 push @$ref, ['403', $chan];
7323 0         0 last SWITCH;
7324             }
7325 8 50       66 if (!$self->state_is_chan_member($nick, $chan)) {
7326 0         0 push @$ref, ['442', $chan];
7327 0         0 last SWITCH;
7328             }
7329              
7330 8         203 $chan = $self->_state_chan_name($chan);
7331 8         127 my $uid = $self->state_user_uid($nick);
7332 8         150 my $urec = $self->{state}{uids}{$uid};
7333              
7334 8         28 my $pmsg = $args->[0];
7335 8         24 my $params = [ $chan ];
7336              
7337 8 50 66     106 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     71 if ( $pmsg && !$self->state_can_send_to_channel($nick,$chan,$pmsg,'PART') ) {
7342 0         0 $pmsg = '';
7343             }
7344              
7345 8 100       43 push @$params, $pmsg if $pmsg;
7346              
7347 8 100       94 $self->state_check_spambot_warning($nick) if $urec->{umode} !~ /o/;
7348              
7349 8         88 $self->send_output(
7350             {
7351             prefix => $uid,
7352             command => 'PART',
7353             params => $params,
7354             },
7355             $self->_state_connected_peers(),
7356             );
7357 8         73 $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         49 $chan = uc_irc($chan);
7367 8         130 delete $self->{state}{chans}{$chan}{users}{$uid};
7368 8         30 delete $self->{state}{uids}{$uid}{chans}{$chan};
7369 8 100       21 if (! keys %{ $self->{state}{chans}{$chan}{users} }) {
  8         84  
7370 5         25 delete $self->{state}{chans}{$chan};
7371             }
7372             }
7373              
7374 8 50       78 return @$ref if wantarray;
7375 0         0 return $ref;
7376             }
7377              
7378             sub _daemon_cmd_kick {
7379 7     7   20 my $self = shift;
7380 7   50     27 my $nick = shift || return;
7381 7         19 my $server = $self->server_name();
7382 7         18 my $ref = [ ];
7383 7         21 my $args = [@_];
7384 7         16 my $count = @$args;
7385              
7386             SWITCH: {
7387 7 50 33     14 if (!$count || $count < 2) {
  7         42  
7388 0         0 push @$ref, ['461', 'KICK'];
7389 0         0 last SWITCH;
7390             }
7391 7         42 my $chan = (split /,/, $args->[0])[0];
7392 7         29 my $who = (split /,/, $args->[1])[0];
7393 7 50       27 if (!$self->state_chan_exists($chan)) {
7394 0         0 push @$ref, ['403', $chan];
7395 0         0 last SWITCH;
7396             }
7397 7         40 $chan = $self->_state_chan_name($chan);
7398 7 50 66     128 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       112 if (!$self->state_nick_exists($who) ) {
7403 0         0 push @$ref, ['401', $who];
7404 0         0 last SWITCH;
7405             }
7406 7         26 $who = $self->state_user_nick($who);
7407 7 100       91 if (!$self->state_is_chan_member($who, $chan)) {
7408 3         16 push @$ref, ['441', $who, $chan];
7409 3         10 last SWITCH;
7410             }
7411 4 50 66     101 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         50 push @$ref, ['482', $chan];
7417 3         15 last SWITCH;
7418             }
7419 1   33     17 my $comment = $args->[2] || $who;
7420 1         4 my $uid = $self->state_user_uid($nick);
7421 1         16 my $wuid = $self->state_user_uid($who);
7422 1         27 $self->send_output(
7423             {
7424             prefix => $uid,
7425             command => 'KICK',
7426             params => [$chan, $wuid, $comment],
7427             },
7428             $self->_state_connected_peers(),
7429             );
7430 1         8 $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         15 $chan = uc_irc($chan);
7439 1         13 delete $self->{state}{chans}{$chan}{users}{$wuid};
7440 1         3 delete $self->{state}{uids}{$wuid}{chans}{$chan};
7441 1 50       2 if (!keys %{ $self->{state}{chans}{$chan}{users} }) {
  1         12  
7442 0         0 delete $self->{state}{chans}{$chan};
7443             }
7444             }
7445              
7446 7 50       53 return @$ref if wantarray;
7447 0         0 return $ref;
7448             }
7449              
7450             sub _daemon_cmd_remove {
7451 3     3   7 my $self = shift;
7452 3   50     8 my $nick = shift || return;
7453 3         8 my $server = $self->server_name();
7454 3         8 my $ref = [ ];
7455 3         9 my $args = [@_];
7456 3         7 my $count = @$args;
7457              
7458             SWITCH: {
7459 3 50 33     6 if (!$count || $count < 2) {
  3         17  
7460 0         0 push @$ref, ['461', 'REMOVE'];
7461 0         0 last SWITCH;
7462             }
7463 3         16 my $chan = (split /,/, $args->[0])[0];
7464 3         9 my $who = (split /,/, $args->[1])[0];
7465 3 50       11 if (!$self->state_chan_exists($chan)) {
7466 0         0 push @$ref, ['403', $chan];
7467 0         0 last SWITCH;
7468             }
7469 3         25 $chan = $self->_state_chan_name($chan);
7470 3 50 66     47 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       53 if (!$self->state_nick_exists($who) ) {
7475 0         0 push @$ref, ['401', $who];
7476 0         0 last SWITCH;
7477             }
7478 3         13 $who = $self->state_user_nick($who);
7479 3 100       42 if (!$self->state_is_chan_member($who, $chan)) {
7480 1         6 push @$ref, ['441', $who, $chan];
7481 1         3 last SWITCH;
7482             }
7483 2 50 66     57 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         23 push @$ref, ['482', $chan];
7489 1         4 last SWITCH;
7490             }
7491 1         5 my $comment = "Requested by $nick";
7492 1 50       9 $comment .= qq{ "$args->[2]"} if $args->[2];
7493 1         4 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         30 $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         15 $chan = uc_irc($chan);
7511 1         18 delete $self->{state}{chans}{$chan}{users}{$uid};
7512 1         5 delete $self->{state}{uids}{$uid}{chans}{$chan};
7513 1 50       3 if (! keys %{ $self->{state}{chans}{$chan}{users} }) {
  1         8  
7514 0         0 delete $self->{state}{chans}{$chan};
7515             }
7516             }
7517              
7518 3 50       20 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   751 my $self = shift;
7643 231   50     1052 my $nick = shift || return;
7644 231         1004 my $args = [ @_ ];
7645 231         674 my $count = @$args;
7646 231         845 my $server = $self->server_name();
7647 231         724 my $ref = [ ];
7648 231         1168 my $record = $self->{state}{users}{uc_irc($nick)};
7649              
7650 231 100       3667 if (!$count) {
7651             push @$ref, {
7652             prefix => $server,
7653             command => '221',
7654 2         24 params => [$nick, '+' . $record->{umode}],
7655             };
7656             }
7657             else {
7658 229         1107 my $modestring = join('', @$args);
7659 229         1487 $modestring =~ s/\s+//g;
7660 229         969 my $cnt += $modestring =~ s/[^a-zA-Z+-]+//g;
7661 229         859 $cnt += $modestring =~ s/[^DFGHRSWXabcdefgijklnopqrsuwy+-]+//g;
7662              
7663             # These can only be set by servers/services
7664 229         781 $modestring =~ s/[SWr]+//g;
7665              
7666             # These can only be set by an OPER
7667 229 50       1353 $cnt += $modestring =~ s/[FHXabcdefjklnsuy]+//g if $record->{umode} !~ /o/;
7668              
7669 229 100       949 push @$ref, ['501'] if $cnt;
7670              
7671 229         1353 my $umode = unparse_mode_line($modestring);
7672 229         7995 my $peer_ignore;
7673 229         1273 my $parsed_mode = parse_mode_line($umode);
7674 229         20754 my $route_id = $self->_state_user_route($nick);
7675 229         845 my $previous = $record->{umode};
7676              
7677 229         677 while (my $mode = shift @{ $parsed_mode->{modes} }) {
  457         2130  
7678 228 50       1112 next if $mode eq '+o';
7679 228         1145 my ($action, $char) = split //, $mode;
7680 228 50 33     3911 if ($action eq '+' && $record->{umode} !~ /$char/) {
7681 228         917 $record->{umode} .= $char;
7682 228 100       1101 if ($char eq 'i') {
7683 227         840 $self->{state}{stats}{invisible}++;
7684 227         772 $peer_ignore = delete $record->{_ignore_i_umode};
7685             }
7686 228 50       1079 if ($char eq 'w') {
7687 0         0 $self->{state}{wallops}{$route_id} = time;
7688             }
7689 228 50       1092 if ($char eq 'l') {
7690 0         0 $self->{state}{locops}{$route_id} = time;
7691             }
7692             }
7693 228 50 33     1487 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         1635 $record->{umode} = join '', sort split //, $record->{umode};
7713 229         1364 my $set = gen_mode_change($previous, $record->{umode});
7714 229 100       18250 if ($set) {
7715 228         1493 my $full = $self->state_user_full($nick);
7716             $self->send_output(
7717             {
7718             prefix => $record->{uid},
7719             command => 'MODE',
7720 228 100       1099 params => [$record->{uid}, $set],
7721             },
7722             $self->_state_connected_peers(),
7723             ) if !$peer_ignore;
7724 228         1572 my $hashref = {
7725             prefix => $full,
7726             command => 'MODE',
7727             params => [$nick, $set],
7728             };
7729 228 100       1023 $self->send_event(
7730             "daemon_umode",
7731             $full,
7732             $set,
7733             ) if !$peer_ignore;
7734 228         1231 push @$ref, $hashref;
7735             }
7736             }
7737              
7738 231 50       2753 return @$ref if wantarray;
7739 0         0 return $ref;
7740             }
7741              
7742             sub _daemon_cmd_topic {
7743 60     60   166 my $self = shift;
7744 60   50     280 my $nick = shift || return;
7745 60         220 my $server = $self->server_name();
7746 60         184 my $ref = [ ];
7747 60         196 my $args = [@_];
7748 60         171 my $count = @$args;
7749              
7750             SWITCH:{
7751 60 50       144 if (!$count) {
  60         247  
7752 0         0 push @$ref, ['461', 'TOPIC'];
7753 0         0 last SWITCH;
7754             }
7755 60 50       274 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     434 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         303 my $chan_name = $self->_state_chan_name($args->[0]);
7765 60 50 66     1247 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       260 if ($count == 1) {
7780 57         423 push @$ref, {
7781             prefix => $server,
7782             command => '331',
7783             params => [$nick, $chan_name, 'No topic is set'],
7784             };
7785 57         198 last SWITCH;
7786             }
7787 3 50       17 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     46 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         69 my $record = $self->{state}{chans}{uc_irc($args->[0])};
7797 3         69 my $topic_length = $self->server_config('TOPICLEN');
7798 3 50       22 if (length $args->[0] > $topic_length) {
7799 0         0 $args->[1] = substr $args->[0], 0, $topic_length;
7800             }
7801 3 100       27 if ($args->[1] eq '') {
7802 1         6 delete $record->{topic};
7803             }
7804             else {
7805             $record->{topic} = [
7806 2         15 $args->[1],
7807             $self->state_user_full($nick),
7808             time,
7809             ];
7810             }
7811 3         29 $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         34 $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       727 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     8 my $nick = shift || return;
7837 2         8 my $server = $self->server_name();
7838 2         8 my $sid = $self->server_sid();
7839 2         5 my $ref = [ ];
7840              
7841             SWITCH: {
7842 2 50       5 if (!$self->state_user_is_operator($nick)) {
  2         12  
7843 2         40 my $lastuse = $self->{state}{lastuse}{map};
7844 2         6 my $pacewait = $self->{config}{pace_wait};
7845 2 0 33     10 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         15 my $msg = sprintf('MAP requested by %s (%s) [%s]',
7854             $nick, (split /!/,$full)[1], $server,
7855             );
7856              
7857 2         16 $self->_send_to_realops( $msg, 'Notice', 'y' );
7858              
7859 2         14 push @$ref, $_ for
7860             $self->_state_do_map( $nick, $sid, 0 );
7861              
7862 2         13 push @$ref, {
7863             prefix => $server,
7864             command => '017',
7865             params => [
7866             $nick,
7867             'End of /MAP',
7868             ],
7869             };
7870             }
7871              
7872 2 50       32 return @$ref if wantarray;
7873 0         0 return $ref;
7874             }
7875              
7876             sub _daemon_cmd_links {
7877 7     7   14 my $self = shift;
7878 7   50     19 my $nick = shift || return;
7879 7         15 my $server = $self->server_name();
7880 7         14 my $sid = $self->server_sid();
7881 7         17 my $args = [ @_ ];
7882 7         14 my $count = @$args;
7883 7         11 my $ref = [ ];
7884              
7885             SWITCH:{
7886 7         13 my $target;
  7         8  
7887 7 100 100     34 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         12 my $lastuse = $self->{state}{lastuse}{links};
7892 6         15 my $pacewait = $self->{config}{pace_wait};
7893 6 100 100     36 if ( $lastuse && $pacewait && ( $lastuse + $pacewait ) > time() ) {
      66        
7894 1         4 push @$ref, ['263', 'LINKS'];
7895 1         2 last SWITCH;
7896             }
7897 5         13 $self->{state}{lastuse}{links} = time();
7898 5 100       14 if ( $count > 1 ) {
7899 1         3 $target = shift @$args;
7900             }
7901 5 100 66     17 if ($target && uc $server ne uc $target) {
7902 1         25 $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         5 last SWITCH;
7914             }
7915              
7916             $self->_send_to_realops(
7917 4         17 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     22 my $mask = shift @$args || '*';
7924              
7925 4         9 push @$ref, $_ for
7926 4         15 @{ $self->_daemon_do_links($nick,$server,$mask) };
7927             }
7928              
7929 7 50       53 return @$ref if wantarray;
7930 0         0 return $ref;
7931             }
7932              
7933             sub _daemon_do_links {
7934 5     5   22 my $self = shift;
7935 5   50     18 my $client = shift || return;
7936 5   50     27 my $prefix = shift || return;
7937 5   50     16 my $mask = shift || return;
7938 5         17 my $sid = $self->server_sid();
7939 5         12 my $server = $self->server_name();
7940 5         10 my $ref = [ ];
7941              
7942 5         26 for ($self->_state_sid_links($sid, $prefix, $client, $mask)) {
7943 13         30 push @$ref, $_;
7944             }
7945 5 100       39 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         56 push @$ref, {
7956             prefix => $prefix,
7957             command => '365',
7958             params => [$client, $mask, 'End of /LINKS list.'],
7959             };
7960              
7961 5 50       18 return @$ref if wantarray;
7962 5         37 return $ref;
7963             }
7964              
7965             sub _daemon_cmd_knock {
7966 7     7   21 my $self = shift;
7967 7   50     26 my $nick = shift || return;
7968 7         34 my $server = $self->server_name();
7969 7         22 my $sid = $self->server_sid();
7970 7         20 my $args = [ @_ ];
7971 7         19 my $count = @$args;
7972 7         17 my $ref = [ ];
7973              
7974             SWITCH:{
7975 7 50       14 if (!$count) {
  7         26  
7976 0         0 push @$ref, ['461', 'KNOCK'];
7977 0         0 last SWITCH;
7978             }
7979 7         20 my $channel = shift @$args;
7980 7 50       29 if ( !$self->state_chan_exists($channel) ) {
7981 0         0 push @$ref, ['401', $channel];
7982 0         0 last SWITCH;
7983             }
7984 7 50       33 if ( $self->state_is_chan_member($nick,$channel) ) {
7985 0         0 push @$ref, ['714', $channel];
7986 0         0 last SWITCH;
7987             }
7988 7         28 my $chanrec = $self->{state}{chans}{uc_irc $channel};
7989 7 50 66     115 if ( !( $chanrec->{mode} =~ /i/ || $chanrec->{ckey} || ($chanrec->{mode} =~ /l/
      33        
      33        
7990 1         7 && keys %{$chanrec->{users}} >= $chanrec->{climit}) ) ) {
7991 1         4 push @$ref, ['713', $channel];
7992 1         4 last SWITCH;
7993             }
7994 6 50 33     44 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         23 my $uid = $self->state_user_uid($nick);
8000 6         89 my $rec = $self->{state}{uids}{$uid};
8001              
8002 6 100       23 if ( !$rec->{last_knock} ) {
8003 3         9 $rec->{knock_count} = 0;
8004             }
8005 6 50 66     64 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     31 if ( $rec->{knock_count} && $rec->{knock_count} > $self->{config}{knock_client_count} ) {
8009 1         8 push @$ref, ['712', $channel,'user'];
8010 1         4 last SWITCH;
8011             }
8012 5 100 66     187 if ( $chanrec->{last_knock} && ( $chanrec->{last_knock} + $self->{config}{knock_delay_channel} ) > time() ) {
8013 1         5 push @$ref, ['712', $channel,'channel'];
8014 1         5 last SWITCH;
8015             }
8016              
8017 4         16 $rec->{last_knock} = time();
8018 4         11 $rec->{knock_count}++;
8019              
8020 4         15 push @$ref, ['711', $channel]; # KNOCK Delivered
8021              
8022 4         16 $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         19 $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         40 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   4 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         4 my $ref = [ ];
8091 1         4 my $args = [ @_ ];
8092 1         5 my $count = @$args;
8093              
8094             SWITCH: {
8095 1 50       3 if (!$count) {
  1         4  
8096 0         0 last SWITCH;
8097             }
8098 1         4 my $channel = shift @$args;
8099 1 50       4 if ( !$self->state_chan_exists($channel) ) {
8100 0         0 last SWITCH;
8101             }
8102 1         8 my $chanrec = $self->{state}{chans}{uc_irc $channel};
8103 1         14 $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         7 $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       10 grep { $_ ne $peer_id && $self->_state_peer_capab($_,'KNOCK') }
  2         13  
8125             $self->_state_connected_peers(),
8126             );
8127             }
8128              
8129 1 50       12 return @$ref if wantarray;
8130 1         4 return $ref;
8131             }
8132              
8133             sub _daemon_peer_squit {
8134 228     228   593 my $self = shift;
8135 228   50     1019 my $peer_id = shift || return;
8136 228         979 my $sid = $self->server_sid();
8137 228         713 my $ref = [ ];
8138 228         687 my $args = [ @_ ];
8139 228         601 my $count = @$args;
8140 228 50       1146 return if !$self->state_sid_exists($args->[0]);
8141              
8142             SWITCH: {
8143 228 50       687 if ($peer_id ne $self->_state_sid_route($args->[0])) {
  228         1298  
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       907 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         2220  
8160             );
8161 228         946 my $qsid = $args->[0];
8162 228         1206 my $qpeer = $self->_state_sid_name($qsid);
8163 228         1541 $self->send_event("daemon_squit", $qpeer, $args->[1]);
8164             my $quit_msg = join ' ',
8165 228         28098 $self->{state}{sids}{$qsid}{peer}, $qpeer;
8166              
8167 228 100       1248 if ($sid eq $self->{state}{sids}{$qsid}{psid}) {
8168 227         1580 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         2536 $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         8 ), qw[Notice e],
8183             );
8184             }
8185 228         1571 for my $uid ($self->_state_server_squit($qsid)) {
8186 518         2293 my $output = {
8187             prefix => $self->state_user_full($uid),
8188             command => 'QUIT',
8189             params => [$quit_msg],
8190             };
8191 518         1441 my $common = { };
8192 518         1109 for my $uchan ( keys %{ $self->{state}{uids}{$uid}{chans} } ) {
  518         3534  
8193 1988         7219 delete $self->{state}{chans}{$uchan}{users}{$uid};
8194 1988         2715 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  1988         22926  
8195 124631 100       293864 next if $user !~ m!^$sid!;
8196 5         23 $common->{$user} = $self->_state_uid_route($user);
8197             }
8198 1988 100       6966 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  1988         5582  
8199 57         543 delete $self->{state}{chans}{$uchan};
8200             }
8201             }
8202 518         3616 $self->send_output($output, values %$common);
8203             $self->send_event(
8204             "daemon_quit",
8205             $output->{prefix},
8206 518         2891 $output->{params}[0],
8207             );
8208 518         76637 my $record = delete $self->{state}{uids}{$uid};
8209 518         2467 my $nick = uc_irc $record->{nick};
8210 518         8313 delete $self->{state}{users}{$nick};
8211             # WATCH LOGOFF
8212 518 50       2057 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       2462 if ($record->{umode} =~ /o/) {
8236 215         709 $self->{state}{stats}{ops_online}--;
8237             }
8238 518 50       2041 if ($record->{umode} =~ /i/) {
8239 518         1485 $self->{state}{stats}{invisible}--;
8240             }
8241 518         8722 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         1018 };
8252             }
8253 228         1015 last SWITCH;
8254             }
8255             }
8256              
8257 228 50       1046 return @$ref if wantarray;
8258 228         1403 return $ref;
8259             }
8260              
8261             sub _daemon_peer_resv {
8262 2     2   6 my $self = shift;
8263 2   50     8 my $peer_id = shift || return;
8264 2   50     9 my $uid = shift || return;
8265 2         7 my $server = $self->server_name();
8266 2         18 my $sid = $self->server_sid();
8267 2         4 my $ref = [ ];
8268 2         8 my $args = [ @_ ];
8269 2         6 my $count = @$args;
8270              
8271             SWITCH: {
8272 2 50 33     4 if (!$count || $count < 3) {
  2         13  
8273 0         0 last SWITCH;
8274             }
8275 2         9 my ($peermask,$duration,$mask,$reason) = @$args;
8276 2 50       7 $reason = '' if !$reason;
8277 2         4 my $us = 0;
8278             {
8279 2         5 my %targpeers;
  2         5  
8280 2         5 my $sids = $self->{state}{sids};
8281 2         5 foreach my $psid ( keys %{ $sids } ) {
  2         10  
8282 8 50       29 if (matches_mask($peermask, $sids->{$psid}{name})) {
8283 8 100       342 if ($sid eq $psid) {
8284 2         5 $us = 1;
8285             }
8286             else {
8287 6         21 $targpeers{ $sids->{$psid}{route_id} }++;
8288             }
8289             }
8290             }
8291 2         6 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         27 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         9  
8304             );
8305             }
8306              
8307 2 50       21 last SWITCH if !$us;
8308              
8309 2 50       10 if ( !$reason ) {
8310 0   0     0 $reason = shift @$args || '';
8311             }
8312              
8313 2 50       10 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         9 my $full = $self->state_user_full($uid);
8323              
8324 2 50       11 last SWITCH if !$self->_state_add_drkx_line( 'resv', $full, time(), $server,
8325             $duration, $mask, $reason );
8326 2         9 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       222 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         8 $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     4 my $peer_id = shift || return;
8357 1   50     4 my $uid = shift || return;
8358 1         3 my $server = $self->server_name();
8359 1         4 my $sid = $self->server_sid();
8360 1         2 my $ref = [ ];
8361 1         4 my $args = [ @_ ];
8362 1         3 my $count = @$args;
8363              
8364              
8365             SWITCH: {
8366 1 50 33     2 if (!$count || $count < 2) {
  1         7  
8367 0         0 last SWITCH;
8368             }
8369 1         4 my ($peermask,$unmask) = @$args;
8370 1         2 my $us = 0;
8371             {
8372 1         2 my %targpeers;
  1         2  
8373 1         3 my $sids = $self->{state}{sids};
8374 1         2 foreach my $psid ( keys %{ $sids } ) {
  1         4  
8375 4 50       13 if (matches_mask($peermask, $sids->{$psid}{name})) {
8376 4 100       161 if ($sid eq $psid) {
8377 1         3 $us = 1;
8378             }
8379             else {
8380 3         10 $targpeers{ $sids->{$psid}{route_id} }++;
8381             }
8382             }
8383             }
8384 1         3 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         8 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  1         4  
8396             );
8397             }
8398              
8399 1 50       6 last SWITCH if !$us;
8400              
8401 1         18 my $result = $self->_state_del_drkx_line( 'resv', $unmask );
8402              
8403 1         3 my $full = $self->state_user_full($uid);
8404              
8405 1 50       14 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         7 "daemon_unresv",
8412             $full,
8413             $unmask,
8414             );
8415              
8416 1         109 push @$ref, {
8417             prefix => $sid,
8418             command => 'NOTICE',
8419             params => [ $uid, "RESV for [$unmask] is removed" ],
8420             };
8421              
8422 1         6 $self->_send_to_realops( "$full has removed the RESV for: [$unmask]", 'Notice', 's' );
8423              
8424             }
8425              
8426 1 50       7 return @$ref if wantarray;
8427 0         0 return $ref;
8428             }
8429              
8430             sub _daemon_peer_xline {
8431 2     2   6 my $self = shift;
8432 2   50     9 my $peer_id = shift || return;
8433 2   50     8 my $uid = shift || return;
8434 2         7 my $server = $self->server_name();
8435 2         19 my $sid = $self->server_sid();
8436 2         5 my $ref = [ ];
8437 2         7 my $args = [ @_ ];
8438 2         6 my $count = @$args;
8439              
8440             SWITCH: {
8441 2 50 33     4 if (!$count || $count < 3) {
  2         15  
8442 0         0 last SWITCH;
8443             }
8444 2         8 my ($peermask,$duration,$mask,$reason) = @$args;
8445 2 50       6 $reason = '' if !$reason;
8446 2         4 my $us = 0;
8447             {
8448 2         4 my %targpeers;
  2         4  
8449 2         6 my $sids = $self->{state}{sids};
8450 2         5 foreach my $psid ( keys %{ $sids } ) {
  2         9  
8451 8 50       28 if (matches_mask($peermask, $sids->{$psid}{name})) {
8452 8 100       374 if ($sid eq $psid) {
8453 2         7 $us = 1;
8454             }
8455             else {
8456 6         20 $targpeers{ $sids->{$psid}{route_id} }++;
8457             }
8458             }
8459             }
8460 2         6 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         17 grep { $self->_state_peer_capab($_, 'CLUSTER') } keys %targpeers,
  2         9  
8473             );
8474             }
8475              
8476 2 50       10 last SWITCH if !$us;
8477              
8478 2 50       18 if ( !$reason ) {
8479 0   0     0 $reason = shift @$args || '';
8480             }
8481              
8482 2         12 my $full = $self->state_user_full($uid);
8483              
8484 2 50       13 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         10 $self->send_event(
8489             "daemon_xline",
8490             $full,
8491             $mask,
8492             $minutes,
8493             $reason,
8494             );
8495              
8496 2 50       362 my $temp = $duration ? "temporary $minutes min. " : '';
8497              
8498 2         18 my $reply_notice = "Added ${temp}X-Line [$mask]";
8499 2         10 my $locop_notice = "$full added ${temp}X-Line for [$mask] [$reason]";
8500              
8501 2         12 push @$ref, {
8502             prefix => $sid,
8503             command => 'NOTICE',
8504             params => [ $uid, $reply_notice ],
8505             };
8506              
8507 2         11 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
8508              
8509 2         11 $self->_state_do_local_users_match_xline($mask,$reason);
8510             }
8511              
8512 2 50       17 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     5 my $peer_id = shift || return;
8519 1   50     4 my $uid = shift || return;
8520 1         3 my $server = $self->server_name();
8521 1         3 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         4 my ($peermask,$unmask) = @$args;
8532 1         2 my $us = 0;
8533             {
8534 1         2 my %targpeers;
  1         2  
8535 1         3 my $sids = $self->{state}{sids};
8536 1         2 foreach my $psid ( keys %{ $sids } ) {
  1         4  
8537 4 50       13 if (matches_mask($peermask, $sids->{$psid}{name})) {
8538 4 100       169 if ($sid eq $psid) {
8539 1         3 $us = 1;
8540             }
8541             else {
8542 3         9 $targpeers{ $sids->{$psid}{route_id} }++;
8543             }
8544             }
8545             }
8546 1         3 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       6 last SWITCH if !$us;
8562              
8563 1         5 my $result = $self->_state_del_drkx_line( 'xline', $unmask );
8564              
8565 1         4 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         6 "daemon_unxline",
8574             $full,
8575             $unmask,
8576             );
8577              
8578 1         105 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       7 return @$ref if wantarray;
8589 0         0 return $ref;
8590             }
8591              
8592             sub _daemon_peer_dline {
8593 2     2   7 my $self = shift;
8594 2   50     8 my $peer_id = shift || return;
8595 2   50     8 my $uid = shift || return;
8596 2         9 my $server = $self->server_name();
8597 2         7 my $sid = $self->server_sid();
8598 2         4 my $ref = [ ];
8599 2         6 my $args = [ @_ ];
8600 2         6 my $count = @$args;
8601              
8602             SWITCH: {
8603 2 50 33     3 if (!$count || $count < 3) {
  2         14  
8604 0         0 last SWITCH;
8605             }
8606 2         7 my ($peermask,$duration,$netmask,$reason) = @$args;
8607 2 50       5 $reason = '' if !$reason;
8608 2         4 my $us = 0;
8609             {
8610 2         4 my %targpeers;
  2         4  
8611 2         7 my $sids = $self->{state}{sids};
8612 2         4 foreach my $psid ( keys %{ $sids } ) {
  2         24  
8613 8 50       45 if (matches_mask($peermask, $sids->{$psid}{name})) {
8614 8 100       362 if ($sid eq $psid) {
8615 2         6 $us = 1;
8616             }
8617             else {
8618 6         21 $targpeers{ $sids->{$psid}{route_id} }++;
8619             }
8620             }
8621             }
8622 2         6 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         19 grep { $self->_state_peer_capab($_, 'DLN') } keys %targpeers,
  2         10  
8635             );
8636             }
8637              
8638 2 50       12 last SWITCH if !$us;
8639              
8640 2         11 $netmask = Net::CIDR::cidrvalidate($netmask);
8641              
8642 2 50       1325 last SWITCH if !$netmask;
8643              
8644 2         11 my $full = $self->state_user_full($uid);
8645              
8646 2         10 my $minutes = $duration / 60;
8647              
8648 2 50       10 last SWITCH if !$self->_state_add_drkx_line( 'dline',
8649             $full, time, $server, $duration,
8650             $netmask, $reason );
8651              
8652 2         148 $self->send_event(
8653             "daemon_dline",
8654             $full,
8655             $netmask,
8656             $minutes,
8657             $reason,
8658             );
8659              
8660 2         237 $self->add_denial( $netmask, 'You have been D-lined.' );
8661              
8662 2 50       23 my $temp = $duration ? "temporary $minutes min. " : '';
8663              
8664 2         8 my $reply_notice = "Added ${temp}D-Line [$netmask]";
8665 2         13 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         10 $self->_state_do_local_users_match_dline($netmask,$reason);
8676             }
8677              
8678 2 50       13 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     5 my $peer_id = shift || return;
8685 1   50     4 my $uid = shift || return;
8686 1         4 my $server = $self->server_name();
8687 1         3 my $sid = $self->server_sid();
8688 1         2 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         8  
8695 0         0 last SWITCH;
8696             }
8697 1         3 my ($peermask,$unmask) = @$args;
8698 1         4 my $us = 0;
8699             {
8700 1         1 my %targpeers;
  1         3  
8701 1         2 my $sids = $self->{state}{sids};
8702 1         2 foreach my $psid ( keys %{ $sids } ) {
  1         5  
8703 4 50       14 if (matches_mask($peermask, $sids->{$psid}{name})) {
8704 4 100       141 if ($sid eq $psid) {
8705 1         3 $us = 1;
8706             }
8707             else {
8708 3         9 $targpeers{ $sids->{$psid}{route_id} }++;
8709             }
8710             }
8711             }
8712 1         3 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         9 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       4 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         122 $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         6 $self->_send_to_realops( "$full has removed the D-Line for: [$unmask]", 'Notice', 's' );
8753              
8754             }
8755              
8756 1 50       8 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     8 my $peer_id = shift || return;
8763 2   50     9 my $prefix = shift || return;
8764 2         10 my $server = $self->server_name();
8765 2         6 my $ref = [ ];
8766 2         7 my $args = [ @_ ];
8767 2         5 my $count = @$args;
8768              
8769             SWITCH: {
8770 2 50       4 if (!$count) {
  2         8  
8771 0         0 last SWITCH;
8772             }
8773 2         6 my $target = $args->[0];
8774 2         4 my $us = 0;
8775 2         6 my $ucserver = uc $server;
8776 2         5 my %targets;
8777              
8778 2         5 for my $peer (keys %{ $self->{state}{peers} }) {
  2         12  
8779 8 50       29 if (matches_mask($target, $peer)) {
8780 8 100       377 if ($ucserver eq $peer) {
8781 2         7 $us = 1;
8782             }
8783             else {
8784 6         21 $targets{$self->_state_peer_route($peer)}++;
8785             }
8786             }
8787             }
8788 2         7 delete $targets{$peer_id};
8789             $self->send_output(
8790             {
8791             prefix => $prefix,
8792             command => 'ENCAP',
8793             params => $args,
8794             colonify => 1,
8795             },
8796 2         15 grep { $self->_state_peer_capab($_, 'ENCAP') } keys %targets,
  2         13  
8797             );
8798              
8799 2 50       11 last SWITCH if !$us;
8800              
8801 2   33     10 $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       222 return @$ref if wantarray;
8811 2         8 return $ref;
8812             }
8813              
8814             sub _daemon_peer_kline {
8815 2     2   7 my $self = shift;
8816 2   50     11 my $peer_id = shift || return;
8817 2   50     9 my $uid = shift || return;
8818 2         11 my $server = $self->server_name();
8819 2         8 my $ref = [ ];
8820 2         7 my $args = [ @_ ];
8821 2         6 my $count = @$args;
8822              
8823             SWITCH: {
8824 2 50 33     7 if (!$count || $count < 5) {
  2         15  
8825 0         0 last SWITCH;
8826             }
8827 2         16 my $full = $self->state_user_full($uid);
8828 2         8 my $target = $args->[0];
8829 2         5 my $us = 0;
8830 2         7 my $ucserver = uc $server;
8831 2         6 my %targets;
8832              
8833 2         5 for my $peer (keys %{ $self->{state}{peers} }) {
  2         14  
8834 8 50       35 if (matches_mask($target, $peer)) {
8835 8 100       425 if ($ucserver eq $peer) {
8836 2         9 $us = 1;
8837             }
8838             else {
8839 6         26 $targets{$self->_state_peer_route($peer)}++;
8840             }
8841             }
8842             }
8843 2         8 delete $targets{$peer_id};
8844             $self->send_output(
8845             {
8846             prefix => $uid,
8847             command => 'KLINE',
8848             params => $args,
8849             colonify => 0,
8850             },
8851 2         18 grep { $self->_state_peer_capab($_, 'KLN') } keys %targets,
  2         12  
8852             );
8853              
8854 2 50       11 last SWITCH if !$us;
8855              
8856 2 50       18 last SWITCH if !$self->_state_add_drkx_line( 'kline', $full, time(), @$args );
8857              
8858 2         23 my $minutes = $args->[1] / 60;
8859 2         7 $args->[1] = $minutes;
8860              
8861 2         14 $self->send_event("daemon_kline", $full, @$args);
8862              
8863 2 50       245 my $temp = $minutes ? "temporary $minutes min. " : '';
8864              
8865 2         12 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         14 $self->_send_to_realops( $locop_notice, 'Notice', 's' );
8876              
8877 2         17 $self->_state_do_local_users_match_kline($args->[2], $args->[3], $args->[4]);
8878             }
8879              
8880 2 50       25 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     6 my $peer_id = shift || return;
8887 1   50     4 my $uid = shift || return;
8888 1         4 my $server = $self->server_name();
8889 1         4 my $ref = [ ];
8890 1         3 my $args = [ @_ ];
8891 1         3 my $count = @$args;
8892              
8893             # :klanker UNKLINE logserv.gumbynet.org.uk * moos.loud.me.uk
8894             SWITCH: {
8895 1 50 33     3 if (!$count || $count < 3) {
  1         7  
8896 0         0 last SWITCH;
8897             }
8898 1         4 my $full = $self->state_user_full($uid);
8899 1         5 my $target = $args->[0];
8900 1         2 my $us = 0;
8901 1         3 my $ucserver = uc $server;
8902 1         2 my %targets;
8903              
8904 1         2 for my $peer (keys %{ $self->{state}{peers} }) {
  1         4  
8905 4 50       10 if (matches_mask($target, $peer)) {
8906 4 100       177 if ($ucserver eq $peer) {
8907 1         3 $us = 1;
8908             }
8909             else {
8910 3         6 $targets{$self->_state_peer_route($peer)}++;
8911             }
8912             }
8913             }
8914 1         5 delete $targets{$peer_id};
8915             $self->send_output(
8916             {
8917             prefix => $uid,
8918             command => 'UNKLINE',
8919             params => $args,
8920             colonify => 0,
8921             },
8922 1         8 grep { $self->_state_peer_capab($_, 'UNKLN') } keys %targets,
  1         4  
8923             );
8924              
8925 1 50       5 last SWITCH if !$us;
8926              
8927 1         7 my $result = $self->_state_del_drkx_line( 'kline', $args->[1], $args->[2] );
8928              
8929 1         3 my $sid = $self->server_sid();
8930              
8931 1         5 my $unmask = join '@', $args->[1], $args->[2];
8932              
8933 1 50       5 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         104 push @$ref, {
8941             prefix => $sid,
8942             command => 'NOTICE',
8943             params => [ $uid, "K-Line for [$unmask] is removed" ],
8944             };
8945              
8946 1         6 $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   886 my $self = shift;
9026 385   50     1262 my $peer_id = shift || return;
9027 385   50     1218 my $peer = shift || return;
9028 385         894 my $ref = [ ];
9029 385 100       1611 if ($self->{state}{conns}{$peer_id}{sid} eq $peer) {
9030 256         744 my $crec = $self->{state}{conns}{$peer_id};
9031             $self->_send_to_realops(
9032             sprintf(
9033             'End of burst from %s (%u seconds)',
9034 256         2201 $crec->{name}, ( time() - $crec->{conn_time} ),
9035             ),
9036             'Notice',
9037             's',
9038             );
9039             }
9040 385         2193 $self->send_event('daemon_eob', $self->{state}{sids}{$peer}{name}, $peer);
9041 385 50       48702 return @$ref if wantarray;
9042 385         972 return $ref;
9043             }
9044              
9045             sub _daemon_peer_kill {
9046 6     6   17 my $self = shift;
9047 6   50     23 my $peer_id = shift || return;
9048 6   50     24 my $killer = shift || return;
9049 6         23 my $server = $self->server_name();
9050 6         17 my $ref = [ ];
9051 6         17 my $args = [ @_ ];
9052 6         17 my $count = @$args;
9053              
9054             SWITCH: {
9055 6 50       13 if ($self->state_sid_exists($args->[0])) {
  6         28  
9056 0         0 last SWITCH;
9057             }
9058 6 50       60 if (!$self->state_uid_exists($args->[0])) {
9059 6         20 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 6 50       22 return @$ref if wantarray;
9122 6         29 return $ref;
9123             }
9124              
9125             sub _daemon_peer_svinfo {
9126 257     257   701 my $self = shift;
9127 257   50     975 my $peer_id = shift || return;
9128 257         669 my $ref = [ ];
9129 257         985 my $args = [ @_ ];
9130 257         755 my $count = @$args;
9131             # SVINFO 6 6 0 :1525185763
9132 257 100 66     1907 if ( !( $args->[0] eq '6' && $args->[1] eq '6' ) ) {
9133 1         7 $self->_terminate_conn_error($peer_id, 'Incompatible TS version');
9134 1         3 return;
9135             }
9136 256         998 $self->{state}{conns}{$peer_id}{svinfo} = $args;
9137 256 50       943 return @$ref if wantarray;
9138 256         675 return $ref;
9139             }
9140              
9141             sub _daemon_peer_ping {
9142 252     252   670 my $self = shift;
9143 252   50     1080 my $peer_id = shift || return;
9144 252         961 my $server = $self->server_name();
9145 252         861 my $sid = $self->server_sid();
9146 252         680 my $ref = [ ];
9147 252         582 my $prefix = shift;
9148 252         804 my $args = [ @_ ];
9149 252         691 my $count = @$args;
9150              
9151             SWITCH: {
9152 252 50       587 if (!$count) {
  252         1239  
9153 0         0 last SWITCH;
9154             }
9155 252 100 66     1368 if ($count >= 2 && $sid ne $args->[1]) {
9156 2 50       8 if ( $self->state_sid_exists($args->[1]) ) {
9157 2         16 $self->send_output(
9158             {
9159             prefix => $prefix,
9160             command => 'PING',
9161             params => $args,
9162             },
9163             $self->_state_sid_route($args->[1]),
9164             );
9165 2         13 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         2163 prefix => $sid,
9195             command => 'PONG',
9196             params => [$server, $args->[0]],
9197             },
9198             $peer_id,
9199             );
9200             }
9201              
9202 252 50       1330 return @$ref if wantarray;
9203 252         784 return $ref;
9204             }
9205              
9206             sub _daemon_peer_pong {
9207 3     3   13 my $self = shift;
9208 3   50     11 my $peer_id = shift || return;
9209 3         12 my $server = $self->server_name();
9210 3         11 my $sid = $self->server_sid();
9211 3         8 my $ref = [ ];
9212 3         6 my $prefix = shift;
9213 3         9 my $args = [ @_ ];
9214 3         7 my $count = @$args;
9215              
9216             SWITCH: {
9217 3 50       6 if (!$count) {
  3         10  
9218 0         0 last SWITCH;
9219             }
9220 3 50 33     18 if ($count >= 2 && uc $sid ne $args->[1]) {
9221 3 50       11 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       15 if ( $self->state_uid_exists($args->[1]) ) {
9233 3         13 my $route_id = $self->_state_uid_route($args->[1]);
9234 3 100       49 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         18 $self->send_output(
9246             {
9247             prefix => $prefix,
9248             command => 'PONG',
9249             params => $args,
9250             },
9251             $route_id,
9252             );
9253             }
9254 3         17 last SWITCH;
9255             }
9256             }
9257 0         0 delete $self->{state}{conns}{$peer_id}{pinged};
9258             }
9259              
9260 3 50       10 return @$ref if wantarray;
9261 3         10 return $ref;
9262             }
9263              
9264             sub _daemon_peer_sid {
9265 131     131   427 my $self = shift;
9266 131   50     762 my $peer_id = shift || return;
9267 131   50     757 my $prefix = shift || return;
9268 131         660 my $server = $self->server_name();
9269 131         517 my $ref = [ ];
9270 131         522 my $args = [ @_ ];
9271 131         464 my $count = @$args;
9272 131         581 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     311 if (!$count || $count < 2) {
  131         1199  
9280 0         0 last SWITCH;
9281             }
9282 131 50       1836 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       1081 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       819 if ($self->state_sid_exists($args->[2])) {
9303 1         4 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         19 $prec->{name}, $prec->{socket}[0], $args->[2],
9308             ), 'Notice', 's',
9309             );
9310 1         9 $self->_terminate_conn_error($peer_id, 'Link cancelled, server ID already exists');
9311 1         3 last SWITCH;
9312             }
9313 130 100       628 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         20 $prec->{name}, $prec->{socket}[0], $args->[0],
9319             ), 'Notice', 's',
9320             );
9321 1         9 $self->_terminate_conn_error($peer_id, 'Server exists');
9322 1         3 last SWITCH;
9323             }
9324 129   50     1404 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     1667 if ( $record->{desc} && $record->{desc} =~ m!^\(H\) ! ) {
9337 1         4 $record->{hidden} = 1;
9338 1         5 $record->{desc} =~ s!^\(H\) !!;
9339             }
9340 129         883 $self->{state}{sids}{ $prefix }{sids}{ $record->{sid} } = $record;
9341 129         478 $self->{state}{sids}{ $record->{sid} } = $record;
9342 129         524 my $uname = uc $record->{name};
9343 129 100       753 $record->{serv} = 1 if $self->{state}{services}{$uname};
9344 129         584 $self->{state}{peers}{$uname} = $record;
9345 129         691 $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       2051 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  175         1160  
9359             );
9360             $self->_send_to_realops(
9361             sprintf(
9362             'Server %s being introduced by %s',
9363             $record->{name}, $record->{peer},
9364 129         1557 ),
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         908 );
9376             $self->send_event(
9377             'daemon_server',
9378             $record->{name},
9379             $prefix,
9380             $record->{hops},
9381             $record->{desc},
9382 129         16988 );
9383             }
9384 131 50       16869 return @$ref if wantarray;
9385 131         621 return $ref;
9386             }
9387              
9388             sub _daemon_peer_quit {
9389 6     6   20 my $self = shift;
9390 6   50     82 my $uid = shift || return;
9391 6   50     26 my $qmsg = shift || 'Client Quit';
9392 6         13 my $conn_id = shift;
9393 6         16 my $ref = [ ];
9394 6         22 my $sid = $self->server_sid();
9395              
9396 6         24 my $record = delete $self->{state}{uids}{$uid};
9397 6 100       39 return $ref if !$record;
9398 3         11 my $full = $record->{full}->();
9399 3         15 my $nick = uc_irc($record->{nick});
9400 3         42 delete $self->{state}{users}{$nick};
9401 3         10 delete $self->{state}{sids}{ $record->{sid} }{users}{$nick};
9402 3         10 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       24 grep { !$conn_id || $_ ne $conn_id }
9410             $self->_state_connected_peers(),
9411 3 100       22 ) if !$record->{killed};
9412              
9413 3         19 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 3         30 $record->{auth}{realhost}, $record->{ipaddress}, $qmsg,
9424             ),
9425             'Notice', 'F',
9426             );
9427              
9428 3         13 $self->send_event("daemon_quit", $full, $qmsg);
9429              
9430             # Remove for peoples accept lists
9431             delete $self->{state}{users}{$_}{accepts}{uc_irc($nick)}
9432 3         380 for keys %{ $record->{accepts} };
  3         28  
9433              
9434             # WATCH LOGOFF
9435 3 100       15 if ( defined $self->{state}{watches}{$nick} ) {
9436 1         2 my $laston = time();
9437 1         4 $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         10 );
9456             }
9457             }
9458             # Okay, all 'local' users who share a common channel with user.
9459 3         10 my $common = { };
9460 3         6 for my $uchan (keys %{ $record->{chans} }) {
  3         12  
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 3         12 push @$ref, $common->{$_} for keys %$common;
9472 3 50       14 $self->{state}{stats}{ops_online}-- if $record->{umode} =~ /o/;
9473 3 50       19 $self->{state}{stats}{invisible}-- if $record->{umode} =~ /i/;
9474 3         13 delete $self->{state}{peers}{uc $record->{server}}{users}{$nick};
9475 3         37 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 3         6 };
9486 3 50       10 return @$ref if wantarray;
9487 3         20 return $ref;
9488             }
9489              
9490             sub _daemon_peer_uid {
9491 554     554   1186 my $self = shift;
9492 554   50     1627 my $peer_id = shift || return;
9493 554         1106 my $prefix = shift;
9494 554         1589 my $server = $self->server_name();
9495 554         1412 my $mysid = $self->server_sid();
9496 554         1258 my $ref = [ ];
9497 554         2333 my $args = [ @_ ];
9498 554         1136 my $count = @$args;
9499 554   66     1655 my $rhost = ( $self->_state_our_capab('RHOST')
9500             && $self->_state_peer_capab( $peer_id, 'RHOST') );
9501              
9502              
9503             SWITCH: {
9504 554 50 33     1199 if (!$count || $count < 9) {
  554         2738  
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       2205 if ( $self->state_nick_exists( $args->[0] ) ) {
9512 12         59 my $unick = uc_irc($args->[0]);
9513 12         167 my $exist = $self->{state}{users}{ $unick };
9514 12         71 my $userhost = ( split /!/, $self->state_user_full($args->[0]) )[1];
9515 12         47 my $incoming = join '@', @{ $args }[4..5];
  12         54  
9516             # Received TS < Existing TS
9517 12 100       80 if ( $args->[2] < $exist->{ts} ) {
9518             # If userhosts different, collide existing user
9519 6 100       31 if ( $incoming ne $userhost ) {
9520             # Send KILL for existing user UID to all servers
9521 5         20 $exist->{nick_collision} = 1;
9522 5         43 $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       53 if ( $args->[2] == $exist->{ts} ) {
9540             # Collide both
9541 1         15 $exist->{nick_collision} = 1;
9542 1         10 $self->daemon_server_kill( $exist->{uid}, 'Nick Collision', $peer_id);
9543 1         9 $self->send_output(
9544             {
9545             prefix => $mysid,
9546             command => 'KILL',
9547             params => [$args->[7+$rhost], 'Nick Collision'],
9548             },
9549             $peer_id,
9550             );
9551 1         4 last SWITCH;
9552             }
9553             # Received TS > Existing TS
9554 10 100       45 if ( $args->[2] > $exist->{ts} ) {
9555             # If userhosts same, collide existing user
9556 5 100       26 if ( $incoming eq $userhost ) {
9557             # Send KILL for existing user UID to all servers
9558 1         16 $exist->{nick_collision} = 1;
9559 1         10 $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 4         89 $self->send_output(
9565             {
9566             prefix => $mysid,
9567             command => 'KILL',
9568             params => [$args->[7+$rhost], 'Nick Collision'],
9569             },
9570             $peer_id,
9571             );
9572 4         20 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 548   50     1875 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   20990 $record->{auth}{hostname});
9604 548         3580 };
9605              
9606 548 100       1670 if ( $rhost ) {
9607 3         12 $record->{auth}{realhost} = $args->[6];
9608             }
9609             else {
9610 545         1551 $record->{auth}{realhost} = $record->{auth}{hostname};
9611             }
9612              
9613 548         1789 my $unick = uc_irc( $args->[0] );
9614              
9615 548         7458 $self->{state}{users}{ $unick } = $record;
9616 548         2112 $self->{state}{uids}{ $record->{uid} } = $record;
9617 548 100       2607 $self->{state}{stats}{ops_online}++ if $record->{umode} =~ /o/;
9618 548 50       2174 $self->{state}{stats}{invisible}++ if $record->{umode} =~ /i/;
9619 548         1790 $self->{state}{sids}{$prefix}{users}{$unick} = $record;
9620 548         1757 $self->{state}{sids}{$prefix}{uids}{ $record->{uid} } = $record;
9621 548         1934 $self->_state_update_stats();
9622              
9623 548 100       1772 if ( defined $self->{state}{watches}{$unick} ) {
9624 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         6  
9625 1 50       5 next if !defined $self->{state}{uids}{$wuid};
9626 1         4 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         9 );
9642             }
9643             }
9644              
9645             $self->send_output(
9646             {
9647             prefix => $prefix,
9648             command => 'UID',
9649             params => $args,
9650             },
9651 548         3181 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  821         3894  
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 548         5606 ),
9661             'Notice', 'F',
9662             );
9663              
9664 548         2203 $self->send_event('daemon_uid', $prefix, @$args);
9665 548   50     78394 $self->send_event('daemon_nick', @{ $args }[0..5], $record->{server}, ( $args->[9+$rhost] || '' ) );
  548         3061  
9666              
9667             }
9668              
9669 554 50       73973 return @$ref if wantarray;
9670 554         1831 return $ref;
9671             }
9672              
9673             sub _daemon_peer_nick {
9674 2     2   5 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         3 my $count = @$args;
9681 2         6 my $peer = $self->{state}{conns}{$peer_id}{name};
9682 2         6 my $nicklen = $self->server_config('NICKLEN');
9683              
9684             SWITCH: {
9685 2 50 33     3 if (!$count || $count < 2) {
  2         11  
9686 0         0 last SWITCH;
9687             }
9688 2 50       7 if ( !$self->state_uid_exists( $prefix ) ) {
9689 0         0 last SWITCH;
9690             }
9691 2         5 my $newts = $args->[1];
9692 2 50 33     6 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         5 my $new = $args->[0];
9760 2         5 my $unew = uc_irc($new);
9761 2   33     26 my $ts = $args->[1] || time;
9762 2         4 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       6 if ($unick eq $unew) {
9768 0         0 $record->{nick} = $new;
9769 0         0 $record->{ts} = $ts;
9770             }
9771             else {
9772 2         5 my $nick = $record->{nick};
9773 2         5 $record->{nick} = $new;
9774 2         4 $record->{ts} = $ts;
9775             # Remove from peoples accept lists
9776             # WATCH OFF
9777 2 100       6 if ( defined $self->{state}{watches}{$unick} ) {
9778 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         5  
9779 1 50       6 next if !defined $self->{state}{uids}{$wuid};
9780 1         2 my $wrec = $self->{state}{uids}{$wuid};
9781 1         3 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       8 if ( defined $self->{state}{watches}{$unew} ) {
9801 1         2 foreach my $wuid ( keys %{ $self->{state}{watches}{$unew}{uids} } ) {
  1         6  
9802 1 50       15 next if !defined $self->{state}{uids}{$wuid};
9803 1         4 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         11 );
9819             }
9820             }
9821             delete $self->{state}{users}{$_}{accepts}{$unick}
9822 2         5 for keys %{ $record->{accepts} };
  2         8  
9823 2         7 delete $record->{accepts};
9824 2         5 delete $self->{state}{users}{$unick};
9825 2         4 $self->{state}{users}{$unew} = $record;
9826 2         6 delete $self->{state}{sids}{$sid}{users}{$unick};
9827 2         5 $self->{state}{sids}{$sid}{users}{$unew} = $record;
9828 2 50       8 if ( $record->{umode} =~ /r/ ) {
9829 0         0 $record->{umode} =~ s/r//g;
9830             }
9831 2         24 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         3 };
9842             }
9843 2         5 my $common = { };
9844 2         4 for my $chan (keys %{ $record->{chans} }) {
  2         17  
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         5 my ($nick,$userhost) = split /!/, $full;
  2         9  
9852 2         14 $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         11 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  4         14  
9868             );
9869             $self->send_output(
9870             {
9871             prefix => $full,
9872             command => 'NICK',
9873             params => [$new],
9874             },
9875 2         11 map{ $common->{$_} } keys %{ $common },
  0         0  
  2         10  
9876             );
9877 2         25 $self->send_event("daemon_nick", $full, $new);
9878             }
9879              
9880 2 50       267 return @$ref if wantarray;
9881 2         6 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     5 my $uid = shift || return;
9888 1         4 my $chan = shift;
9889 1         4 my $ref = [ ];
9890 1         3 my $args = [ @_ ];
9891 1         3 my $count = @$args;
9892              
9893             SWITCH: {
9894 1 50       2 if (!$chan) {
  1         5  
9895 0         0 last SWITCH;
9896             }
9897 1 50       3 if (!$self->state_chan_exists($chan)) {
9898 0         0 last SWITCH;
9899             }
9900 1 50       5 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     22 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  2         22  
9910             );
9911 1   50     8 $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         16 delete $self->{state}{chans}{$uchan}{users}{$uid};
9920 1         7 delete $self->{state}{uids}{$uid}{chans}{$uchan};
9921 1 50       2 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  1         7  
9922 0         0 delete $self->{state}{chans}{$uchan};
9923             }
9924             }
9925              
9926 1 50       5 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     4 my $peer_id = shift || return;
9933 1   50     4 my $uid = shift || return;
9934 1         3 my $ref = [ ];
9935 1         3 my $args = [ @_ ];
9936 1         2 my $count = @$args;
9937              
9938             SWITCH: {
9939 1 50 33     3 if (!$count || $count < 2) {
  1         7  
9940 0         0 last SWITCH;
9941             }
9942 1         11 my $chan = (split /,/, $args->[0])[0];
9943 1         6 my $wuid = (split /,/, $args->[1])[0];
9944 1 50       4 if (!$self->state_chan_exists($chan)) {
9945 0         0 last SWITCH;
9946             }
9947 1 50       5 if ( !$self->state_uid_exists($wuid)) {
9948 0         0 last SWITCH;
9949             }
9950 1 50       5 if (!$self->state_uid_chan_member($wuid, $chan)) {
9951 0         0 last SWITCH;
9952             }
9953 1         21 my $who = $self->state_user_nick($wuid);
9954 1   33     6 my $comment = $args->[2] || $who;
9955             $self->send_output(
9956             {
9957             prefix => $uid,
9958             command => 'KICK',
9959             params => [$chan, $wuid, $comment],
9960             },
9961 1         8 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  2         8  
9962             );
9963 1         6 $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         5 my $uchan = uc_irc($chan);
9971 1         15 delete $self->{state}{chans}{$uchan}{users}{$wuid};
9972 1         4 delete $self->{state}{uids}{$wuid}{chans}{$uchan};
9973 1 50       3 if (!keys %{ $self->{state}{chans}{$uchan}{users} }) {
  1         8  
9974 0         0 delete $self->{state}{chans}{$uchan};
9975             }
9976             }
9977              
9978 1 50       4 return @$ref if wantarray;
9979 1         3 return $ref;
9980             }
9981              
9982             sub _daemon_peer_sjoin {
9983 125     125   397 my $self = shift;
9984 125         318 my $peer_id = shift;
9985 125         548 $self->_daemon_do_joins( $peer_id, 'SJOIN', @_ );
9986             }
9987              
9988             sub _daemon_peer_join {
9989 1     1   6 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   328 my $self = shift;
9996 126   50     576 my $peer_id = shift || return;
9997 126         289 my $cmd = shift;
9998 126         338 my $prefix = shift;
9999 126         300 my $ref = [ ];
10000 126         433 my $args = [ @_ ];
10001 126         330 my $count = @$args;
10002 126         418 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     253 if ($cmd eq 'SJOIN' && ( !$count || $count < 4) ) {
  126   66     1086  
10010 0         0 last SWITCH;
10011             }
10012 126 50 33     425 if ($cmd eq 'JOIN' && ( !$count || $count < 3) ) {
      66        
10013 0         0 last SWITCH;
10014             }
10015 126         324 my $ts = $args->[0];
10016 126         245 my $chan = $args->[1];
10017 126         304 my $uids;
10018 126 100       442 if ( $cmd eq 'JOIN' ) {
10019 1         3 $uids = $prefix;
10020             }
10021             else {
10022 125         233 $uids = pop @{ $args };
  125         324  
10023             }
10024 126 100       537 if (!$self->state_chan_exists($chan)) {
10025 50         1189 my $chanrec = { name => $chan, ts => $ts };
10026 50         174 my @args = @{ $args }[2..$#{ $args }];
  50         187  
  50         144  
10027 50         162 my $cmode = shift @args;
10028 50         269 $cmode =~ s/^\+//g;
10029 50         194 $chanrec->{mode} = $cmode;
10030 50         260 for my $mode (split //, $cmode) {
10031 108         188 my $arg;
10032 108 100       359 $arg = shift @args if $mode =~ /[lk]/;
10033 108 100       299 $chanrec->{climit} = $arg if $mode eq 'l';
10034 108 50       378 $chanrec->{ckey} = $arg if $mode eq 'k';
10035             }
10036 50         175 push @$args, $uids;
10037 50         257 my $uchan = uc_irc($chanrec->{name});
10038 50         1061 for my $uid (split /\s+/, $uids) {
10039 733         1339 my $umode = '';
10040 733 100       2497 $umode .= 'o' if $uid =~ s/\@//g;
10041 733 50       1500 $umode .= 'h' if $uid =~ s/\%//g;
10042 733 50       1616 $umode .= 'v' if $uid =~ s/\+//g;
10043 733         2273 $chanrec->{users}{$uid} = $umode;
10044 733         3233 $self->{state}{uids}{$uid}{chans}{$uchan} = $umode;
10045              
10046 733         2067 $self->send_event(
10047             'daemon_join',
10048             $self->state_user_full($uid),
10049             $chan,
10050             );
10051 733 100       112837 $self->send_event(
10052             'daemon_mode',
10053             $server,
10054             $chan,
10055             '+' . $umode,
10056             $self->state_user_nick($uid),
10057             ) if $umode;
10058             }
10059 50         3078 $self->{state}{chans}{$uchan} = $chanrec;
10060             $self->send_output(
10061             {
10062             prefix => $prefix,
10063             command => $cmd,
10064             params => $args,
10065             },
10066 50         484 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  57         427  
10067             );
10068 50         273 last SWITCH;
10069             }
10070              
10071             # :8H8 SJOIN 1526826863 #ooby +cmntlk 699 secret :@7UPAAAAAA
10072              
10073 76         301 my $chanrec = $self->{state}{chans}{uc_irc($chan)};
10074 76         1140 my @local_users; my @local_extjoin; my @local_nextjoin;
  76         0  
10075             {
10076 76         143 my @tmp_users =
10077 3266         6056 grep { $self->_state_is_local_uid($_) }
10078 76         171 keys %{ $chanrec->{users} };
  76         1480  
10079              
10080 0         0 @local_extjoin = map { $self->_state_uid_route($_) }
10081 76         535 grep { $self->{state}{uids}{$_}{caps}{'extended-join'} }
  24         99  
10082             @tmp_users;
10083              
10084 24         121 @local_nextjoin = map { $self->_state_uid_route($_) }
10085 76         319 grep { !$self->{state}{uids}{$_}{caps}{'extended-join'} }
  24         96  
10086             @tmp_users;
10087              
10088 76         236 @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       596 if ( $ts < $chanrec->{ts} ) {
    100          
10098 4         11 my @deop;
10099             my @deop_list;
10100 4         10 my $common = { };
10101              
10102             # Remove all +ovh
10103 4         12 for my $user (keys %{ $chanrec->{users} }) {
  4         28  
10104 7 100       25 $common->{$user} = $self->_state_uid_route($user)
10105             if $self->_state_is_local_uid($user);
10106 7 100       33 next if !$chanrec->{users}{$user};
10107 4         12 my $current = $chanrec->{users}{$user};
10108 4         16 my $proper = $self->state_user_nick($user);
10109 4         12 $chanrec->{users}{$user} = '';
10110 4         24 $self->{state}{uids}{$user}{chans}{uc_irc($chanrec->{name})} = '';
10111 4         87 push @deop, "-$current";
10112 4         40 push @deop_list, $proper for split //, $current;
10113             }
10114              
10115 4 50 33     34 if (keys %$common && @deop) {
10116             $self->send_event(
10117             "daemon_mode",
10118             $server,
10119             $chanrec->{name},
10120 4         30 unparse_mode_line(join '', @deop),
10121             @deop_list,
10122             );
10123 4         633 my @output_modes;
10124 4         24 my $length = length($server) + 4
10125             + length($chan) + 4;
10126 4         17 my @buffer = ('', '');
10127 4         13 for my $deop (@deop) {
10128 4         12 my $arg = shift @deop_list;
10129 4         31 my $mode_line = unparse_mode_line($buffer[0].$deop);
10130 4 50       124 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         33 $buffer[0] = $mode_line;
10148 4 50       19 if ($buffer[1]) {
10149 0         0 $buffer[1] = join ' ', $buffer[1], $arg;
10150             }
10151             else {
10152 4         13 $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         52 $buffer[0],
10162             split /\s+/, $buffer[1],
10163             ],
10164             };
10165             $self->send_output($_, values %$common)
10166 4         32 for @output_modes;
10167             }
10168              
10169             # Remove all +beI modes
10170 4 50       24 if ( $cmd eq 'SJOIN' ) {
10171 4         21 my $tmap = { bans => 'b', excepts => 'e', invex => 'I' };
10172 4         20 my @types; my @mask_list;
10173 4         17 foreach my $type ( qw[bans excepts invex] ) {
10174 12 100       55 next if !$chanrec->{$type};
10175 9         15 foreach my $umask ( keys %{ $chanrec->{$type} } ) {
  9         27  
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     581 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       19 if ( $chanrec->{topic} ) {
10238 1         4 delete $chanrec->{topic};
10239 1         7 $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         52 . " to $ts",
10258             ],
10259             },
10260             @local_users,
10261             );
10262 4         16 $chanrec->{ts} = $ts;
10263             # Remove invites
10264 4   50     43 my $invites = delete $chanrec->{invites} || {};
10265 4         12 foreach my $invite ( keys %{ $invites } ) {
  4         18  
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         12 my $origmode = $chanrec->{mode};
10272 4         13 my @args = @{ $args }[2..$#{ $args }];
  4         14  
  4         21  
10273 4         22 my $chanmode = shift @args;
10274 4         10 my $reply = '';
10275 4         9 my @reply_args;
10276 4         19 for my $mode (grep { $_ ne '+' } split //, $chanmode) {
  12         34  
10277 8         27 my $arg;
10278 8 50       31 $arg = shift @args if $mode =~ /[lk]/;
10279 8 50 0     186 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     29 $origmode = join '', grep { $chanmode !~ /$_/ }
  8         99  
10308             split //, ($origmode || '');
10309 4 50       47 $chanrec->{mode} =~ s/[$origmode]//g if $origmode;
10310 4 50       138 $reply = '-' . $origmode . $reply if $origmode;
10311 4 50 33     27 if ($origmode && $origmode =~ /k/) {
10312 0         0 unshift @reply_args, '*';
10313 0         0 delete $chanrec->{ckey};
10314             }
10315 4 50 33     37 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       43 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         223 my $origmode = $chanrec->{mode};
10341 67         329 my @args = @{ $args }[2..$#{ $args }];
  67         224  
  67         217  
10342 67         181 my $chanmode = shift @args;
10343 67         140 my $reply = '';
10344 67         197 my @reply_args;
10345 67         280 for my $mode (grep { $_ ne '+' } split //, $chanmode) {
  206         781  
10346 139         277 my $arg;
10347 139 100       462 $arg = shift @args if $mode =~ /[lk]/;
10348 139 50 33     3023 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       301 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         34 $uids = join ' ', map { my $s = $_; $s =~ s/[@%+]//g; $s; }
  5         13  
  5         28  
  5         24  
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         784 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  130         713  
10407             );
10408             # Joins and modes for new arrivals
10409 76         438 my $uchan = uc_irc($chanrec->{name});
10410 76         1181 my $modes;
10411             my @aways;
10412 76         0 my @mode_parms;
10413 76         911 for my $uid (split /\s+/, $uids) {
10414 1273         2154 my $umode = '';
10415 1273         1915 my @op_list;
10416 1273 100       3525 $umode .= 'o' if $uid =~ s/\@//g;
10417 1273 50       2863 $umode .= 'h' if $uid =~ s/\%//g;
10418 1273 50       2790 $umode .= 'v' if $uid =~ s/\+//g;
10419 1273 100       3650 next if !defined $self->{state}{uids}{$uid};
10420 1257         3805 $chanrec->{users}{$uid} = $umode;
10421 1257         4543 $self->{state}{uids}{$uid}{chans}{$uchan} = $umode;
10422 1257         3217 push @op_list, $self->state_user_nick($uid) for split //, $umode;
10423 1257         2971 my $full = $self->state_user_full($uid);
10424 1257 100       3347 if ( @local_nextjoin ) {
10425             my $output = {
10426             prefix => $full,
10427             command => 'JOIN',
10428 20         125 params => [$chanrec->{name}],
10429             };
10430 20         104 $self->send_output($output, @local_nextjoin);
10431             }
10432 1257 50       2592 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 1257         4557 );
10449 1257 100       195647 if ($umode) {
10450 17         44 $modes .= $umode;
10451 17         72 push @mode_parms, @op_list;
10452             }
10453 1257 100       4672 if ( $self->{state}{uids}{$uid}{away} ) {
10454 2         14 push @aways, { uid => $uid, msg => $self->{state}{uids}{$uid}{away} };
10455             }
10456             }
10457 76 100       467 if ($modes) {
10458             $self->send_event(
10459             "daemon_mode",
10460             $server,
10461             $chanrec->{name},
10462 17         131 '+' . $modes,
10463             @mode_parms,
10464             );
10465 17         2126 my @output_modes;
10466 17         76 my $length = length($server) + 4 + length($chan) + 4;
10467 17         58 my @buffer = ('+', '');
10468 17         72 for my $umode (split //, $modes) {
10469 17         66 my $arg = shift @mode_parms;
10470 17 50       106 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 17         71 $buffer[0] .= $umode;
10487 17 50       92 if ($buffer[1]) {
10488 0         0 $buffer[1] = join ' ', $buffer[1], $arg;
10489             }
10490             else {
10491 17         57 $buffer[1] = $arg;
10492             }
10493             }
10494             push @output_modes, {
10495             prefix => $server,
10496             command => 'MODE',
10497             colonify => 0,
10498             params => [
10499             $chanrec->{name},
10500 17         214 $buffer[0],
10501             split /\s+/,
10502             $buffer[1],
10503             ],
10504             };
10505             $self->send_output($_, @local_users)
10506 17         143 for @output_modes;
10507             }
10508 76 100       352 if ( @aways ) {
10509             $self->_state_do_away_notify($_->{uid},$chanrec->{name},$_->{msg})
10510 2         22 for @aways;
10511             }
10512             }
10513              
10514 126 50       458 return @$ref if wantarray;
10515 126         597 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   132 my $self = shift;
10751 72   50     203 my $peer_id = shift || return;
10752 72   50     171 my $prefix = shift || return;
10753 72         137 my $ref = [ ];
10754 72         201 my $args = [ @_ ];
10755 72         137 my $count = scalar @$args;
10756 72         272 my %map = qw(b bans e excepts I invex);
10757              
10758             SWITCH: {
10759 72 50 33     121 if ( !$count || $count < 4 ) {
  72         294  
10760 0         0 last SWITCH;
10761             }
10762 72         181 my ($ts,$chan,$trype,$masks) = @$args;
10763 72 50       213 if ( !$self->state_chan_exists($chan) ) {
10764 0         0 last SWITCH;
10765             }
10766 72         182 my $chanrec = $self->{state}{chans}{uc_irc($chan)};
10767             # Simple TS rules apply
10768 72 100       925 if ( $ts > $chanrec->{ts} ) {
10769             # Drop MODE
10770 6         14 last SWITCH;
10771             }
10772             $self->send_output(
10773             {
10774             prefix => $prefix,
10775             command => 'BMASK',
10776             params => $args,
10777             },
10778 66         674 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  102         389  
10779             );
10780 66         269 my $mode_u_set = ( $chanrec->{mode} =~ /u/ );
10781 66         162 my $sid = $self->server_sid();
10782 66         140 my $server = $self->server_name();
10783 72         196 my @local_users = map { $self->_state_uid_route( $_ ) }
10784 72 50       246 grep { !$mode_u_set || $chanrec->{users}{$_} =~ /[oh]/ }
10785 66         115 grep { $_ =~ m!^$sid! } keys %{ $chanrec->{users} };
  174         694  
  66         183  
10786 66         614 my @mask_list = split m!\s+!, $masks;
10787 66         121 my @marsk_list;
10788 66         138 foreach my $marsk ( @mask_list ) {
10789 636         1600 my $mask = normalize_mask($marsk);
10790 636         14589 my $umask = uc_irc($mask);
10791 636 100       7781 next if $chanrec->{ $map{ $trype } }{$umask};
10792 309         982 $chanrec->{ $map{ $trype } }{$umask} =
10793             [ $mask, $server, time() ];
10794 309         732 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     296 if ( !@local_users || !@marsk_list ) {
10799 33         107 last SWITCH;
10800             }
10801 33         67 my @types;
10802 33         219 push @types, "+$trype" for @marsk_list;
10803 33         58 my @output_modes;
10804 33         71 my $length = length($server) + 4
10805             + length($chan) + 4;
10806 33         95 my @buffer = ('', '');
10807 33         67 for my $type (@types) {
10808 309         536 my $arg = shift @marsk_list;
10809 309         874 my $mode_line = unparse_mode_line($buffer[0].$type);
10810 309 100       12421 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 13         183 $buffer[0],
10819             split /\s+/,
10820             $buffer[1],
10821             ],
10822             };
10823 13         35 $buffer[0] = $type;
10824 13         26 $buffer[1] = $arg;
10825 13         29 next;
10826             }
10827 296         533 $buffer[0] = $mode_line;
10828 296 100       520 if ($buffer[1]) {
10829 263         715 $buffer[1] = join ' ', $buffer[1], $arg;
10830             }
10831             else {
10832 33         69 $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         329 $buffer[0],
10842             split /\s+/, $buffer[1],
10843             ],
10844             };
10845             $self->send_output($_, @local_users)
10846 33         176 for @output_modes;
10847             }
10848              
10849 72 50       191 return @$ref if wantarray;
10850 72         240 return $ref;
10851             }
10852              
10853             sub _daemon_peer_tburst {
10854 10     10   31 my $self = shift;
10855 10   50     39 my $peer_id = shift || return;
10856 10   50     34 my $prefix = shift || return;
10857 10         34 my $ref = [ ];
10858 10         39 my $args = [ @_ ];
10859 10         22 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       38 if ( !$self->state_chan_exists( $args->[1] ) ) {
  10         47  
10865 0         0 last SWITCH;
10866             }
10867 10         44 my ($chants,$chan,$topicts,$who,$what) = @$args;
10868 10         17 my $accept;
10869 10         35 my $uchan = uc_irc $chan;
10870 10         137 my $chanrec = $self->{state}{chans}{$uchan};
10871 10 50       87 if ( $chants < $chanrec->{ts} ) {
    50          
10872 0         0 $accept = 1;
10873             }
10874             elsif ( $chants == $chanrec->{ts} ) {
10875 10 100       87 if ( !$chanrec->{topic} ) {
    50          
10876 6         16 $accept = 1;
10877             }
10878             elsif ( $topicts > $chanrec->{topic}[2] ) {
10879 0         0 $accept = 1;
10880             }
10881             }
10882 10 100       33 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         48 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  6         47  
10893             );
10894 6   33     43 my $differing = ( !$chanrec->{topic} || $chanrec->{topic}[0] ne $what );
10895 6         30 $chanrec->{topic} = [ $what, $who, $topicts ];
10896 6 50       24 if ( !$differing ) {
10897 0         0 last SWITCH;
10898             }
10899 6   33     42 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         62 $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       41 return @$ref if wantarray;
10912 10         28 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   16 my $self = shift;
10962 7   50     32 my $peer_id = shift || return;
10963 7   50     24 my $uid = shift || return;
10964 7   50     27 my $type = shift || return;
10965 7         17 my $ref = [ ];
10966 7         20 my $args = [ @_ ];
10967 7         17 my $count = @$args;
10968              
10969             SWITCH: {
10970 7         12 my $nick = $self->state_user_nick($uid);
  7         28  
10971 7 50       24 if (!$count) {
10972 0         0 push @$ref, ['461', $type];
10973 0         0 last SWITCH;
10974             }
10975 7 50 33     73 if ($count < 2 || !$args->[1]) {
10976 0         0 push @$ref, ['412'];
10977 0         0 last SWITCH;
10978             }
10979 7         24 my $targets = 0;
10980 7         25 my $max_targets = $self->server_config('MAXTARGETS');
10981 7         23 my $full = $self->state_user_full($uid);
10982 7         38 my $targs = $self->_state_parse_msg_targets($args->[0]);
10983              
10984 7         39 LOOP: for my $target (keys %$targs) {
10985 7         15 my $targ_type = shift @{ $targs->{$target} };
  7         19  
10986 7 50 66     47 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     38 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     41 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     27 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     27 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     27 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     33 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       45 if ($targ_type eq 'uid') {
11022 4         18 $target = $self->state_user_nick($target);
11023             }
11024 7 50 33     51 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         15 $targets++;
11030 7 50       21 if ($targets > $max_targets) {
11031 0         0 push @$ref, ['407', $target];
11032 0         0 last SWITCH;
11033             }
11034             # $$whatever
11035 7 100       35 if ($targ_type eq 'servermask') {
11036 1         2 my $us = 0;
11037 1         2 my %targets;
11038 1         5 my $ucserver = uc $self->server_name();
11039 1         2 for my $peer (keys %{ $self->{state}{peers} }) {
  1         6  
11040 4 100       101 if (matches_mask($targs->{$target}[0], $peer)) {
11041 1 50       69 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         33 delete $targets{$peer_id};
11050 1         12 $self->send_output(
11051             {
11052             prefix => $uid,
11053             command => $type,
11054             params => [$target, $args->[1]],
11055             },
11056             keys %targets,
11057             );
11058 1 50       6 if ($us) {
11059 1         4 my $local = $self->{state}{peers}{uc $self->server_name()}{users};
11060 1         3 my @local;
11061 1         2 my $spoofed = 0;
11062 1         5 for my $luser (values %$local) {
11063 3 50       11 if ($luser->{route_id} eq 'spoofed') {
11064 0         0 $spoofed = 1;
11065             }
11066             else {
11067 3         72 push @local, $luser->{route_id};
11068             }
11069             }
11070             $self->send_output(
11071             {
11072 1         14 prefix => $full,
11073             command => $type,
11074             params => [$target, $args->[1]],
11075             },
11076             @local,
11077             );
11078 1 50       6 $self->send_event(
11079             "daemon_" . lc $type,
11080             $full,
11081             $target,
11082             $args->[1],
11083             ) if $spoofed;
11084             }
11085 1         7 next LOOP;
11086             }
11087             # $#whatever
11088 6 100       33 if ($targ_type eq 'hostmask') {
11089 1         3 my $spoofed = 0;
11090 1         4 my %targets;
11091             my @local;
11092 1         3 HOST: for my $luser (values %{ $self->{state}{users} }) {
  1         6  
11093             next HOST if !matches_mask(
11094 6 100       111 $targs->{$target}[0], $luser->{auth}{hostname});
11095 3 50       109 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         8 push @local, $luser->{route_id};
11103             }
11104             }
11105 1         3 delete $targets{$peer_id};
11106 1         12 $self->send_output(
11107             {
11108             prefix => $uid,
11109             command => $type,
11110             params => [$target, $args->[1]],
11111             },
11112             keys %targets,
11113             );
11114 1         9 $self->send_output(
11115             {
11116             prefix => $full,
11117             command => $type,
11118             params => [$target, $args->[1]],
11119             },
11120             @local,
11121             );
11122 1 50       5 $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         14 my $channel;
11197             my $status_msg;
11198 5 100       21 if ($targ_type eq 'channel') {
11199 1         6 $channel = $self->_state_chan_name($target);
11200             }
11201 5 50       28 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     21 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     38 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     33 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     27 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     27 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     24 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     20 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     41 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       19 if ($channel) {
11246 1         3 my $common = { };
11247 1 50       8 my $msg = {
11248             command => $type,
11249             params => [
11250             ($status_msg ? $target : $channel),
11251             $args->[1],
11252             ],
11253             };
11254 1         6 for my $member ($self->state_chan_list($channel, $status_msg)) {
11255 4 50       11 next if $self->_state_user_is_deaf($member);
11256 4         66 $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       13 if ($self->_connection_is_client($route_id)) {
11262 3         8 $msg->{prefix} = $full;
11263             }
11264 3 50       10 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         15 my $server = $self->server_name();
11282 4 50       12 if ($self->state_nick_exists($target)) {
11283 4         14 $target = $self->state_user_nick($target);
11284 4 50       55 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         59 my $targ_umode = $self->state_user_umode($target);
11292             # Target user has CALLERID on
11293 4 50 33     100 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         57 my $msg = {
11340             prefix => $uid,
11341             command => $type,
11342             params => [$target, $args->[1]],
11343             };
11344 4         14 my $route_id = $self->_state_user_route($target);
11345 4 50       30 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       15 if ($self->_connection_is_client($route_id)) {
11356 4         11 $msg->{prefix} = $full;
11357             }
11358 4         19 $self->send_output($msg, $route_id);
11359             }
11360 4         27 next LOOP;
11361             }
11362             }
11363             }
11364              
11365 7 50       40 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     6 my $peer_id = shift || return;
11419 1   50     4 my $uid = shift || return;
11420 1         3 my $server = $self->server_name();
11421 1         3 my $ref = [ ];
11422 1         3 my $args = [ @_ ];
11423 1         2 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         4 $chan = $self->_state_chan_name($chan);
11432 1         13 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         4 my $route_id = $self->_state_uid_route($who);
11438 1         7 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       6 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         6 $self->send_output( $output, $route_id );
11453             }
11454             }
11455 1 50 33     10 if ( $chanrec->{mode} && $chanrec->{mode} =~ m!i! ) {
11456 1         5 $chanrec->{invites}{$who} = time;
11457             # Send NOTICE to +oh local channel members
11458             # ":%s NOTICE %%%s :%s is inviting %s to %s."
11459 1         6 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         6 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         4 $self->_send_output_channel_local($chan,$notice,'','oh','','invite-notify');
11479 1         4 $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   31 my $self = shift;
11499 10   50     44 my $peer_id = shift || return;
11500 10   50     63 my $uid = shift || return;
11501 10         44 my $msg = shift;
11502 10         40 my $server = $self->server_name();
11503 10         41 my $ref = [ ];
11504              
11505             SWITCH: {
11506 10         31 my $rec = $self->{state}{uids}{$uid};
  10         41  
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         34 $rec->{away} = $msg;
11520              
11521             $self->send_output(
11522             {
11523             prefix => $uid,
11524             command => 'AWAY',
11525             params => [$msg],
11526             },
11527 10         94 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  11         73  
11528             );
11529 10         94 $self->_state_do_away_notify($uid,'*',$msg);
11530             }
11531              
11532 10 50       54 return @$ref if wantarray;
11533 10         63 return $ref;
11534             }
11535              
11536             sub _daemon_peer_links {
11537 1     1   3 my $self = shift;
11538 1   50     4 my $peer_id = shift || return;
11539 1   50     4 my $uid = shift || return;
11540 1         3 my $server = $self->server_name();
11541 1         3 my $sid = $self->server_sid();
11542 1         3 my $ref = [ ];
11543 1         3 my $args = [ @_ ];
11544 1         3 my $count = @$args;
11545              
11546             SWITCH: {
11547 1 50 33     1 if (!$count || $count < 2) {
  1         7  
11548 0         0 last SWITCH;
11549             }
11550 1         5 my ($target,$mask) = @$args;
11551 1 50       3 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         4 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         4 ), qw[Notice y],
11568             );
11569 1         2 push @$ref, $_ for
11570 1         5 @{ $self->_daemon_do_links($uid,$sid,$mask ) };
11571             }
11572              
11573 1 50       25 return @$ref if wantarray;
11574 0         0 return $ref;
11575             }
11576              
11577             sub _daemon_peer_svsjoin {
11578 6     6   18 my $self = shift;
11579 6   50     38 my $peer_id = shift || return;
11580 6   50     24 my $prefix = shift || return;
11581 6         21 my $sid = $self->server_sid();
11582 6         17 my $ref = [ ];
11583 6         18 my $args = [ @_ ];
11584 6         16 my $count = @$args;
11585              
11586             SWITCH: {
11587 6 50 66     13 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  6         29  
11588 0         0 last SWITCH;
11589             }
11590 6 50 33     43 if (!$count || $count < 2) {
11591 0         0 last SWITCH;
11592             }
11593 6         17 my $client = shift @$args;
11594 6         34 my $uid = $self->state_user_uid($client);
11595 6 50       86 last SWITCH if !$uid;
11596 6 50       118 if ( $uid =~ m!^$sid! ) {
11597 6         26 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       42 ) 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       37 return @$ref if wantarray;
11623 6         25 return $ref;
11624             }
11625              
11626             sub _daemon_peer_svspart {
11627 1     1   4 my $self = shift;
11628 1   50     6 my $peer_id = shift || return;
11629 1   50     3 my $prefix = shift || return;
11630 1         5 my $sid = $self->server_sid();
11631 1         4 my $ref = [ ];
11632 1         3 my $args = [ @_ ];
11633 1         3 my $count = @$args;
11634              
11635             SWITCH: {
11636 1 50 33     2 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  1         5  
11637 0         0 last SWITCH;
11638             }
11639 1 50 33     15 if (!$count || $count < 2) {
11640 0         0 last SWITCH;
11641             }
11642 1         5 my $client = shift @$args;
11643 1         15 my $uid = $self->state_user_uid($client);
11644 1 50       6 last SWITCH if !$uid;
11645 1 50       18 if ( $uid =~ m!^$sid! ) {
11646 1         4 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       8 ) for $self->_daemon_cmd_part($rec->{nick}, @$args);
11651 1         3 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       12 return @$ref if wantarray;
11672 1         5 return $ref;
11673             }
11674              
11675             sub _daemon_peer_svshost {
11676 2     2   7 my $self = shift;
11677 2   50     11 my $peer_id = shift || return;
11678 2   50     11 my $prefix = shift || return;
11679 2         9 my $sid = $self->server_sid();
11680 2         6 my $ref = [ ];
11681 2         9 my $args = [ @_ ];
11682 2         7 my $count = @$args;
11683              
11684             # :9T9 SVSHOST 7UPAAAABO 1529239224 fake.host.name
11685             SWITCH: {
11686 2 50 33     4 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  2         13  
11687 0         0 last SWITCH;
11688             }
11689 2 50 33     18 if (!$count || $count < 3) {
11690 0         0 last SWITCH;
11691             }
11692 2         23 my $client = shift @$args;
11693 2         14 my $uid = $self->state_user_uid($client);
11694 2 50       9 last SWITCH if !$uid;
11695 2 50       15 last SWITCH if $args->[0] !~ m!^\d+$!;
11696 2 50       13 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
11697 2 50       21 if ($args->[1] =~ $host_re) {
11698 2         13 $self->_state_do_change_hostmask($uid, $args->[1]);
11699             }
11700 2         12 unshift @$args, $uid;
11701             $self->send_output(
11702             {
11703             prefix => $prefix,
11704             command => 'SVSHOST',
11705             params => $args,
11706             colonify => 0,
11707             },
11708 2         18 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  4         30  
11709             );
11710             }
11711              
11712 2 50       12 return @$ref if wantarray;
11713 2         6 return $ref;
11714             }
11715              
11716             sub _daemon_peer_svsmode {
11717 31     31   95 my $self = shift;
11718 31   50     140 my $peer_id = shift || return;
11719 31   50     119 my $prefix = shift || return;
11720 31         109 my $sid = $self->server_sid();
11721 31         96 my $ref = [ ];
11722 31         146 my $args = [ @_ ];
11723 31         96 my $count = @$args;
11724              
11725             # :9T9 SVSMODE 7UPAAAABO 1529239224 + extra_arg
11726             SWITCH: {
11727 31 50 33     78 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  31         173  
11728 0         0 last SWITCH;
11729             }
11730 31 50 33     293 if (!$count || $count < 3) {
11731 0         0 last SWITCH;
11732             }
11733 31         93 my $client = shift @$args;
11734 31         205 my $uid = $self->state_user_uid($client);
11735 31 50       121 last SWITCH if !$uid;
11736 31 50       252 last SWITCH if $args->[0] !~ m!^\d+$!;
11737 31 50       279 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
11738 31         108 my $rec = $self->{state}{uids}{$uid};
11739 31         493 my $local = ( $uid =~ m!^$sid! );
11740 31 50       161 $local = $rec->{route_id} if $local;
11741 31 50       148 my $extra_arg = ( $count >= 4 ? $args->[2] : '' );
11742 31         183 my $umode = unparse_mode_line($args->[1]);
11743 31         1137 my $parsed_mode = parse_mode_line($umode);
11744 31         1919 my $previous = $rec->{umode};
11745 31         87 MODE: while (my $mode = shift @{ $parsed_mode->{modes} }) {
  90         360  
11746 59 50       225 next MODE if $mode eq '+o';
11747 59         223 my ($action, $char) = split //, $mode;
11748 59 50       241 next MODE if $char =~ m![SW]!;
11749 59 100 66     315 if ($action eq '+' && $char eq 'x') {
11750 3 50 33     39 if ($extra_arg && $extra_arg =~ $host_re) {
11751 3         23 $self->_state_do_change_hostmask($uid, $extra_arg);
11752             }
11753 3         13 next MODE;
11754             }
11755 56 100 66     282 if ($action eq '+' && $char eq 'd') {
11756 28 50       110 if ($extra_arg) {
11757 28         98 $rec->{account} = $extra_arg;
11758 28         71 foreach my $chan ( keys %{ $rec->{chans} } ) {
  28         134  
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         18 '',
11769             'account-notify',
11770             );
11771             }
11772             }
11773 28         120 next MODE;
11774             }
11775 28 50 33     418 if ($action eq '+' && $rec->{umode} !~ /$char/) {
11776 28         106 $rec->{umode} .= $char;
11777 28 50       111 if ($char eq 'i') {
11778 0         0 $self->{state}{stats}{invisible}++;
11779             }
11780 28 50 33     170 if ($char eq 'w' && $local ) {
11781 0         0 $self->{state}{wallops}{$local} = time;
11782             }
11783 28 50 33     141 if ($char eq 'l' && $local ) {
11784 0         0 $self->{state}{locops}{$local} = time;
11785             }
11786             }
11787 28 50 33     148 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         287 $rec->{umode} = join '', sort split //, $rec->{umode};
11808 31         142 unshift @$args, $uid;
11809             $self->send_output(
11810             {
11811             prefix => $prefix,
11812             command => 'SVSMODE',
11813             params => $args,
11814             colonify => 0,
11815             },
11816 31         274 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  62         289  
11817             );
11818 31 50       190 last SWITCH if !$local;
11819 31         200 my $set = gen_mode_change($previous, $rec->{umode});
11820 31 100       2238 if ($set) {
11821 28         117 my $full = $rec->{full}->();
11822             $self->send_output(
11823             {
11824             prefix => $full,
11825             command => 'MODE',
11826 28         281 params => [$rec->{nick}, $set],
11827             },
11828             $local
11829             );
11830 28         187 $self->send_event(
11831             "daemon_umode",
11832             $full,
11833             $set,
11834             );
11835             }
11836             }
11837              
11838 31 50       3673 return @$ref if wantarray;
11839 31         105 return $ref;
11840             }
11841              
11842             sub _daemon_peer_svsnick {
11843 3     3   11 my $self = shift;
11844 3   50     16 my $peer_id = shift || return;
11845 3   50     12 my $prefix = shift || return;
11846 3         13 my $sid = $self->server_sid();
11847 3         9 my $ref = [ ];
11848 3         10 my $args = [ @_ ];
11849 3         8 my $count = @$args;
11850              
11851             SWITCH: {
11852 3 50 33     11 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  3         22  
11853 0         0 last SWITCH;
11854             }
11855 3 50       13 if (!$count) {
11856 0         0 last SWITCH;
11857             }
11858 3 50       16 my $newnick = ( $count == 4 ? $args->[2] : $args->[1] );
11859 3 50       20 last SWITCH if !is_valid_nick_name($newnick); # maybe check nicklen too
11860 3         64 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         8 my $ts = 0; my $newts = 0;
  3         7  
11864 3 50       28 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         10 $ts = $args->[2];
11870             }
11871 3 50       16 if ( $count == 3 ) {
11872 3         12 $newts = $ts;
11873             }
11874             else {
11875 0         0 $newts = $args->[3];
11876             }
11877 3 50       87 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         23 my $full = $rec->{full}->();
11898 3         10 my $nick = $rec->{nick};
11899 3         14 my $unick = uc_irc $nick;
11900 3         65 my $unew = uc_irc $newnick;
11901 3         52 my $server = uc $self->server_name();
11902              
11903 3 100       13 if ( $self->state_nick_exists($newnick) ) {
11904 2 100       11 if ( defined $self->{state}{users}{$unew} ) {
11905 1         3 my $exist = $self->{state}{users}{$unew};
11906 1 50       5 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         7 '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         7 my $common;
11927 2         5 for my $chan (keys %{ $rec->{chans} }) {
  2         11  
11928 1         3 for my $user ( keys %{ $self->{state}{chans}{$chan}{users} } ) {
  1         5  
11929 3 50       20 next if $user !~ m!^$sid!;
11930 3         8 $common->{$user} = $self->_state_uid_route($user);
11931             }
11932             }
11933              
11934 2 50       10 if ($unick eq $unew) {
11935 0         0 $rec->{nick} = $newnick;
11936 0         0 $rec->{ts} = $newts;
11937             }
11938             else {
11939 2         8 $rec->{nick} = $newnick;
11940 2         7 $rec->{ts} = $newts;
11941             # WATCH ON/OFF
11942 2 50       10 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         9  
11988 0         0 delete $self->{state}{users}{$_}{accepts}{$unick};
11989             }
11990 2         10 delete $rec->{accepts};
11991 2         6 delete $self->{state}{users}{$unick};
11992 2         52 $self->{state}{users}{$unew} = $rec;
11993 2         13 delete $self->{state}{peers}{$server}{users}{$unick};
11994 2         7 $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         12 );
12008             }
12009 2         39 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         61 $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         20 params => [$newnick, $rec->{ts}],
12036             },
12037             $self->_state_connected_peers(),
12038             );
12039              
12040 2         16 $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         274 $rec->{route_id}, values %$common,
12049             );
12050             }
12051              
12052 3 50       16 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     5 my $peer_id = shift || return;
12059 1   50     4 my $prefix = shift || return;
12060 1         4 my $sid = $self->server_sid();
12061 1         3 my $ref = [ ];
12062 1         4 my $args = [ @_ ];
12063 1         2 my $count = @$args;
12064              
12065             SWITCH: {
12066 1 50 33     2 if (!$self->_state_sid_serv($prefix) && $prefix ne $sid) {
  1         5  
12067 0         0 last SWITCH;
12068             }
12069 1 50 33     8 if (!$count || $count < 2) {
12070 0         0 last SWITCH;
12071             }
12072 1         3 my $client = shift @$args;
12073 1         6 my $uid = $self->state_user_uid($client);
12074 1 50       3 last SWITCH if !$uid;
12075 1 50       7 last SWITCH if $args->[0] !~ m!^\d+$!;
12076 1 50       7 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
12077 1 50       29 if ( $uid =~ m!^$sid! ) {
12078 1         6 my $rec = $self->{state}{uids}{$uid};
12079 1         3 my $reason = 'SVSKilled: ';
12080 1 50       3 if ( $count == 3 ) {
12081 1         4 $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         2 return $ref;
12112             }
12113              
12114             sub _daemon_peer_svstag {
12115 3     3   7 my $self = shift;
12116 3   50     23 my $peer_id = shift || return;
12117 3   50     14 my $prefix = shift || return;
12118 3         10 my $sid = $self->server_sid();
12119 3         8 my $ref = [ ];
12120 3         9 my $args = [ @_ ];
12121 3         8 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         14  
12131 0         0 last SWITCH;
12132             }
12133 3 50 33     27 if (!$count || $count < 2) {
12134 0         0 last SWITCH;
12135             }
12136 3         15 my $client = shift @$args;
12137 3         16 my $uid = $self->state_user_uid($client);
12138 3 50       42 last SWITCH if !$uid;
12139 3 50       42 last SWITCH if $args->[0] !~ m!^\d+$!;
12140 3 50       21 last SWITCH if $args->[0] != $self->{state}{uids}{$uid}{ts};
12141 3         8 my $rec = $self->{state}{uids}{$uid};
12142 3 50       11 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     24 last SWITCH if $count < 5 || !$args->[3];
12159 3         22 $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         24 grep { $_ ne $peer_id } $self->_state_connected_peers(),
  4         18  
12177             );
12178             }
12179              
12180 3 50       24 return @$ref if wantarray;
12181 3         11 return $ref;
12182             }
12183              
12184             sub _state_create {
12185 184     184   603 my $self = shift;
12186              
12187 184         1024 $self->_state_delete();
12188              
12189             # Connection specific tables
12190 184         857 $self->{state}{conns} = { };
12191              
12192             # IRC State specific
12193 184         707 $self->{state}{users} = { };
12194 184         628 $self->{state}{peers} = { };
12195 184         625 $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         1087 ts => 6,
12203             };
12204              
12205 184 50       1064 if ( my $sid = $self->{config}{SID} ) {
12206 184         848 my $rec = $self->{state}{peers}{uc $self->server_name()};
12207 184         598 $rec->{sid} = $sid;
12208 184         551 $rec->{ts} = 6;
12209 184         846 $self->{state}{sids}{uc $sid} = $rec;
12210 184         699 $self->{state}{uids} = { };
12211 184         1288 $self->{genuid} = $sid . 'AAAAAA';
12212             }
12213              
12214             $self->{state}{stats} = {
12215 184         1681 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         2041 '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         544 return 1;
12234             }
12235              
12236             sub _state_rand_sid {
12237 2     2   6 my $self = shift;
12238 2         17 my @components = ( 0 .. 9, 'A' .. 'Z' );
12239 2         6 my $total = scalar @components;
12240 2         4 my $prefx = 10;
12241 2         94 $self->{config}{SID} = join '', $components[ rand $prefx ], $components[ rand $total ], $components[ rand $total ];
12242             }
12243              
12244             sub _state_gen_uid {
12245 10570     10570   12160163 my $self = shift;
12246 10570         23813 my $uid = $self->{genuid};
12247 10570         22705 $self->{genuid} = _add_one_uid( $uid );
12248 10570         48321 while ( defined $self->{state}{uids}{$uid} ) {
12249 0         0 $uid = $self->{genuid};
12250 0         0 $self->{genuid} = _add_one_uid( $uid );
12251             }
12252 10570         27040 return $uid;
12253             }
12254              
12255             sub _add_one_uid {
12256 10570     10570   19055 my $UID = shift;
12257 10570         63469 my @cols = unpack 'a' x length $UID, $UID;
12258 10570         23124 my ($add,$add1);
12259             $add1 = $add = sub {
12260 10862     10862   20586 my $idx = shift;
12261 10862 50       27517 if ( $idx != 3 ) {
12262 10862 100       30682 if ( $cols[$idx] eq 'Z' ) {
    100          
12263 293         799 $cols[$idx] = '0';
12264             }
12265             elsif ( $cols[$idx] eq '9' ) {
12266 292         665 $cols[$idx] = 'A';
12267 292         1204 $add->( $idx - 1 );
12268             }
12269             else {
12270 10277         26280 $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         60832 };
12282 10570         30999 $add->(8);
12283 10570         56711 return pack 'a' x scalar @cols, @cols;
12284             }
12285              
12286             sub _state_delete {
12287 184     184   471 my $self = shift;
12288 184         578 delete $self->{state};
12289 184         469 return 1;
12290             }
12291              
12292             sub _state_update_stats {
12293 816     816   1777 my $self = shift;
12294 816         2269 my $server = $self->server_name();
12295 816         1653 my $global = keys %{ $self->{state}{users} };
  816         2750  
12296 816         1601 my $local = keys %{ $self->{state}{peers}{uc $server}{users} };
  816         3940  
12297              
12298             $self->{state}{stats}{maxglobal}
12299 816 100       3372 = $global if $global > $self->{state}{stats}{maxglobal};
12300             $self->{state}{stats}{maxlocal}
12301 816 100       2710 = $local if $local > $self->{state}{stats}{maxlocal};
12302 816         1769 return 1;
12303             }
12304              
12305             sub _state_conn_stats {
12306 527     527   1363 my $self = shift;
12307              
12308 527         1801 $self->{state}{stats}{conns_cumlative}++;
12309 527         1108 my $conns = keys %{ $self->{state}{conns} };
  527         2015  
12310             $self->{state}{stats}{maxconns} = $conns
12311 527 100       2513 if $conns > $self->{state}{stats}{maxconns};
12312 527         1271 return 1;
12313             }
12314              
12315             sub _state_cmd_stat {
12316 4136     4136   7972 my $self = shift;
12317 4136   50     10880 my $cmd = shift || return;
12318 4136   100     10419 my $line = shift || return;
12319 3909         6903 my $remote = shift;
12320 3909   100     20477 my $record = $self->{state}{stats}{cmds}{$cmd} || {
12321             remote => 0,
12322             local => 0,
12323             bytes => 0,
12324             };
12325              
12326 3909 100       11671 $record->{local}++ if !$remote;
12327 3909 100       9762 $record->{remote}++ if $remote;
12328 3909         7760 $record->{bytes} += length $line;
12329 3909         9478 $self->{state}{stats}{cmds}{$cmd} = $record;
12330 3909         8391 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   75 my $self = shift;
12351 26   50     98 my $type = shift || return;
12352 26         124 my @args = @_;
12353 26 50       100 return if !@args;
12354 26 50       227 return if $type !~ m!^((RK|[DKX])LINE|RESV)$!i;
12355 26         90 $type = lc($type) . 's';
12356 26         72 my $ref = { };
12357 26         93 foreach my $field ( qw[setby setat target duration] ) {
12358 104         305 $ref->{$field} = shift @args;
12359 104 50       322 return if !defined $ref->{$field};
12360             }
12361 26         124 $ref->{reason} = pop @args;
12362 26 100       220 if ( $type =~ m!^([xd]lines|resvs)$! ) {
12363 18         81 $ref->{mask} = shift @args;
12364 18 50       119 return if !$ref->{mask};
12365             }
12366             else {
12367 8         62 $ref->{user} = shift @args;
12368 8         27 $ref->{host} = shift @args;
12369 8 50 33     75 return if !$ref->{user} || !$ref->{host};
12370             }
12371 26 100       137 if ( $ref->{duration} ) {
12372             $ref->{alarm} =
12373             $poe_kernel->delay_set(
12374             '_state_drkx_line_alarm',
12375             $ref->{duration},
12376 17         143 $type,
12377             $ref,
12378             );
12379             }
12380 26 100       1674 if ( $type eq 'resvs' ) {
12381 8         190 $self->{state}{$type}{ uc_irc $ref->{mask} } = $ref;
12382             }
12383             else {
12384 18         41 push @{ $self->{state}{$type} }, $ref;
  18         101  
12385             }
12386 26         456 return 1;
12387             }
12388              
12389             sub _state_del_drkx_line {
12390 15     15   54 my $self = shift;
12391 15   50     87 my $type = shift || return;
12392 15         56 my @args = @_;
12393 15 50       61 return if !@args;
12394 15 50       158 return if $type !~ m!^((RK|[DKX])LINE|RESV)$!i;
12395 15         61 $type = lc($type) . 's';
12396 15         39 my ($mask,$user,$host);
12397 15 100       92 if ( $type =~ m!^([xd]lines|resvs)$! ) {
12398 11         30 $mask = shift @args;
12399 11 50       46 return if !$mask;
12400             }
12401             else {
12402 4         12 $user = shift @args;
12403 4         12 $host = shift @args;
12404 4 50 33     36 return if !$user || !$host;
12405             }
12406 15         32 my $result; my $i = 0;
  15         93  
12407 15 100       78 if ( $type eq 'resvs' ) {
12408 5         28 $result = delete $self->{state}{resvs}{ uc_irc $mask };
12409             }
12410             else {
12411 10         26 LINES: for (@{ $self->{state}{$type} }) {
  10         65  
12412 10 100 66     68 if ($mask && $_->{mask} eq $mask) {
12413 6         18 $result = splice @{ $self->{state}{$type} }, $i, 1;
  6         21  
12414 6         20 last LINES;
12415             }
12416 4 50 33     41 if ($user && ($_->{user} eq $user && $_->{host} eq $host)) {
      33        
12417 4         9 $result = splice @{ $self->{state}{$type} }, $i, 1;
  4         16  
12418 4         13 last LINES;
12419             }
12420 0         0 ++$i;
12421             }
12422             }
12423 15 50       142 return if !$result;
12424 15 100       98 if ( my $alarm = delete $result->{alarm} ) {
12425 8         53 $poe_kernel->alarm_remove( $alarm );
12426             }
12427 15         992 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   89909676 my ($kernel,$self,$type,$ref) = @_[KERNEL,OBJECT,ARG0,ARG1];
12442 9         80 my $fancy = $drkxlines{$type};
12443 9         56 delete $ref->{alarm};
12444 9         40 my $res; my $i = 0;
  9         37  
12445 9 100       149 if ( $type eq 'resvs' ) {
12446 2         30 $res = delete $self->{state}{resvs}{uc_irc $ref->{mask}};
12447             }
12448             else {
12449 7         30 LINES: foreach my $drkxline ( @{ $self->{state}{$type} } ) {
  7         76  
12450 7 50       63 if ( $drkxline eq $ref ) {
12451 7         27 $res = splice @{ $self->{state}{$type} }, $i, 1;
  7         47  
12452 7         58 last LINES;
12453             }
12454 0         0 ++$i;
12455             }
12456             }
12457 9 50       180 return if !$res;
12458 9   66     135 my $mask = $res->{mask} || join '@', $res->{user}, $res->{host};
12459 9         138 my $locops = sprintf 'Temporary %s for [%s] expired', $fancy, $mask;
12460 9 100       114 $self->del_denial( $res->{mask} ) if $type eq 'dlines';
12461 9         139 $self->send_event( "daemon_expired", lc($fancy), $mask );
12462 9         2339 $self->_send_to_realops( $locops, 'Notice', 'X' );
12463 9         63 return;
12464             }
12465              
12466             }
12467              
12468             sub _state_is_resv {
12469 389     389   1165 my $self = shift;
12470 389   50     1610 my $thing = shift || return;
12471 389         951 my $conn_id = shift;
12472 389 100 66     2325 if ($conn_id && !$self->_connection_exists($conn_id)) {
12473 1         5 $conn_id = '';
12474             }
12475 389 100 100     3392 if ($conn_id && $self->{state}{conns}{$conn_id}{resv_exempt}) {
12476 1         23 return 0;
12477             }
12478 388         969 foreach my $mask ( keys %{ $self->{state}{resvs} } ) {
  388         2032  
12479 10 100       52 if ( matches_mask( $mask, $thing ) ) {
12480 7         439 return $self->{state}{resvs}{$mask}{reason};
12481             }
12482             }
12483 381         2156 return 0;
12484             }
12485              
12486             sub _state_have_resv {
12487 8     8   23 my $self = shift;
12488 8   50     32 my $mask = shift || return;
12489 8 50       49 return 1 if $self->{state}{resvs}{uc_irc $mask};
12490 8         161 return 0;
12491             }
12492              
12493             sub _state_do_away_notify {
12494 18     18   50 my $self = shift;
12495 18   50     88 my $uid = shift || return;
12496 18   50     89 my $chan = shift || return;
12497 18         41 my $msg = shift;
12498 18 50       102 return if !$self->state_uid_exists($uid);
12499 18         66 my $sid = $self->server_sid();
12500 18         57 my $rec = $self->{state}{uids}{$uid};
12501 18         44 my $common = { };
12502 18         69 my @chans;
12503 18 100       92 if ( $chan eq '*' ) {
12504 15         35 @chans = keys %{ $rec->{chans} };
  15         131  
12505             }
12506             else {
12507 3         12 push @chans, uc_irc $chan;
12508             }
12509 18         133 for my $uchan (@chans) {
12510 5         11 for my $user ( keys %{ $self->{state}{chans}{$uchan}{users} } ) {
  5         29  
12511 8 100       137 next if $user !~ m!^$sid!;
12512 6 100       53 next if !$self->{state}{uids}{$user}{caps}{'away-notify'};
12513 1         4 $common->{$user} = $self->_state_uid_route($user);
12514             }
12515             }
12516             my $ref = {
12517 18         73 prefix => $rec->{full}->(),
12518             command => 'AWAY',
12519             };
12520 18 100       132 $ref->{params} = [ $msg ] if $msg;
12521 18         90 $self->send_output( $ref, $common->{$_} ) for keys %$common;
12522 18         128 return 1;
12523             }
12524              
12525             sub _state_do_local_users_match_xline {
12526 5     5   23 my $self = shift;
12527 5   50     21 my $mask = shift || return;
12528 5   50     34 my $reason = shift || '';
12529 5         20 my $sid = $self->server_sid();
12530 5         15 my $server = $self->server_name();
12531              
12532 5         13 foreach my $luser ( keys %{ $self->{state}{sids}{$sid}{uids} } ) {
  5         33  
12533 5         16 my $urec = $self->{state}{uids}{$luser};
12534 5 50       39 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         20 return 1;
12552             }
12553              
12554             sub _state_do_local_users_match_dline {
12555 5     5   13 my $self = shift;
12556 5   50     21 my $netmask = shift || return;
12557 5   50     19 my $reason = shift || '';
12558 5         31 my $sid = $self->server_sid();
12559 5         23 my $server = $self->server_name();
12560              
12561 5         14 foreach my $luser ( keys %{ $self->{state}{sids}{$sid}{uids} } ) {
  5         34  
12562 5         16 my $urec = $self->{state}{uids}{$luser};
12563 5 50       27 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         27 return 1;
12581             }
12582              
12583             sub _state_do_local_users_match_rkline {
12584 2     2   16 my $self = shift;
12585 2   50     10 my $luser = shift || return;
12586 2   50     7 my $host = shift || return;
12587 2   50     9 my $reason = shift || '';
12588 2         9 my $sid = $self->server_sid();
12589 2         5 my $server = $self->server_name();
12590 2         8 my $local = $self->{state}{sids}{$sid}{uids};
12591              
12592 2         9 for my $urec (values %$local) {
12593 2 50       25 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         8 return 1;
12613             }
12614              
12615             sub _state_do_local_users_match_kline {
12616 6     6   17 my $self = shift;
12617 6   50     29 my $luser = shift || return;
12618 6   50     25 my $host = shift || return;
12619 6   50     31 my $reason = shift || '';
12620 6         30 my $local = $self->{state}{peers}{uc $self->server_name()}{users};
12621 6         18 my $server = $self->server_name();
12622              
12623 6 50       55 if (my $netmask = Net::CIDR::cidrvalidate($host)) {
12624 6         4082 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         29 return 1;
12669             }
12670              
12671             sub _state_user_matches_rkline {
12672 229     229   608 my $self = shift;
12673 229   50     1150 my $conn_id = shift || return;
12674 229         885 my $record = $self->{state}{conns}{$conn_id};
12675 229   66     1695 my $host = $record->{auth}{hostname} || $record->{socket}[0];
12676 229   66     1867 my $user = $record->{auth}{ident} || "~" . $record->{user};
12677 229         700 my $ip = $record->{socket}[0];
12678              
12679 229 100       1050 return 0 if $record->{kline_exempt};
12680              
12681 228         608 for my $kline (@{ $self->{state}{rklines} }) {
  228         1311  
12682 2 50 33     81 if (($host =~ /$kline->{host}/ || $ip =~ /$kline->{host}/)
      33        
12683             && $user =~ /$kline->{user}/) {
12684 2         15 return $kline->{reason};
12685             }
12686             }
12687 226         1359 return 0;
12688             }
12689              
12690             sub _state_user_matches_kline {
12691 234     234   652 my $self = shift;
12692 234   50     1135 my $conn_id = shift || return;
12693 234         825 my $record = $self->{state}{conns}{$conn_id};
12694 234   66     1921 my $host = $record->{auth}{hostname} || $record->{socket}[0];
12695 234   66     1971 my $user = $record->{auth}{ident} || "~" . $record->{user};
12696 234         1056 my $ip = $record->{socket}[0];
12697              
12698 234 100       1162 return 0 if $record->{kline_exempt};
12699              
12700 233         630 for my $kline (@{ $self->{state}{klines} }) {
  233         1118  
12701 5 50 0     32 if (my $netmask = Net::CIDR::cidrvalidate($kline->{host})) {
    0 0        
12702 5 50 33     3205 if (Net::CIDR::cidrlookup($ip,$netmask)
12703             && matches_mask($kline->{user}, $user)) {
12704 5         2759 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         1205 return 0;
12715             }
12716              
12717             sub _state_user_matches_xline {
12718 239     239   652 my $self = shift;
12719 239   50     1082 my $conn_id = shift || return;
12720 239         790 my $record = $self->{state}{conns}{$conn_id};
12721 239   50     1053 my $ircname = $record->{ircname} || return;
12722              
12723 239         574 for my $xline (@{ $self->{state}{xlines} }) {
  239         1175  
12724 5 50       31 if ( matches_mask( $xline->{mask}, $ircname ) ) {
12725 5         455 return $xline->{reason};
12726             }
12727             }
12728              
12729 234         1475 return 0;
12730             }
12731              
12732             sub _state_auth_client_conn {
12733 245     245   735 my $self = shift;
12734 245   50     1082 my $conn_id = shift || return;
12735              
12736 245 100 66     1524 if (!$self->{config}{auth} || !@{ $self->{config}{auth} }) {
  10         54  
12737 235         1136 return 1;
12738             }
12739 10         39 my $record = $self->{state}{conns}{$conn_id};
12740 10   66     56 my $host = $record->{auth}{hostname} || $record->{socket}[0];
12741 10   33     68 my $user = $record->{auth}{ident} || "~" . $record->{user};
12742 10         34 my $uh = join '@', $user, $host;
12743 10         46 my $ui = join '@', $user, $record->{socket}[0];
12744              
12745 10         20 for my $auth (@{ $self->{config}{auth} }) {
  10         54  
12746 10 100 100     57 if (matches_mask($auth->{mask}, $uh)
12747             || matches_mask($auth->{mask}, $ui)) {
12748 9 100 100     739 if ($auth->{password} && (!$record->{pass}
      100        
12749             || !chkpasswd($record->{pass}, $auth->{password}) )) {
12750 4         21 return 0;
12751             }
12752 5 100       7455 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         11 ),
12759             'Notice',
12760             's',
12761             );
12762 1         5 $record->{auth}{hostname} = $auth->{spoof};
12763             }
12764 5         28 foreach my $feat ( qw(exceed_limit kline_exempt resv_exempt can_flood need_ident) ) {
12765 25 100       109 $record->{$feat} = 1 if $auth->{$feat};
12766             }
12767 5 100 66     47 if (!$record->{auth}{ident} && $auth->{no_tilde}) {
12768 1         2 $record->{auth}{ident} = $record->{user};
12769             }
12770 5         31 return 1;
12771             }
12772             }
12773              
12774 1         121 return 0;
12775             }
12776              
12777             sub _state_auth_peer_conn {
12778 259     259   686 my $self = shift;
12779 259         919 my ($conn_id, $name, $pass) = @_;
12780              
12781 259 50 33     1421 if (!$conn_id || !$self->_connection_exists($conn_id)) {
12782 0         0 return;
12783             }
12784              
12785 259 50 33     1687 return 0 if !$name || !$pass;
12786 259         972 my $peers = $self->{config}{peers};
12787 259 50       1394 return 0 if !$peers->{uc $name};
12788 259         697 my $peer = $peers->{uc $name};
12789 259 100       1708 return -1 if !chkpasswd($pass,$peer->{pass});
12790              
12791 258         31189 my $conn = $self->{state}{conns}{$conn_id};
12792              
12793 258 50 66     1068 if ($peer->{certfp} && $conn->{secured}) {
12794 4         29 my $certfp = $self->connection_certfp($conn_id);
12795 4 100 66     39 return -2 if !$certfp || $certfp ne $peer->{certfp};
12796             }
12797              
12798 257 100 66     2930 if (!$peer->{ipmask} && $conn->{socket}[0] =~ /^(127\.|::1)/) {
12799 254         1000 return 1;
12800             }
12801 3 50       19 return -3 if !$peer->{ipmask};
12802 3         11 my $client_ip = $conn->{socket}[0];
12803              
12804 3 50       16 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       39 "*!*\@$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   609 my $self = shift;
12833 227   50     1085 my $conn_id = shift || return;
12834 227 50       1027 return if !$self->_connection_exists($conn_id);
12835 227         972 my $server = $self->server_name();
12836 227         785 my $crec = $self->{state}{conns}{$conn_id};
12837 227         651 my $nick = $crec->{nick};
12838              
12839 227         901 foreach my $feat ( qw(kline_exempt resv_exempt exceed_limit can_flood) ) {
12840 908 100       2829 next if !$crec->{$feat};
12841 4 100       16 $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         30 params => [ $nick, $flag_notices{$feat} ],
12848             },
12849             );
12850             }
12851 227         673 return 1;
12852             }
12853              
12854             }
12855              
12856             sub _state_send_credentials {
12857 257     257   642 my $self = shift;
12858 257   50     890 my $conn_id = shift || return;
12859 257   50     949 my $name = shift || return;
12860 257 50       877 return if !$self->_connection_exists($conn_id);
12861 257 50       1381 return if !$self->{config}{peers}{uc $name};
12862 257 50       930 return if $self->_connection_terminated($conn_id);
12863              
12864 257         1018 my $peer = $self->{config}{peers}{uc $name};
12865 257         1092 my $rec = $self->{state}{peers}{uc $self->server_name()};
12866 257         813 my $sid = $rec->{sid};
12867              
12868             $self->send_output(
12869             {
12870             command => 'PASS',
12871 257 50       3450 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         2998 join (' ', @{ $self->{config}{capab} },
12881 257 100       1207 ($peer->{zip} ? 'ZIP' : ())
12882             ),
12883             ],
12884             },
12885             $conn_id,
12886             );
12887              
12888 257         890 my $desc = '';
12889 257 100       1543 $desc = '(H) ' if $self->{config}{hidden};
12890 257         896 $desc .= $rec->{desc};
12891              
12892             $self->send_output(
12893             {
12894             command => 'SERVER',
12895             params => [
12896             $rec->{name},
12897 257         1988 $rec->{hops} + 1,
12898             $desc,
12899             ],
12900             },
12901             $conn_id,
12902             );
12903              
12904 257         1954 $self->send_output(
12905             {
12906             command => 'SVINFO',
12907             params => [6, 6, 0, time],
12908             },
12909             $conn_id,
12910             );
12911              
12912 257         1618 $self->{state}{conns}{$conn_id}{zip} = $peer->{zip};
12913 257         877 return 1;
12914             }
12915              
12916             sub _state_send_burst {
12917 257     257   698 my $self = shift;
12918 257   50     1032 my $conn_id = shift || return;
12919 257 50       987 return if !$self->_connection_exists($conn_id);
12920 257 50       936 return if $self->_connection_terminated($conn_id);
12921 257         1107 my $server = $self->server_name();
12922 257         824 my $sid = $self->server_sid();
12923 257         781 my $conn = $self->{state}{conns}{$conn_id};
12924 257         593 my $burst = grep { /^EOB$/i } @{ $conn->{capab} };
  4077         8898  
  257         856  
12925 257         640 my $invex = grep { /^IE$/i } @{ $conn->{capab} };
  4077         7951  
  257         796  
12926 257         611 my $excepts = grep { /^EX$/i } @{ $conn->{capab} };
  4077         7897  
  257         800  
12927 257         660 my $tburst = grep { /^TBURST$/i } @{ $conn->{capab} };
  4077         8439  
  257         740  
12928 257         636 my $rhost = grep { /^RHOST$/i } @{ $conn->{capab} };
  4077         7335  
  257         764  
12929 257   66     1508 $rhost = ( $self->_state_our_capab('RHOST') && $rhost );
12930 257         1652 my %map = qw(bans b excepts e invex I);
12931 257         805 my @lists = qw(bans);
12932 257 100       1048 push @lists, 'excepts' if $excepts;
12933 257 100       993 push @lists, 'invex' if $invex;
12934              
12935             # Send SERVER burst
12936 257         584 my %eobs;
12937 257         1368 for ($self->_state_server_burst($sid, $conn->{sid})) {
12938 206         715 $eobs{ $_->{prefix} }++;
12939 206         940 $self->send_output($_, $conn_id );
12940             }
12941              
12942             # Send NICK burst
12943 257         783 for my $uid (keys %{ $self->{state}{uids} }) {
  257         1265  
12944 328         1121 my $record = $self->{state}{uids}{$uid};
12945 328 50       1443 next if $record->{route_id} eq $conn_id;
12946              
12947 328         1311 my $umode_fixed = $record->{umode};
12948 328         1603 $umode_fixed =~ s/[^aiow]//g;
12949 328         1042 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 328         2001 ];
12958 328 100       1138 push @$arrayref, $record->{auth}{realhost} if $rhost;
12959             push @$arrayref, ( $record->{ipaddress} || 0 ),
12960 328   100     2353 $record->{uid}, $record->{account}, $record->{ircname};
12961 328         1451 my @uid_burst = (
12962             {
12963             prefix => $prefix,
12964             command => 'UID',
12965             params => $arrayref,
12966             },
12967             );
12968 328 100       1437 if ( $record->{away} ) {
12969             push @uid_burst, {
12970             prefix => $record->{uid},
12971             command => 'AWAY',
12972 9         66 params => [ $record->{away} ],
12973             };
12974             }
12975 328         622 foreach my $svstag ( keys %{ $record->{svstags} } ) {
  328         1509  
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 2         14 ],
12986             };
12987             }
12988 328         1474 $self->send_output( $_, $conn_id ) for @uid_burst;
12989             }
12990              
12991             # Send SJOIN+MODE burst
12992 257         657 for my $chan (keys %{ $self->{state}{chans} }) {
  257         1197  
12993 57 50       375 next if $chan =~ /^\&/;
12994 57         166 my $chanrec = $self->{state}{chans}{$chan};
12995 1019         1671 my @uids = map { $_->[1] }
12996 4504         6306 sort { $a->[0] cmp $b->[0] }
12997 57         342 map { my $w = $_; $w =~ tr/@%+/ABC/; [$w, $_] }
  1019         1507  
  1019         1512  
  1019         2033  
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 57   33     836 ($chanrec->{climit} || ()),
      66        
13006             ];
13007              
13008 57         228 my $length = length( join ' ', @$chanref ) + 11;
13009 57         142 my $buf = '';
13010 57         259 UID: foreach my $uid ( @uids ) {
13011 1019 100       2348 if (length(join ' ', $buf, '1', $uid)+$length+1 > 510) {
13012 11         80 $self->send_output(
13013             {
13014             prefix => $sid,
13015             command => 'SJOIN',
13016             params => [ @$chanref, $buf ],
13017             },
13018             $conn_id,
13019             );
13020 11         34 $buf = $uid;
13021 11         36 next UID;
13022             }
13023 1008         1793 $buf = join ' ', $buf, $uid;
13024 1008         2049 $buf =~ s!^\s+!!;
13025             }
13026 57 50       232 if ($buf) {
13027 57         420 $self->send_output(
13028             {
13029             prefix => $sid,
13030             command => 'SJOIN',
13031             params => [ @$chanref, $buf ],
13032             },
13033             $conn_id,
13034             );
13035             }
13036              
13037 57         195 my @output_modes;
13038 57         208 OUTER: for my $type (@lists) {
13039 171         421 my $length = length($sid) + 5 + length($chan) + 4 + length($chanrec->{ts}) + 2;
13040 171         365 my @buffer = ( '', '' );
13041 171         271 INNER: for my $thing (keys %{ $chanrec->{$type} }) {
  171         1093  
13042 168         292 $thing = $chanrec->{$type}{$thing}[0];
13043 168 100       401 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         58 $map{$type},
13053             $buffer[1],
13054             ],
13055             };
13056 12         26 $buffer[0] = '+' . $map{$type};
13057 12         19 $buffer[1] = $thing;
13058 12         21 next INNER;
13059             }
13060              
13061 156 100       256 if ($buffer[1]) {
13062 147         210 $buffer[0] .= $map{$type};
13063 147         358 $buffer[1] = join ' ', $buffer[1], $thing;
13064             }
13065             else {
13066 9         24 $buffer[0] = '+' . $map{$type};
13067 9         18 $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 171 100       520 $map{$type},
13079             $buffer[1],
13080             ],
13081             } if $buffer[1];
13082             }
13083 57         188 $self->send_output($_, $conn_id) for @output_modes;
13084              
13085 57 100 66     463 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         34 @{ $chanrec->{topic} }[2,1,0],
  8         81  
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       983 if ( $burst ) {
13105 257         1895 $self->send_output(
13106             {
13107             prefix => $sid,
13108             command => 'EOB',
13109             },
13110             $conn_id,
13111             );
13112 257         877 delete $eobs{$sid};
13113             $self->send_output(
13114             {
13115             prefix => $_,
13116             command => 'EOB',
13117             },
13118             $conn_id,
13119 257         1438 ) for keys %eobs;
13120             }
13121              
13122 257         1122 return 1;
13123             }
13124              
13125             sub _state_server_burst {
13126 463     463   1112 my $self = shift;
13127 463   50     1498 my $peer = shift || return;
13128 463   50     1418 my $targ = shift || return;
13129 463 50 33     1440 if (!$self->state_peer_exists( $peer )
13130             || !$self->state_peer_exists($targ)) {
13131             }
13132              
13133 463         1242 my $ref = [ ];
13134              
13135 463         908 for my $server (keys %{ $self->{state}{sids}{$peer}{sids} }) {
  463         2643  
13136 463 100       1568 next if $server eq $targ;
13137 206         716 my $rec = $self->{state}{sids}{$server};
13138 206         552 my $desc = '';
13139 206 100       949 $desc = '(H) ' if $rec->{hidden};
13140 206         868 $desc .= $rec->{desc};
13141             push @$ref, {
13142             prefix => $peer,
13143             command => 'SID',
13144 206         1683 params => [$rec->{name}, $rec->{hops} + 1, $server, $desc],
13145             };
13146 206         1832 push @$ref, $_ for $self->_state_server_burst($rec->{sid}, $targ);
13147             }
13148              
13149 463 50       2369 return @$ref if wantarray;
13150 0         0 return $ref;
13151             }
13152              
13153             sub _state_do_change_hostmask {
13154 6     6   1699 my $self = shift;
13155 6   50     28 my $uid = shift || return;
13156 6   50     21 my $nhost = shift || return;
13157 6         19 my $ref = [ ];
13158 6         23 my $sid = $self->server_sid();
13159 6         38 my $server = $self->server_name();
13160              
13161             SWITCH: {
13162 6 50       43 if ($nhost !~ $host_re ) {
  6         104  
13163 0         0 last SWITCH;
13164             }
13165 6         36 my $rec = $self->{state}{uids}{$uid};
13166 6 50       43 if ($nhost eq $rec->{auth}{hostname}) {
13167 0         0 last SWITCH;
13168             }
13169 6         130 my $local = ( $uid =~ m!^$sid! );
13170 6 50       53 my $conn_id = ($local ? $rec->{route_id} : '');
13171 6         30 my $full = $rec->{full}->();
13172 6         15 foreach my $chan ( keys %{ $rec->{chans} } ) {
  6         36  
13173 3         46 $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         28 $rec->{auth}{hostname} = $nhost;
13196 6 50       29 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         59 );
13209             }
13210 6         35 $full = $rec->{full}->();
13211 6         28 CHAN: foreach my $uchan ( keys %{ $rec->{chans} } ) {
  6         39  
13212 3         42 my $chan = $self->{state}{chans}{$uchan}{name};
13213 3         10 my $modeline;
13214             MODES: {
13215 3         6 my $modes = $rec->{chans}{$uchan};
  3         11  
13216 3 50       14 last MODES if !$modes;
13217             $modes = join '',
13218 9         27 map { $_->[1] }
13219 9         36 sort { $a->[0] cmp $b->[0] }
13220 3         32 map { my $w = $_; $w =~ tr/ohv/ABC/; [$w, $_] }
  9         20  
  9         15  
  9         57  
13221             split //, $modes;
13222 3         11 my @args;
13223 3         17 push @args, $_ for
13224 9         32 map { $rec->{nick} } split //, $modes;
13225 3         20 $modeline = join ' ', "+$modes", @args;
13226             }
13227             $self->_send_output_channel_local(
13228 3         46 $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         39 params => [ $chan, $rec->{account}, $rec->{ircname} ],
13244             },
13245             $conn_id, '', 'extended-join', 'chghost'
13246             );
13247 3 50       21 if ($modeline) {
13248 3         44 $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       27 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         24 return $ref;
13275             }
13276              
13277             sub _state_do_map {
13278 14     14   34 my $self = shift;
13279 14   50     33 my $nick = shift || return;
13280 14   50     33 my $psid = shift || return;
13281 14         19 my $plen = shift;
13282 14         20 my $ctn = shift;
13283 14         26 my $ref = [ ];
13284 14 50       45 return if !$self->state_sid_exists($psid);
13285 14         29 my $rec = $self->{state}{sids}{$psid};
13286              
13287             SWITCH: {
13288 14         21 my $global = scalar keys %{ $self->{state}{uids} };
  14         31  
  14         36  
13289 14         38 my $local = scalar keys %{ $rec->{uids} };
  14         36  
13290 14         122 my $suffix = sprintf(" | Users: %5d (%1.2f%%)", $local, ( 100 * $local / $global ) );
13291              
13292 14         36 my $prompt = ' ' x $plen;
13293 14 100       79 substr $prompt, -2, 2, '|-' if $plen;
13294 14 100 100     55 substr $prompt, -2, 2, '`-' if !$ctn && $plen;
13295 14         48 my $buffer = $rec->{name} . ' ';
13296 14         42 $buffer .= '-' x ( 64 - length($buffer) - length($prompt) );
13297 14         34 $buffer .= $suffix;
13298              
13299 14 50 66     53 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         36 push @$ref, {
13312             prefix => $self->server_name(),
13313             command => '015',
13314             params => [
13315             $nick,
13316             join '', $prompt, $buffer
13317             ],
13318             };
13319 14         34 my $sids = $self->{state}{sids}{$psid}{sids};
13320 14         29 my $cnt = keys %$sids;
13321 14         51 foreach my $server (sort { keys %{ $sids->{$a}{sids} } <=> keys %{ $sids->{$b}{sids} } } keys %$sids) {
  2         5  
  2         11  
  2         29  
13322 12         103 push @$ref, $_ for $self->_state_do_map( $nick, $server, $plen + 2, --$cnt );
13323             }
13324             }
13325              
13326 14 50       80 return @$ref if wantarray;
13327 0         0 return $ref;
13328             }
13329              
13330             sub _state_sid_links {
13331 20     20   37 my $self = shift;
13332 20   50     45 my $psid = shift || return;
13333 20   50     44 my $orig = shift || return;
13334 20   50     45 my $nick = shift || return;
13335 20   100     71 my $mask = shift || '*';
13336 20 50       45 return if !$self->state_sid_exists($psid);
13337              
13338 20         36 my $ref = [ ];
13339 20         46 my $peer = $self->_state_sid_name($psid);
13340              
13341 20         46 my $sids = $self->{state}{sids}{$psid}{sids};
13342 20         70 for my $server (sort { keys %{ $sids->{$b}{sids} } <=> keys %{ $sids->{$a}{sids} } } keys %$sids) {
  5         12  
  5         18  
  5         35  
13343 15         231 my $rec = $self->{state}{sids}{$server};
13344 15         55 for ($self->_state_sid_links($server, $orig, $nick)) {
13345 5         13 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       50 } if matches_mask($mask, $rec->{name});
13357             }
13358              
13359 20 50       576 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   832 my $self = shift;
13373 345   50     1170 my $sid = shift || return;
13374 345 100       1197 return if !$self->state_sid_exists($sid);
13375 344         996 my $ref = [ ];
13376 344         926 push @$ref, $_ for keys %{ $self->{state}{sids}{$sid}{uids} };
  344         3008  
13377              
13378 344         1085 for my $psid (keys %{ $self->{state}{sids}{$sid}{sids} }) {
  344         1581  
13379 117         911 push @$ref, $_ for $self->_state_server_squit($psid);
13380             }
13381              
13382 344         1297 my $rec = delete $self->{state}{sids}{$sid};
13383 344         1136 my $upeer = uc $rec->{name};
13384 344         1109 my $me = uc $self->server_name();
13385 344         1018 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       2303 ) if $mysid ne $rec->{psid};
13394              
13395 344         1178 delete $self->{state}{peers}{$upeer};
13396 344         1022 delete $self->{state}{peers}{$me}{peers}{$upeer};
13397 344         932 delete $self->{state}{peers}{$me}{sids}{$sid};
13398 344 50       1991 return @$ref if wantarray;
13399 0         0 return $ref;
13400             }
13401              
13402             sub _state_register_peer {
13403 257     257   589 my $self = shift;
13404 257   50     1034 my $conn_id = shift || return;
13405 257 50       930 return if !$self->_connection_exists($conn_id);
13406 257         1393 my $server = $self->server_name();
13407 257         997 my $mysid = $self->server_sid();
13408 257         784 my $record = $self->{state}{conns}{$conn_id};
13409 257         693 my $psid = $record->{ts_data}[1];
13410 257 50       885 return if !$psid;
13411              
13412 257 100       945 if (!$record->{cntr}) {
13413 254         1322 $self->_state_send_credentials($conn_id, $record->{name});
13414             }
13415              
13416 257         948 $record->{burst} = $record->{registered} = 1;
13417 257         1120 $record->{conn_time} = time;
13418 257         747 $record->{type} = 'p';
13419 257         806 $record->{route_id} = $conn_id;
13420 257         734 $record->{peer} = $server;
13421 257         769 $record->{psid} = $mysid;
13422 257         751 $record->{users} = { };
13423 257         745 $record->{peers} = { };
13424 257         701 $record->{sid} = $psid;
13425 257         931 my $ucname = uc $record->{name};
13426 257 100       1493 $record->{serv} = 1 if $self->{state}{services}{$ucname};
13427 257         1250 $self->{state}{peers}{uc $server}{peers}{ $ucname } = $record;
13428 257         786 $self->{state}{peers}{ $ucname } = $record;
13429 257         1070 $self->{state}{sids}{ $mysid }{sids}{ $psid } = $record;
13430 257         742 $self->{state}{sids}{ $psid } = $record;
13431 257         1364 $self->antiflood($conn_id, 0);
13432              
13433 257 100       1718 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         24 $record->{name}, $record->{socket}[0], $sslinfo, join(' ', @{ $record->{capab} }),
  6         78  
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         986 $record->{name}, $record->{socket}[0], join(' ', @{ $record->{capab} }),
  251         2926  
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       3110 grep { $_ ne $conn_id } $self->_state_connected_peers(),
  380         3108  
13467             );
13468              
13469             $self->send_event(
13470             'daemon_sid',
13471             $record->{name},
13472             $mysid,
13473             $record->{hops},
13474             $psid,
13475             $record->{desc},
13476 257         1946 );
13477             $self->send_event(
13478             'daemon_server',
13479             $record->{name},
13480             $server,
13481             $record->{hops},
13482             $record->{desc},
13483 257         34851 );
13484              
13485 257         31328 return 1;
13486             }
13487              
13488             sub _state_register_client {
13489 227     227   905 my $self = shift;
13490 227   50     1048 my $conn_id = shift || return;
13491 227 50       959 return if !$self->_connection_exists($conn_id);
13492              
13493 227         861 my $record = $self->{state}{conns}{$conn_id};
13494 227         1992 $record->{ts} = $record->{idle_time} = $record->{conn_time} = time;
13495 227         884 $record->{_ignore_i_umode} = 1;
13496 227         932 $record->{server} = $self->server_name();
13497 227         1113 $record->{hops} = 0;
13498 227         880 $record->{route_id} = $conn_id;
13499 227         781 $record->{umode} = '';
13500              
13501              
13502 227         1138 $record->{uid} = $self->_state_gen_uid();
13503 227         1136 $record->{sid} = substr $record->{uid}, 0, 3;
13504              
13505 227 100       1052 if (!$record->{auth}{ident}) {
13506 226         1092 $record->{auth}{ident} = '~' . $record->{user};
13507             }
13508              
13509 227 100 66     3637 if ($record->{auth}{hostname} eq 'localhost' ||
      66        
13510             !$record->{auth}{hostname} && $record->{socket}[0] =~ /^(127\.|::1)/) {
13511 226         1198 $record->{auth}{hostname} = $self->server_name();
13512             }
13513              
13514 227 50       1262 if (!$record->{auth}{hostname}) {
13515 0         0 $record->{auth}{hostname} = $record->{socket}[0];
13516             }
13517              
13518 227         1484 $record->{auth}{realhost} = $record->{auth}{hostname};
13519              
13520 227         821 $record->{account} = '*';
13521              
13522 227         822 $record->{ipaddress} = $record->{socket}[0]; # Needed later for UID command
13523 227 50       1282 $record->{ipaddress} = '0' if $record->{ipaddress} =~ m!^:!;
13524              
13525 227         1214 my $unick = uc_irc $record->{nick};
13526 227         3845 my $ucserver = uc $record->{server};
13527 227         866 $self->{state}{users}{$unick} = $record;
13528 227 50       1504 $self->{state}{uids}{ $record->{uid} } = $record if $record->{uid};
13529 227         1136 $self->{state}{peers}{$ucserver}{users}{$unick} = $record;
13530 227 50       1273 $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   8728 $record->{auth}{hostname});
13537 227         1585 };
13538              
13539 227         745 my $umode = '+i';
13540 227 100       1079 if ( $record->{secured} ) {
13541 8         24 $umode .= 'S';
13542 8         48 $record->{umode} = 'S';
13543 8 100       85 if (my $certfp = $self->connection_certfp($conn_id)) {
13544 5         155 $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         1975 ];
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         1583 ];
13572              
13573 227         2683 delete $self->{state}{pending}{uc_irc($record->{nick})};
13574              
13575 227         4362 foreach my $peer_id ( $self->_state_connected_peers() ) {
13576 332 50       1650 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         2646 command => 'UID',
13591             params => $arrayref,
13592             },
13593             $peer_id,
13594             );
13595             }
13596 332 100       2643 if ($record->{certfp}) {
13597             $self->send_output(
13598             {
13599             prefix => $record->{uid},
13600             command => 'CERTFP',
13601 8         52 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         3185 @{ $rhostref }[0,4,6], $record->{socket}[0],
13613             'users', $record->{ircname}, $record->{uid},
13614 227         1009 ),
13615             'Notice',
13616             'c',
13617             );
13618              
13619 227         1282 $self->send_event('daemon_uid', @$arrayref);
13620 227   50     29489 $self->send_event('daemon_nick', @{ $arrayref }[0..5], $record->{server}, ( $arrayref->[9] || '' ) );
  227         1878  
13621 227         27755 $self->_state_update_stats();
13622              
13623 227 100       1231 if ( defined $self->{state}{watches}{$unick} ) {
13624 1         3 foreach my $wuid ( keys %{ $self->{state}{watches}{$unick}{uids} } ) {
  1         7  
13625 1 50       5 next if !defined $self->{state}{uids}{$wuid};
13626 1         4 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         12 );
13642             }
13643             }
13644 227         1233 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 4171     4171 1 7680 my $self = shift;
13655 4171   50     10397 my $nick = shift || return 1;
13656 4171         12152 $nick = uc_irc($nick);
13657              
13658 4171 100 100     62872 if (!defined $self->{state}{users}{$nick}
13659             && !defined $self->{state}{pending}{$nick}) {
13660 925         3671 return 0;
13661             }
13662 3246         10855 return 1;
13663             }
13664              
13665             sub state_uid_exists {
13666 6639     6639 0 10609 my $self = shift;
13667 6639   50     13959 my $uid = shift || return 1;
13668 6639 100       22941 return 1 if defined $self->{state}{uids}{$uid};
13669 12         77 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 1877     1877 1 3320 my $self = shift;
13680 1877   50     4722 my $chan = shift || return;
13681 1877 100       5825 return 0 if !defined $self->{state}{chans}{uc_irc($chan)};
13682 1771         26181 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 904     904 1 1712 my $self = shift;
13693 904   50     2471 my $peer = shift || return;
13694 904 100       5154 return 0 if !defined $self->{state}{peers}{uc $peer};
13695 49         157 return 1;
13696             }
13697              
13698             sub state_sid_exists {
13699 2473     2473 0 4715 my $self = shift;
13700 2473   50     6362 my $sid = shift || return;
13701 2473 100       8006 return 0 if !defined $self->{state}{sids}{ $sid };
13702 2074         5788 return 1;
13703             }
13704              
13705             sub state_check_joinflood_warning {
13706 52     52 0 138 my $self = shift;
13707 52   50     569 my $nick = shift || return;
13708 52   50     181 my $chan = shift || return;
13709 52         175 my $joincount = $self->{config}{joinfloodcount};
13710 52         141 my $jointime = $self->{config}{joinfloodtime};
13711 52 50 33     311 return if !$joincount || !$jointime;
13712 52 50       184 return if !$self->state_nick_exists($nick);
13713 52 50       233 return if !$self->state_chan_exists($chan);
13714 52         265 my $crec = $self->{state}{chans}{uc_irc $chan};
13715 52         684 $crec->{_num_joined}++;
13716 52   33     454 $crec->{_num_joined} -= ( time - ( $self->{_last_joined} || time ) ) *
13717             ( $joincount / $jointime );
13718 52 50       414 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         187 $crec->{_last_joined} = time();
13737             }
13738              
13739             sub state_check_spambot_warning {
13740 59     59 0 170 my $self = shift;
13741 59   50     251 my $nick = shift || return;
13742 59   100     750 my $chan = shift || return;
13743 52         249 my $spamnum = $self->{config}{MAX_JOIN_LEAVE_COUNT};
13744 52 50       182 return if !$self->state_nick_exists($nick);
13745 52         266 my $urec = $self->{state}{users}{uc_irc $nick};
13746              
13747 52 50 33     1052 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     401 my $delta = time() - ( $urec->{_last_leave} || 0 );
13772 52 50       267 if ( $delta > $self->{config}{JOIN_LEAVE_COUNT_EXPIRE} ) {
13773 52         225 my $dec_cnt = $delta / $self->{config}{JOIN_LEAVE_COUNT_EXPIRE};
13774 52 50 50     465 if ($dec_cnt > ( $urec->{_jl_cnt} || 0 )) {
13775 52         199 $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       220 if ( $chan ) {
13786 52         193 $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 27 my $self = shift;
13796 8   50     27 my $nick = shift || return;
13797 8   50     23 my $chan = shift || return;
13798 8   50     24 my $type = shift || 'PRIVMSG';
13799 8 50 33     55 return 0 if !$self->{config}{floodcount} || !$self->{config}{floodtime};
13800 8 50       34 return if !$self->state_nick_exists($nick);
13801 8 50       41 return if !$self->state_chan_exists($chan);
13802 8         36 my $urec = $self->{state}{users}{uc_irc $nick};
13803 8 50       97 return 0 if $urec->{route_id} eq 'spoofed';
13804 8 50 33     51 return 0 if $urec->{can_flood} || $urec->{umode} =~ /o/;
13805 8         29 my $crec = $self->{state}{chans}{uc_irc $chan};
13806 8         100 my $first = $crec->{_first_msg};
13807 8 50 66     42 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         20 my $recv = $crec->{_recv_msgs};
13817 8 100 100     40 if ( $recv && $recv >= $self->{config}{floodcount} ) {
13818 1 50       7 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         19 ), qw[Notice b],
13825             );
13826 1         8 $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       36 $crec->{_first_msg} = time() if !$first;
13844 7         20 $crec->{_recv_msgs}++;
13845 7         30 return 0;
13846             }
13847              
13848             sub state_flood_attack_client {
13849 14     14 0 28 my $self = shift;
13850 14   50     42 my $nick = shift || return;
13851 14   50     51 my $targ = shift || return;
13852 14   50     53 my $type = shift || 'PRIVMSG';
13853 14 50 33     128 return 0 if !$self->{config}{floodcount} || !$self->{config}{floodtime};
13854 14 50       43 return if !$self->state_nick_exists($nick);
13855 14 50       51 return if !$self->state_nick_exists($targ);
13856 14         64 my $urec = $self->{state}{users}{uc_irc $nick};
13857 14 50       181 return 0 if $urec->{route_id} eq 'spoofed';
13858 14 100 66     104 return 0 if $urec->{can_flood} || $urec->{umode} =~ /o/;
13859 12         45 my $trec = $self->{state}{users}{uc_irc $targ};
13860 12         146 my $first = $trec->{_first_msg};
13861 12 50 66     73 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         31 my $recv = $trec->{_recv_msgs};
13871 12 100 100     51 if ( $recv && $recv >= $self->{config}{floodcount} ) {
13872 1 50       5 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         5 ), 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         4 );
13894             }
13895 1         8 return 1;
13896             }
13897 11 100       40 $trec->{_first_msg} = time() if !$first;
13898 11         32 $trec->{_recv_msgs}++;
13899 11         34 return 0;
13900             }
13901              
13902             sub state_can_send_to_channel {
13903 23     23 0 59 my $self = shift;
13904 23   50     79 my $nick = shift || return;
13905 23   50     69 my $chan = shift || return;
13906 23   50     111 my $msg = shift || return;
13907 23   50     80 my $type = shift || 'PRIVMSG';
13908 23 50       98 return if !$self->state_nick_exists($nick);
13909 23 50       101 return if !$self->state_chan_exists($chan);
13910 23         103 my $uid = $self->state_user_uid($nick);
13911 23         387 my $crec = $self->{state}{chans}{uc_irc $chan};
13912 23         287 my $urec = $self->{state}{uids}{$uid};
13913 23         101 my $member = defined $crec->{users}{$uid};
13914              
13915 23 100 66     126 if ( $crec->{mode} =~ /c/ && ( has_color($msg) || has_formatting($msg) ) ) {
      66        
13916 2         33 return [ '408', $crec->{name} ];
13917             }
13918 21 100 100     176 if ( $crec->{mode} =~ /C/ && $msg =~ m!^\001! && $msg !~ m!^\001ACTION! ) {
      100        
13919 1         6 return [ '492', $crec->{name} ];
13920             }
13921 20 50 33     172 if ( $crec->{mode} =~ /n/ && !$member ) {
13922 0         0 return [ '404', $crec->{name} ];
13923             }
13924 20 100 66     134 if ( $crec->{mode} =~ /M/ && $urec->{umode} !~ /r/ ) {
13925 2         11 return [ '477', $crec->{name} ];
13926             }
13927 18 100 66     140 if ( $member && $crec->{users}{$uid} ) {
13928 8         42 return 2;
13929             }
13930 10 50       37 if ( $crec->{mode} =~ /m/ ) {
13931 0         0 return [ '404', $crec->{name} ];
13932             }
13933 10 100 66     44 if ( $crec->{mode} =~ /T/ && $type eq 'NOTICE' ) {
13934 2         12 return [ '404', $crec->{name} ];
13935             }
13936 8 50       30 if ( $self->_state_user_banned($nick, $chan) ) {
13937 0         0 return [ '404', $crec->{name} ];
13938             }
13939 8         35 return 1;
13940             }
13941              
13942             sub _state_peer_name {
13943 2     2   4 my $self = shift;
13944 2   50     7 my $peer = shift || return;
13945 2 100       8 return if !$self->state_peer_exists($peer);
13946 1         5 return $self->{state}{peers}{uc $peer}{name};
13947             }
13948              
13949             sub _state_peer_sid {
13950 7     7   37 my $self = shift;
13951 7   50     25 my $peer = shift || return;
13952 7 100       31 if ( $peer =~ m!^\d! ) {
13953 4 50       15 return if !$self->state_sid_exists($peer);
13954 4         33 return $self->{state}{sids}{$peer}{sid};
13955             }
13956             else {
13957 3 50       10 return if !$self->state_peer_exists($peer);
13958 3         23 return $self->{state}{peers}{uc $peer}{sid};
13959             }
13960             }
13961              
13962             sub _state_sid_name {
13963 945     945   1898 my $self = shift;
13964 945   50     2634 my $sid = shift || return;
13965 945 50       2741 return if !$self->state_sid_exists($sid);
13966 945         11798 return $self->{state}{sids}{$sid}{name};
13967             }
13968              
13969             sub _state_sid_serv {
13970 52     52   160 my $self = shift;
13971 52   50     510 my $sid = shift || return;
13972 52 50       264 return if !$self->state_sid_exists($sid);
13973 52 100       346 return 0 if !$self->{state}{sids}{$sid}{serv};
13974 43         345 return 1;
13975             }
13976              
13977             sub _state_peer_desc {
13978 4     4   16 my $self = shift;
13979 4   50     16 my $peer = shift || return;
13980 4 50       32 return if !$self->state_peer_exists($peer);
13981 4         29 return $self->{state}{peers}{uc $peer}{desc};
13982             }
13983              
13984             sub _state_peer_capab {
13985 923     923   1902 my $self = shift;
13986 923   50     2524 my $conn_id = shift || return;
13987 923   50     2450 my $capab = shift || return;
13988 923         1861 $capab = uc $capab;
13989 923 50       2725 return if !$self->_connection_is_peer($conn_id);
13990 923         2139 my $conn = $self->{state}{conns}{$conn_id};
13991 923         1656 return scalar grep { $_ eq $capab } @{ $conn->{capab} };
  14703         26496  
  923         2497  
13992             }
13993              
13994             sub _state_our_capab {
13995 811     811   1496 my $self = shift;
13996 811   50     2302 my $capab = shift || return;
13997 811         1826 $capab = uc $capab;
13998 811         1892 my $capabs = $self->{config}{capab};
13999 811         1353 return scalar grep { $_ eq $capab } @{ $capabs };
  9732         20146  
  811         1770  
14000             }
14001              
14002             sub state_user_full {
14003 3142     3142 1 6002 my $self = shift;
14004 3142   50     7853 my $nick = shift || return;
14005 3142         5061 my $oper = shift;
14006 3142         5343 my $opuser = '';
14007 3142         4943 my $record;
14008 3142 100       11672 if ( $nick =~ m!^\d! ) {
14009 2544 50       6569 return if !$self->state_uid_exists($nick);
14010 2544         5579 $record = $self->{state}{uids}{$nick};
14011             }
14012             else {
14013 598 50       1849 return if !$self->state_nick_exists($nick);
14014 598         2227 $record = $self->{state}{users}{uc_irc($nick)};
14015             }
14016 3142 100 66     13933 if ( $oper && defined $record->{opuser} ) {
14017 1         4 $opuser = '{' . $record->{opuser} . '}';
14018             }
14019 3142         11019 return $record->{full}->() . $opuser;
14020             }
14021              
14022             sub state_user_nick {
14023 183     183 1 443 my $self = shift;
14024 183   50     1314 my $nick = shift || return;
14025 183 100       973 if ( $nick =~ m!^\d! ) {
14026 111 100       449 return if !$self->state_uid_exists($nick);
14027 109         572 return $self->{state}{uids}{$nick}{nick};
14028             }
14029             else {
14030 72 100       222 return if !$self->state_nick_exists($nick);
14031 71         285 return $self->{state}{users}{uc_irc($nick)}{nick};
14032             }
14033             }
14034              
14035             sub state_user_uid {
14036 587     587 0 1315 my $self = shift;
14037 587   50     1797 my $nick = shift || return;
14038 587 100       2459 if ( $nick =~ m!^\d! ) {
14039 46 100       241 return if !$self->state_uid_exists($nick);
14040 42         201 return $self->{state}{uids}{$nick}{uid};
14041             }
14042             else {
14043 541 100       1588 return if !$self->state_nick_exists($nick);
14044 537         1917 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     98 return if !$self->state_nick_exists($nick)
14052             || !$self->_state_is_local_user($nick);
14053 22         406 my $record = $self->{state}{users}{uc_irc($nick)};
14054 22         302 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   37 my $self = shift;
14067 17   50     62 my $nick = shift || return;
14068 17 50       54 return if !$self->state_nick_exists($nick);
14069 17         68 return $self->{state}{users}{uc_irc($nick)}{away};
14070             }
14071              
14072             sub state_user_umode {
14073 77     77 1 245 my $self = shift;
14074 77   50     307 my $nick = shift || return;
14075 77 50       321 return if! $self->state_nick_exists($nick);
14076 77         339 return $self->{state}{users}{uc_irc($nick)}{umode};
14077             }
14078              
14079             sub state_user_is_operator {
14080 267     267 1 754 my $self = shift;
14081 267   50     903 my $nick = shift || return;
14082 267 50       991 return if !$self->state_nick_exists($nick);
14083 267 100       1188 return 0 if $self->{state}{users}{uc_irc($nick)}{umode} !~ /o/;
14084 60         1706 return 1;
14085             }
14086              
14087             sub _state_user_is_deaf {
14088 31     31   48 my $self = shift;
14089 31   50     85 my $nick = shift || return;
14090 31 50       67 return if !$self->state_nick_exists($nick);
14091 31 50       84 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 494 my $self = shift;
14097 117   50     451 my $nick = shift || return;
14098 117 50       445 return if !$self->state_nick_exists($nick);
14099 117         550 my $record = $self->{state}{users}{uc_irc($nick)};
14100 2         9 return map { $self->{state}{chans}{$_}{name} }
14101 117         1432 keys %{ $record->{chans} };
  117         813  
14102             }
14103              
14104             sub _state_user_route {
14105 448     448   1111 my $self = shift;
14106 448   50     1594 my $nick = shift || return;
14107 448 50       1771 return if !$self->state_nick_exists($nick);
14108 448         1799 my $record = $self->{state}{users}{uc_irc($nick)};
14109 448         6004 return $record->{route_id};
14110             }
14111              
14112             sub _state_uid_route {
14113 621     621   1193 my $self = shift;
14114 621   50     1531 my $uid = shift || return;
14115 621 50       1626 return if !$self->state_uid_exists($uid);
14116 621         1321 my $record = $self->{state}{uids}{ $uid };
14117 621         1818 return $record->{route_id};
14118             }
14119              
14120             sub state_user_server {
14121 1     1 1 3 my $self = shift;
14122 1   50     3 my $nick = shift || return;
14123 1 50       4 return if !$self->state_nick_exists($nick);
14124 1         5 my $record = $self->{state}{users}{uc_irc($nick)};
14125 1         13 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   79 my $self = shift;
14137 37   50     156 my $peer = shift || return;
14138 37 50       133 return if !$self->state_peer_exists($peer);
14139 37         357 my $record = $self->{state}{peers}{uc $peer};
14140 37         175 return $record->{route_id};
14141             }
14142              
14143             sub _state_sid_route {
14144 463     463   1283 my $self = shift;
14145 463   50     1663 my $sid = shift || return;
14146 463 50       1369 return if !$self->state_sid_exists($sid);
14147 463         1060 my $record = $self->{state}{sids}{$sid};
14148 463         2010 return $record->{route_id};
14149             }
14150              
14151             sub _state_connected_peers {
14152 2131     2131   5519 my $self = shift;
14153 2131         6159 my $server = uc $self->server_name();
14154 2131 50       4028 return if !keys %{ $self->{state}{peers} } > 1;
  2131         8553  
14155 2131         5350 my $record = $self->{state}{peers}{$server};
14156 3145         12085 return map { $record->{peers}{$_}{route_id} }
14157 2131         3959 keys %{ $record->{peers} };
  2131         7838  
14158             }
14159              
14160             sub state_chan_list {
14161 10     10 1 22 my $self = shift;
14162 10   50     35 my $chan = shift || return;
14163 10   50     77 my $status_msg = shift || '';
14164 10 50       40 return if !$self->state_chan_exists($chan);
14165              
14166 10         29 $status_msg =~ s/[^@%+]//g;
14167 10         37 my $record = $self->{state}{chans}{uc_irc($chan)};
14168 31         96 return map { $self->{state}{uids}{$_}{nick} }
14169 10 50       121 keys %{ $record->{users} } if !$status_msg;
  10         43  
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 264 my $self = shift;
14184 96   50     377 my $chan = shift || return;
14185 96         253 my $flag = shift;
14186 96 50       369 return if !$self->state_chan_exists($chan);
14187 96         537 my $record = $self->{state}{chans}{uc_irc($chan)};
14188              
14189             return map {
14190 171         492 my $n = $self->{state}{uids}{$_}{nick};
14191 171 100 66     1200 $n = (($flag && $flag eq 'FULL') ? $self->state_user_full($_) : $n );
14192 171         429 my $m = $record->{users}{$_};
14193 171         331 my $p = '';
14194 171 100       749 $p = '@' if $m =~ /o/;
14195 171 100 100     875 $p = '%' if $m =~ /h/ && !$p;
14196 171 50 66     631 $p = '+' if $m =~ /v/ && !$p;
14197 171         1076 $p . $n;
14198 96         1200 } keys %{ $record->{users} };
  96         493  
14199             }
14200              
14201             sub state_chan_list_multi_prefixed {
14202 71     71 0 172 my $self = shift;
14203 71   50     237 my $chan = shift || return;
14204 71         160 my $flag = shift;
14205 71 50       241 return if !$self->state_chan_exists($chan);
14206 71         241 my $record = $self->{state}{chans}{uc_irc($chan)};
14207              
14208             return map {
14209 1041         1772 my $rec = $self->{state}{uids}{$_};
14210 1041 100 100     2853 my $n = ( ($flag && $flag eq 'UIDS') ? $_ : $rec->{nick} );
14211 1041 100 100     2631 $n = (($flag && $flag eq 'FULL') ? $self->state_user_full($_) : $n );
14212 1041         2086 my $m = $record->{users}{$_};
14213 1041         1487 my $p = '';
14214 1041 100       2049 $p .= '@' if $m =~ /o/;
14215 1041 100       1828 $p .= '%' if $m =~ /h/;
14216 1041 100       1826 $p .= '+' if $m =~ /v/;
14217 1041         2332 $p . $n;
14218 71         802 } keys %{ $record->{users} };
  71         664  
14219             }
14220              
14221             sub _state_chan_timestamp {
14222 1     1   4 my $self = shift;
14223 1   50     6 my $chan = shift || return;
14224 1 50       4 return if !$self->state_chan_exists($chan);
14225 1         6 return $self->{state}{chans}{uc_irc($chan)}{ts};
14226             }
14227              
14228             sub state_chan_topic {
14229 57     57 1 154 my $self = shift;
14230 57   50     206 my $chan = shift || return;
14231 57 50       206 return if !$self->state_chan_exists($chan);
14232 57         269 my $record = $self->{state}{chans}{uc_irc($chan)};
14233 57 50       1047 return if !$record->{topic};
14234 0         0 return [@{ $record->{topic} }];
  0         0  
14235             }
14236              
14237             sub _state_is_local_user {
14238 29     29   82 my $self = shift;
14239 29   50     147 my $nick = shift || return;
14240 29         191 my $record = $self->{state}{sids}{uc $self->server_sid()};
14241 29 50       220 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 29 50       151 return if !$self->state_nick_exists($nick);
14247 29 100       141 return 1 if defined $record->{users}{uc_irc($nick)};
14248             }
14249 1         18 return 0;
14250             }
14251              
14252             sub _state_is_local_uid {
14253 3274     3274   4726 my $self = shift;
14254 3274   50     6065 my $uid = shift || return;
14255 3274 50       6089 return if !$self->state_uid_exists($uid);
14256 3274 100       5698 return 1 if $self->server_sid() eq substr( $uid, 0, 3 );
14257 3245         6063 return 0;
14258             }
14259              
14260             sub _state_chan_name {
14261 211     211   489 my $self = shift;
14262 211   50     766 my $chan = shift || return;
14263 211 50       727 return if !$self->state_chan_exists($chan);
14264 211         732 return $self->{state}{chans}{uc_irc($chan)}{name};
14265             }
14266              
14267             sub state_chan_mode_set {
14268 69     69 1 196 my $self = shift;
14269 69   50     315 my $chan = shift || return;
14270 69   50     293 my $mode = shift || return;
14271 69 50       265 return if !$self->state_chan_exists($chan);
14272              
14273 69         407 $mode =~ s/[^a-zA-Z]+//g;
14274 69 50       331 $mode = (split //, $mode )[0] if length $mode > 1;
14275 69         285 my $record = $self->{state}{chans}{uc_irc($chan)};
14276 69 100       1759 return 1 if $record->{mode} =~ /$mode/;
14277 65         359 return 0;
14278             }
14279              
14280             sub _state_user_invited {
14281 4     4   13 my $self = shift;
14282 4   50     12 my $nick = shift || return;
14283 4   50     12 my $chan = shift || return;
14284 4 50       13 return if !$self->state_nick_exists($nick);
14285 4 50       12 return 0 if !$self->state_chan_exists($chan);
14286 4         14 my $nickrec = $self->{state}{users}{uc_irc($nick)};
14287 4 100       51 return 1 if $nickrec->{invites}{uc_irc($chan)};
14288             # Check if user matches INVEX
14289 3 50       112 return 1 if $self->_state_user_matches_list($nick, $chan, 'invex');
14290 3         26 return 0;
14291             }
14292              
14293             sub _state_user_banned {
14294 69     69   204 my $self = shift;
14295 69   50     245 my $nick = shift || return;
14296 69   50     259 my $chan = shift || return;
14297 69 50       330 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   176 my $self = shift;
14304 72   50     241 my $nick = shift || return;
14305 72   50     274 my $chan = shift || return;
14306 72   50     405 my $list = shift || 'bans';
14307 72 50       223 return if !$self->state_nick_exists($nick);
14308 72 50       264 return 0 if !$self->state_chan_exists($chan);
14309 72         369 my $full = $self->state_user_full($nick);
14310 72         284 my $record = $self->{state}{chans}{uc_irc($chan)};
14311              
14312 72         893 for my $mask (keys %{ $record->{$list} }) {
  72         393  
14313 3 50       120 return 1 if matches_mask($mask, $full);
14314             }
14315 72         575 return 0;
14316             }
14317              
14318             sub state_is_chan_member {
14319 383     383 1 843 my $self = shift;
14320 383   50     1109 my $nick = shift || return;
14321 383   50     1046 my $chan = shift || return;
14322 383 50       1026 return if !$self->state_nick_exists($nick);
14323 383 50       1094 return 0 if !$self->state_chan_exists($chan);
14324 383         1192 my $record = $self->{state}{users}{uc_irc($nick)};
14325 383 100       4550 return 1 if defined $record->{chans}{uc_irc($chan)};
14326 72         1080 return 0;
14327             }
14328              
14329             sub state_uid_chan_member {
14330 2     2 0 7 my $self = shift;
14331 2   50     7 my $uid = shift || return;
14332 2   50     22 my $chan = shift || return;
14333 2 50       10 return if !$self->state_uid_exists($uid);
14334 2 50       11 return 0 if !$self->state_chan_exists($chan);
14335 2         10 my $record = $self->{state}{uids}{$uid};
14336 2 50       8 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 250 my $self = shift;
14349 64   50     205 my $nick = shift || return;
14350 64   50     260 my $chan = shift || return;
14351 64 50       287 return if !$self->state_is_chan_member($nick, $chan);
14352 64         982 my $record = $self->{state}{users}{uc_irc($nick)};
14353 64 100       903 return 1 if $record->{chans}{uc_irc($chan)} =~ /o/;
14354 14 50 33     209 return 1 if $self->{config}{OPHACKS} && $record->{umode} =~ /o/;
14355 14         78 return 0;
14356             }
14357              
14358             sub state_is_chan_hop {
14359 55     55 1 149 my $self = shift;
14360 55   50     287 my $nick = shift || return;
14361 55   50     207 my $chan = shift || return;
14362 55 50       212 return if !$self->state_is_chan_member($nick, $chan);
14363 55         817 my $record = $self->{state}{users}{uc_irc($nick)};
14364 55 100       697 return 1 if $record->{chans}{uc_irc($chan)} =~ /h/;
14365 34         552 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   71 my $self = shift;
14380 25   50     125 my $nick = shift || return;
14381 25         207 my ($user, $pass) = @_;
14382 25 50       186 return if !$self->state_nick_exists($nick);
14383 25 50 33     272 return if !$user || !$pass;
14384              
14385 25         103 my $ops = $self->{config}{ops};
14386 25 100       124 return if !$ops->{$user};
14387 24 50       168 return -1 if !chkpasswd ($pass, $ops->{$user}{password});
14388              
14389 24 100       173996 if ($ops->{$user}{ssl_required}) {
14390 6 100       42 return -2 if $self->{state}{users}{uc_irc $nick}{umode} !~ /S/;
14391             }
14392              
14393 23 100       271 if ($ops->{$user}{certfp}) {
14394 4         21 my $certfp = $self->{state}{users}{uc_irc $nick}{certfp};
14395 4 100 66     95 if (!$certfp || uc($certfp) ne uc($ops->{$user}{certfp})) {
14396 1         3 return -3;
14397             }
14398             }
14399              
14400 22         227 my $client_ip = $self->_state_user_ip($nick);
14401 22 50       115 return if !$client_ip;
14402 22 50 33     342 if (!$ops->{$user}{ipmask} && ($client_ip && $client_ip =~ /^(127\.|::1)/)) {
      33        
14403 22         99 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   87 my $self = shift;
14436 38   50     138 my $targets = shift || return;
14437 38         99 my %results;
14438              
14439 38         164 for my $target (split /,/, $targets) {
14440 38 100       172 if ($target =~ /^[#&]/) {
14441 18         91 $results{$target} = ['channel'];
14442 18         54 next;
14443             }
14444 20 50       81 if ($target =~ /^([@%+]+)([#&].+)$/ ) {
14445 0         0 $results{$target} = ['channel_ext', $1, $2];
14446 0         0 next;
14447             }
14448 20 100       64 if ( $target =~ /^\$([^#].+)$/ ) {
14449 1         7 $results{$target} = ['servermask', $1];
14450 1         4 next;
14451             }
14452 19 100       59 if ( $target =~ /^\$#(.+)$/ ) {
14453 1         6 $results{$target} = ['hostmask', $1];
14454 1         3 next;
14455             }
14456 18 50       66 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       141 if ($target =~ $uid_re) {
14464 4         22 $results{$target} = ['uid'];
14465 4         27 next;
14466             }
14467 14         80 $results{$target} = ['nick'];
14468             }
14469              
14470 38         135 return \%results;
14471             }
14472              
14473             sub server_name {
14474 13987     13987 1 44833 return $_[0]->{config}{'SERVERNAME'};
14475             }
14476              
14477             sub server_version {
14478 233     233 1 958 return $_[0]->{config}{'VERSION'};
14479             }
14480              
14481             sub server_sid {
14482 9287     9287 0 27345 return $_[0]->{config}{'SID'};
14483             }
14484              
14485             sub server_created {
14486 227     227 1 1502 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   6810 my $self = shift;
14492 3834   50     9063 my $wheel_id = $_[0] || return;
14493 3834 100       12013 return '*' if !$self->{state}{conns}{$wheel_id}{nick};
14494 3616         9613 return $self->{state}{conns}{$wheel_id}{nick};
14495             }
14496              
14497             sub _client_uid {
14498 801     801   1731 my $self = shift;
14499 801   50     2541 my $wheel_id = $_[0] || return;
14500 801 50       3138 return '*' if !$self->{state}{conns}{$wheel_id}{uid};
14501 801         2247 return $self->{state}{conns}{$wheel_id}{uid};
14502             }
14503              
14504             sub _client_ip {
14505 240     240   775 my $self = shift;
14506 240   50     1134 my $wheel_id = shift || return '';
14507 240         2593 return $self->{state}{conns}{$wheel_id}{socket}[0];
14508             }
14509              
14510             sub server_config {
14511 1308     1308 1 2902 my $self = shift;
14512 1308   50     3818 my $value = shift || return;
14513 1308         30649 return $self->{config}{uc $value};
14514             }
14515              
14516             sub configure {
14517 184     184 1 5703 my $self = shift;
14518 184 100       1616 my $opts = ref $_[0] eq 'HASH' ? $_[0] : { @_ };
14519 184         2177 $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         815 VERSION => do {
14527 182     182   3833 no strict 'vars';
  182         646  
  182         1691144  
14528 184 50       8141 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         5654 $self->{config}{$_} = $defaults{$_} for keys %defaults;
14575              
14576 184         1275 for my $opt (qw(HOSTLEN NICKLEN USERLEN REALLEN TOPICLEN CHANNELLEN
14577             PASSWDLEN KEYLEN MAXCHANNELS MAXACCEPT MODES MAXTARGETS MAXBANS)) {
14578 2392         4050 my $new = delete $opts->{$opt};
14579 2392 50 33     5924 if (defined $new && $new > $self->{config}{$opt}) {
14580 0         0 $self->{config}{$opt} = $new;
14581             }
14582             }
14583              
14584 184         682 for my $opt (qw(KICKLEN AWAYLEN)) {
14585 368         894 my $new = delete $opts->{$opt};
14586 368 50 33     1421 if (defined $new && $new < $self->{config}{$opt}) {
14587 0         0 $self->{config}{$opt} = $new;
14588             }
14589             }
14590              
14591 184         753 for my $opt (keys %$opts) {
14592 471 100       2850 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       936 if defined $opts->{$opt};
14595             }
14596              
14597 184         1029 $self->{config}{oper_umode} =~ s/[^DFGHRSWXabcdefgijklnopqrsuwy]+//g;
14598 184         709 $self->{config}{oper_umode} =~ s/[SWori]+//g;
14599              
14600 184         683 for my $opt (keys %$opts) {
14601 344 50       1530 $self->{config}{$opt} = $opts->{$opt} if defined $opts->{$opt};
14602             }
14603              
14604             {
14605 184         485 my $sid = delete $self->{config}{SID};
  184         606  
14606 184 100 66     2714 if (!$sid || $sid !~ $sid_re) {
14607 2         153 warn "No SID or SID is invalid, generating a random one\n";
14608 2         31 $self->_state_rand_sid();
14609             }
14610             else {
14611 182         978 $self->{config}{SID} = uc $sid;
14612             }
14613             }
14614              
14615             $self->{config}{BANLEN}
14616 184         554 = sum(@{ $self->{config} }{qw(NICKLEN USERLEN HOSTLEN)}, 3);
  184         1827  
14617             $self->{config}{USERHOST_REPLYLEN}
14618 184         617 = sum(@{ $self->{config} }{qw(NICKLEN USERLEN HOSTLEN)}, 5);
  184         2443  
14619              
14620 184         951 $self->{config}{SERVERNAME} =~ s/[^a-zA-Z0-9\-.]//g;
14621 184 50       1395 if ($self->{config}{SERVERNAME} !~ /\./) {
14622 0         0 $self->{config}{SERVERNAME} .= '.';
14623             }
14624              
14625 184 0 33     1563 if (!defined $self->{config}{ADMIN}
      33        
14626             || ref $self->{config}{ADMIN} ne 'ARRAY'
14627 0         0 || @{ $self->{config}{ADMIN} } != 3) {
14628 184         661 $self->{config}{ADMIN} = [];
14629 184         685 $self->{config}{ADMIN}[0] = 'Somewhere, Somewhere, Somewhere';
14630 184         615 $self->{config}{ADMIN}[1] = 'Some Institution';
14631 184         619 $self->{config}{ADMIN}[2] = 'someone@somewhere';
14632             }
14633              
14634 184 0 33     1237 if (!defined $self->{config}{INFO}
      33        
14635             || ref $self->{config}{INFO} ne 'ARRAY'
14636 0         0 || !@{ $self->{config}{INFO} } == 1) {
14637 184         1960 $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         17810 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         1972 map { ($_, $self->{config}{$_}) }
  1656         6608  
14738             qw(MAXCHANNELS MAXTARGETS NICKLEN TOPICLEN KICKLEN CASEMAPPING
14739             NETWORK MODES AWAYLEN),
14740             };
14741              
14742 184         1572 $self->{config}{capab} = [qw(KNOCK DLN TBURST UNDLN ENCAP UNKLN KLN RHOST SVS CLUSTER EOB QS)];
14743              
14744 184         15808 $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         1662 return 1;
14751             }
14752              
14753             sub _send_to_realops {
14754 2157     2157   4875 my $self = shift;
14755 2157   50     6255 my $msg = shift || return;
14756 2157   100     5847 my $type = shift || 'Notice';
14757 2157         3958 my $flags = shift; # Future use
14758 2157         5532 my $server = $self->server_name();
14759 2157 100       9236 $flags =~ s/[^a-zA-Z]+//g if $flags;
14760              
14761 2157         10057 my %types = (
14762             NOTICE => 'Notice',
14763             LOCOPS => 'LocOps',
14764             GLOBOPS => 'Global',
14765             );
14766              
14767             my $notice =
14768 2157   50     11523 sprintf('*** %s -- %s', ( $types{uc $type} || 'Notice' ), $msg );
14769              
14770 2157         4345 my @locops;
14771              
14772 2157 100       5500 if ( $flags ) {
14773 37         643 @locops = grep { $self->{state}{conns}{$_}{umode} =~ m![$flags]! }
14774 2101         3664 keys %{ $self->{state}{localops} };
  2101         7483  
14775             }
14776             else {
14777 56         149 @locops = keys %{ $self->{state}{localops} };
  56         326  
14778             }
14779              
14780 2157         9983 $self->send_event( 'daemon_snotice', $notice );
14781              
14782 2157         298120 $self->send_output(
14783             {
14784             prefix => $server,
14785             command => 'NOTICE',
14786             params => [
14787             '*',
14788             $notice,
14789             ],
14790             },
14791             @locops,
14792             );
14793 2157         9255 return 1;
14794             }
14795              
14796             sub _send_output_to_client {
14797 2491     2491   5506 my $self = shift;
14798 2491   50     6488 my $wheel_id = shift || return 0;
14799 2491         6248 my $nick = $self->_client_nickname($wheel_id);
14800 2491         5955 my $prefix = $self->server_name();
14801 2491 100       6298 if ( $self->_connection_is_peer($wheel_id) ) {
14802 34         61 $nick = shift;
14803 34         68 $prefix = $self->server_sid();
14804             }
14805 2491   50     6384 my $err = shift || return 0;
14806 2491 50       5373 return if !$self->_connection_exists($wheel_id);
14807              
14808             SWITCH: {
14809 2491 100       4300 if (ref $err eq 'HASH') {
  2491         6794  
14810 2428         9241 $self->send_output($err, $wheel_id);
14811 2428         5474 last SWITCH;
14812             }
14813 63 50       424 if (defined $self->{Error_Codes}{$err}) {
14814 63         288 my $input = {
14815             command => $err,
14816             prefix => $self->server_name(),
14817             params => [$nick],
14818             };
14819 63 100       356 if ($self->{Error_Codes}{$err}[0] > 0) {
14820 41         212 for (my $i = 1; $i <= $self->{Error_Codes}{$err}[0]; $i++) {
14821 41         97 push @{ $input->{params} }, shift;
  41         194  
14822             }
14823             }
14824 63 100       432 if ($self->{Error_Codes}{$err}[1] =~ /%/) {
14825 6         52 push @{ $input->{params} },
14826 6         22 sprintf($self->{Error_Codes}{$err}[1], @_);
14827             }
14828             else {
14829 57         155 push @{ $input->{params} }, $self->{Error_Codes}{$err}[1];
  57         226  
14830             }
14831 63         453 $self->send_output($input, $wheel_id);
14832             }
14833             }
14834              
14835 2491         6524 return 1;
14836             }
14837              
14838             sub _send_output_channel_local {
14839 202     202   473 my $self = shift;
14840 202   50     766 my $channel = shift || return;
14841 202 50       698 return if !$self->state_chan_exists($channel);
14842 202         821 my ($output,$conn_id,$status,$poscap,$negcap) = @_;
14843 202 50       640 return if !$output;
14844 202         544 my $sid = $self->server_sid();
14845              
14846 202 100       838 my $is_msg = ( $output->{command} =~ m!^(PRIVMSG|NOTICE)$! ? 1 : 0 );
14847 202         609 my $chanrec = $self->{state}{chans}{uc_irc($channel)};
14848 202         2412 my @targs;
14849 202 100       714 my $negative = ( $status ? $status =~ s!^\-!! : '' );
14850 202         398 UID: foreach my $uid ( keys %{ $chanrec->{users} } ) {
  202         1032  
14851 776 100       4110 next if $uid !~ m!^$sid!;
14852 437         1290 my $route_id = $self->_state_uid_route( $uid );
14853 437 100 100     1852 if ( $conn_id && $conn_id eq $route_id ) {
14854 127         380 next UID;
14855             }
14856 310 100       812 if ( $status ) {
14857 21         37 my $matched;
14858 21         58 STATUS: foreach my $stat ( split //, $status ) {
14859 42 100       382 $matched++ if $chanrec->{users}{$uid} =~ m!$stat!;
14860             }
14861 21 100 100     154 next UID if ( $negative && $matched ) || ( !$negative && !$matched );
      100        
      100        
14862             }
14863 301 100       894 if ( $poscap ) {
14864 89 50       222 foreach my $cap ( @{ ref $poscap eq 'ARRAY' ? $poscap : [ $poscap ] } ) {
  89         496  
14865 89 100       460 next UID if !$self->{state}{uids}{$uid}{caps}{$cap};
14866             }
14867             }
14868 225 100       564 if ( $negcap ) {
14869 91 100       172 foreach my $cap ( @{ ref $negcap eq 'ARRAY' ? $negcap : [ $negcap ] } ) {
  91         469  
14870 94 100       495 next UID if $self->{state}{uids}{$uid}{caps}{$cap};
14871             }
14872             }
14873 210 50 66     737 if ( $is_msg && $self->{state}{uids}{$uid}{umode} =~ m!D! ) { # +D 'deaf'
14874 0         0 next UID;
14875             }
14876             # Default
14877 210         634 push @targs, $route_id;
14878             }
14879              
14880 202         1049 $self->send_output($output,@targs);
14881              
14882 202         513 my $spoofs = grep { $_ eq 'spoofed' } @targs;
  210         684  
14883              
14884             $self->send_event(
14885             "daemon_" . lc $output->{command},
14886             $output->{prefix},
14887 202 100 66     1571 @{ $output->{params} },
  196         1126  
14888             ) if !$is_msg || $spoofs;
14889              
14890 202         24662 return 1;
14891             }
14892              
14893             sub _duration {
14894 227     227   599 my $duration = shift;
14895 227 50 33     2872 $duration = 0 if !defined $duration || $duration !~ m!^\d+$!;
14896 227         590 my $timestr;
14897 227         728 my $days = my $hours = my $mins = my $secs = 0;
14898 227         901 while ($duration >= 60 * 60 * 24) {
14899 0         0 $duration -= 60 * 60 * 24;
14900 0         0 ++$days;
14901             }
14902 227         943 while ($duration >= 60 * 60) {
14903 0         0 $duration -= 60 * 60;
14904 0         0 ++$hours;
14905             }
14906 227         863 while ($duration >= 60) {
14907 0         0 $duration -= 60;
14908 0         0 ++$mins;
14909             }
14910 227         641 $secs = $duration;
14911 227 50       3587 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 317 my $self = shift;
14919 30         84 my $ref;
14920 30 50       247 if (ref $_[0] eq 'HASH') {
14921 30         98 $ref = $_[0];
14922             }
14923             else {
14924 0         0 $ref = { @_ };
14925             }
14926 30         283 $ref->{lc $_} = delete $ref->{$_} for keys %$ref;
14927              
14928 30 50 33     326 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     435 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     158 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       169 if ( $ref->{umode} ) {
14953 28         146 $ref->{umode} =~ s/[^DFGHRSWXabcdefgijklnopqrsuwy]+//g;
14954 28         135 $ref->{umode} =~ s/[SWori]+//g;
14955             }
14956              
14957 30         194 my $record = $self->{state}{peers}{uc $self->server_name()};
14958 30         123 my $user = delete $ref->{username};
14959 30         123 $self->{config}{ops}{$user} = $ref;
14960 30         108 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 350 my $self = shift;
14973 46   50     261 my $host = shift || return;
14974 46         347 $self->{state}{services}{uc $host} = $host;
14975 46         154 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 2796 my $self = shift;
14987 6         13 my $parms;
14988 6 50       120 if (ref $_[0] eq 'HASH') {
14989 0         0 $parms = $_[0];
14990             }
14991             else {
14992 6         71 $parms = { @_ };
14993             }
14994 6         57 $parms->{lc $_} = delete $parms->{$_} for keys %$parms;
14995              
14996 6 50       27 if (!$parms->{mask}) {
14997 0         0 warn "Not enough parameters specified\n";
14998 0         0 return;
14999             }
15000 6         15 push @{ $self->{config}{auth} }, $parms;
  6         21  
15001 6         19 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 122957 my $self = shift;
15021 290         611 my $parms;
15022 290 50       1111 if (ref $_[0] eq 'HASH') {
15023 0         0 $parms = $_[0];
15024             }
15025             else {
15026 290         1671 $parms = { @_ };
15027             }
15028 290         2729 $parms->{lc $_} = delete $parms->{$_} for keys %$parms;
15029              
15030 290 50 33     3545 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     2696 $parms->{type} = 'c' if !$parms->{type} || lc $parms->{type} ne 'r';
15037 290         825 $parms->{type} = lc $parms->{type};
15038 290 50 66     1331 $parms->{rport} = 6667 if $parms->{type} eq 'r' && !$parms->{rport};
15039              
15040 290         788 for (qw(sockport sockaddr)) {
15041 580 50       2172 $parms->{ $_ } = '*' if !$parms->{ $_ };
15042             }
15043              
15044 290 100       1041 $parms->{ipmask} = $parms->{raddress} if $parms->{raddress};
15045 290 100       1630 $parms->{zip} = 0 if !$parms->{zip};
15046 290 100       2240 $parms->{ssl} = 0 if !$parms->{ssl};
15047              
15048 290 50 66     1339 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         793 my $name = $parms->{name};
15062 290         1253 $self->{config}{peers}{uc $name} = $parms;
15063 290 50       1017 $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     1100 ) if $parms->{type} eq 'r' && $parms->{auto};
15070              
15071 290         922 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 15 my $self = shift;
15085 2         3 my $parms;
15086 2 50       14 if (ref $_[0] eq 'HASH') {
15087 2         6 $parms = $_[0];
15088             }
15089             else {
15090 0         0 $parms = { @_ };
15091             }
15092 2         14 $parms->{lc $_} = delete $parms->{$_} for keys %$parms;
15093              
15094 2 50 33     23 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         9 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         5 $parms->{user} = $user;
15109 2         3 $parms->{host} = $host;
15110              
15111 2         5 my $cmd = delete $parms->{cmd};
15112 2         5 $cmd = uc $cmd;
15113              
15114 2 50 33     19 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         6 $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   669 my $self = shift;
15132 240   50     1011 my $conn_id = shift || return;
15133 240         624 my $msg = shift;
15134 240 50       1121 return if !$self->_connection_exists($conn_id);
15135              
15136 240         2486 $self->disconnect($conn_id, $msg);
15137 240         992 $self->{state}{conns}{$conn_id}{terminated} = 1;
15138 240 100       1592 if ( $self->{state}{conns}{$conn_id}{type} eq 'c' ) {
15139 205         627 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         2665 $conn->{socket}[0],
15147             $msg,
15148             ),
15149             'Notice',
15150             'c',
15151             );
15152             }
15153             $self->send_output(
15154             {
15155 240         1655 command => 'ERROR',
15156             params => [
15157             'Closing Link: ' . $self->_client_ip($conn_id)
15158             . ' (' . $msg . ')',
15159             ],
15160             },
15161             $conn_id,
15162             );
15163              
15164 240         953 foreach my $nick ( keys %{ $self->{state}{pending} }) {
  240         1424  
15165 19         61 my $id = $self->{state}{pending}{$nick};
15166 19 50       101 if ($id == $conn_id) {
15167 19         72 delete $self->{state}{pending}{$nick};
15168 19         67 last;
15169             }
15170             }
15171              
15172 240         716 return 1;
15173             }
15174              
15175             sub daemon_server_join {
15176 4     4 1 13106 my $self = shift;
15177 4         19 my $server = $self->server_name();
15178 4         18 my $mysid = $self->server_sid();
15179 4         11 my $ref = [ ];
15180 4         15 my $args = [ @_ ];
15181 4         11 my $count = @$args;
15182              
15183             SWITCH: {
15184 4 50 33     10 if (!$count || $count < 2) {
  4         34  
15185 0         0 last SWITCH;
15186             }
15187 4 50 33     55 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       22 if ( $args->[1] !~ m!^[#&]! ) {
15194 0         0 last SWITCH;
15195             }
15196 4         40 $ref = $self->_daemon_peer_svsjoin( 'spoofed', $mysid, @$args );
15197             }
15198              
15199 4 50       14 return @$ref if wantarray;
15200 4         15 return $ref;
15201             }
15202              
15203             sub daemon_server_kill {
15204 7     7 1 43 my $self = shift;
15205 7         52 my $server = $self->server_name();
15206 7         25 my $mysid = $self->server_sid();
15207 7         27 my $ref = [ ];
15208 7         30 my $args = [ @_ ];
15209 7         20 my $count = @$args;
15210              
15211             SWITCH: {
15212 7 50       35 if (!$count) {
  7         49  
15213 0         0 last SWITCH;
15214             }
15215 7 50 33     90 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 7         45 my $target = $self->state_user_nick($args->[0]);
15224 7   50     32 my $comment = $args->[1] || '';
15225 7 100 66     62 my $conn_id = ($args->[2] && $self->_connection_exists($args->[2])
15226             ? $args->[2]
15227             : '');
15228              
15229 7 100       42 if ($self->_state_is_local_user($target)) {
15230 6         113 my $route_id = $self->_state_user_route($target);
15231 6         69 $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       58 grep { !$conn_id || $_ ne $conn_id }
  9         70  
15249             $self->_state_connected_peers(),
15250             );
15251 6 100       64 if ($route_id eq 'spoofed') {
15252 3         42 $self->call(
15253             'del_spoofed_nick',
15254             $target,
15255             "Killed ($server ($comment))",
15256             );
15257             }
15258             else {
15259 3         19 $self->{state}{conns}{$route_id}{killed} = 1;
15260 3         41 $self->_terminate_conn_error(
15261             $route_id,
15262             "Killed ($server ($comment))",
15263             );
15264             }
15265             }
15266             else {
15267 1         6 my $tuid = $self->state_user_uid( $target );
15268 1         20 $self->{state}{uids}{$tuid}{killed} = 1;
15269             $self->send_output(
15270             {
15271             prefix => $mysid,
15272             command => 'KILL',
15273             params => [$tuid, "$server ($comment)"],
15274             },
15275 1 50       10 grep { !$conn_id || $_ ne $conn_id }
  2         14  
15276             $self->_state_connected_peers(),
15277             );
15278             $self->send_output(
15279 1         6 @{ $self->_daemon_peer_quit(
  1         10  
15280             $tuid,
15281             "Killed ($server ($comment))"
15282             ) });
15283             }
15284             }
15285              
15286 7 50       59 return @$ref if wantarray;
15287 7         36 return $ref;
15288             }
15289              
15290             sub daemon_server_mode {
15291 10     10 1 32973 my $self = shift;
15292 10         25 my $chan = shift;
15293 10         30 my $server = $self->server_name();
15294 10         26 my $sid = $self->server_sid();
15295 10         24 my $ref = [ ];
15296 10         24 my $args = [ @_ ];
15297 10         22 my $count = @$args;
15298              
15299             SWITCH: {
15300 10 50       17 if (!$self->state_chan_exists($chan)) {
  10         30  
15301 0         0 last SWITCH;
15302             }
15303 10         49 my $record = $self->{state}{chans}{uc_irc($chan)};
15304 10         118 $chan = $record->{name};
15305 10         49 my $mode_u_set = ( $record->{mode} =~ /u/ );
15306 10         18 my $full = $server;
15307 10         35 my %subs; my @reply_args; my $reply;
  10         0  
15308 10         32 my $parsed_mode = parse_mode_line(@$args);
15309              
15310 10         561 while(my $mode = shift (@{ $parsed_mode->{modes} })) {
  23         78  
15311 13 50       48 next if $mode !~ /^[+-][CceIbkMNRSTLOlimnpstohuv]$/;
15312 13         25 my $arg;
15313 13 100       65 if ($mode =~ /^(\+[ohvklbIe]|-[ohvbIe])/) {
15314 3         6 $arg = shift @{ $parsed_mode->{args} };
  3         12  
15315             }
15316 13 100       57 if (my ($flag, $char) = $mode =~ /^([-+])([ohv])/ ) {
15317              
15318 2 50 33     18 if ($flag eq '+'
15319             && $record->{users}{$self->state_user_uid($arg)} !~ /$char/) {
15320             # Update user and chan record
15321 2         57 $arg = $self->state_user_uid($arg);
15322             $record->{users}{$arg} = join('', sort
15323 2         55 split //, $record->{users}{$arg} . $char);
15324             $self->{state}{uids}{$arg}{chans}{uc_irc($chan)}
15325 2         16 = $record->{users}{$arg};
15326 2         26 $reply .= $mode;
15327 2         9 my $anick = $self->state_user_nick($arg);
15328 2         6 $subs{$anick} = $arg;
15329 2         8 push @reply_args, $anick;
15330             }
15331              
15332 2 50 33     25 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         8 next;
15345             }
15346 11 0 33     35 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     32 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     33 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       43 if (my ($flag) = $mode =~ /(\+|-)b/) {
15381 1         10 my $mask = normalize_mask($arg);
15382 1         44 my $umask = uc_irc($mask);
15383 1 50 33     23 if ($flag eq '+' && !$record->{bans}{$umask}) {
15384 1   33     8 $record->{bans}{$umask}
15385             = [$mask, ($full || $server), time];
15386 1         3 $reply .= $mode;
15387 1         4 push @reply_args, $mask;
15388             }
15389 1 0 33     4 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       29 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       31 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         35 my ($flag, $char) = split //, $mode;
15432 10 100 66     110 if ($flag eq '+' && $record->{mode} !~ /$char/) {
15433             $record->{mode} = join('', sort split //,
15434 7         53 $record->{mode} . $char);
15435 7         19 $reply .= $mode;
15436 7         18 next;
15437             }
15438 3 50 33     60 if ($flag eq '-' && $record->{mode} =~ /$char/) {
15439 3         27 $record->{mode} =~ s/$char//g;
15440 3         8 $reply .= $mode;
15441 3         8 next;
15442             }
15443             } # while
15444              
15445 10 50       45 if ($reply) {
15446 10         36 $reply = unparse_mode_line($reply);
15447             my @reply_args_peer = map {
15448 10 100       302 ( defined $subs{$_} ? $subs{$_} : $_ )
  3         22  
15449             } @reply_args;
15450             $self->send_output(
15451             {
15452             prefix => $sid,
15453             command => 'TMODE',
15454 10         85 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       109 $reply,
15468             @reply_args,
15469             ],
15470             },
15471             '', ( $mode_u_set ? 'oh' : '' ),
15472             );
15473 10 100       67 if ($mode_u_set) {
15474 2         20 my $bparse = parse_mode_line( $reply, @reply_args );
15475 2         124 my $breply; my @breply_args;
15476 2         4 while (my $bmode = shift (@{ $bparse->{modes} })) {
  4         12  
15477 2         4 my $arg;
15478 2 100       10 $arg = shift @{ $bparse->{args} }
  1         4  
15479             if $bmode =~ /^(\+[ohvklbIe]|-[ohvbIe])/;
15480 2 100       9 next if $bmode =~ m!^[+-][beI]$!;
15481 1         3 $breply .= $bmode;
15482 1 50       4 push @breply_args, $arg if $arg;
15483             }
15484 2 100       11 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       43 return @$ref if wantarray;
15506 10         37 return $ref;
15507             }
15508              
15509             sub daemon_server_kick {
15510 2     2 1 9719 my $self = shift;
15511 2         13 my $server = $self->server_name();
15512 2         11 my $sid = $self->server_sid();
15513 2         6 my $ref = [ ];
15514 2         6 my $args = [ @_ ];
15515 2         7 my $count = @$args;
15516              
15517             SWITCH: {
15518 2 50 33     5 if (!$count || $count < 2) {
  2         18  
15519 0         0 last SWITCH;
15520             }
15521 2         14 my $chan = (split /,/, $args->[0])[0];
15522 2         9 my $who = (split /,/, $args->[1])[0];
15523 2 50       9 if (!$self->state_chan_exists($chan)) {
15524 0         0 last SWITCH;
15525             }
15526 2         18 $chan = $self->_state_chan_name($chan);
15527 2 50       37 if (!$self->state_nick_exists($who)) {
15528 0         0 last SWITCH;
15529             }
15530 2         12 $who = $self->state_user_nick($who);
15531 2 50       29 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     32 my $comment = $args->[2] || $who;
15536 2         17 $self->send_output(
15537             {
15538             prefix => $sid,
15539             command => 'KICK',
15540             params => [$chan, $wuid, $comment],
15541             },
15542             $self->_state_connected_peers(),
15543             );
15544 2         24 $self->_send_output_channel_local(
15545             $chan,
15546             {
15547             prefix => $server,
15548             command => 'KICK',
15549             params => [$chan, $who, $comment],
15550             },
15551             );
15552 2         13 $chan = uc_irc($chan);
15553 2         33 delete $self->{state}{chans}{$chan}{users}{$wuid};
15554 2         9 delete $self->{state}{uids}{$wuid}{chans}{$chan};
15555 2 50       5 if (!keys %{ $self->{state}{chans}{$chan}{users} }) {
  2         33  
15556 0         0 delete $self->{state}{chans}{$chan};
15557             }
15558             }
15559              
15560 2 50       9 return @$ref if wantarray;
15561 2         8 return $ref;
15562             }
15563              
15564             sub daemon_server_remove {
15565 1     1 1 3361 my $self = shift;
15566 1         5 my $server = $self->server_name();
15567 1         3 my $ref = [ ];
15568 1         4 my $args = [ @_ ];
15569 1         3 my $count = @$args;
15570              
15571             SWITCH: {
15572 1 50 33     3 if (!$count || $count < 2) {
  1         8  
15573 0         0 last SWITCH;
15574             }
15575 1         5 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         3 $chan = $self->_state_chan_name($chan);
15581 1 50       13 if (!$self->state_nick_exists($who)) {
15582 0         0 last SWITCH;
15583             }
15584 1         4 my $fullwho = $self->state_user_full($who);
15585 1         5 $who = (split /!/, $who)[0];
15586 1 50       4 if (!$self->state_is_chan_member($who, $chan)) {
15587 0         0 last SWITCH;
15588             }
15589 1         17 my $wuid = $self->state_user_uid($who);
15590 1         17 my $comment = 'Enforced PART';
15591 1 50       6 $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         9 $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         10  
15612 1         4 delete $self->{state}{chans}{$chan};
15613             }
15614             }
15615              
15616 1 50       7 return @$ref if wantarray;
15617 1         4 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 24209 my ($kernel, $self) = @_[KERNEL, OBJECT];
15668 41         101 my $ref;
15669 41 50       277 if (ref $_[ARG0] eq 'HASH') {
15670 41         127 $ref = $_[ARG0];
15671             }
15672             else {
15673 0         0 $ref = { @_[ARG0..$#_] };
15674             }
15675              
15676 41         369 $ref->{ lc $_ } = delete $ref->{$_} for keys %$ref;
15677 41 50       269 return if !$ref->{nick};
15678 41 50       250 return if $self->state_nick_exists($ref->{nick});
15679 41         113 my $record = $ref;
15680 41         220 $record->{uid} = $self->_state_gen_uid();
15681 41         202 $record->{sid} = substr $record->{uid}, 0, 3;
15682 41 100       229 $record->{ts} = time if !$record->{ts};
15683 41         140 $record->{type} = 's';
15684 41         225 $record->{server} = $self->server_name();
15685 41         180 $record->{hops} = 0;
15686 41         147 $record->{route_id} = 'spoofed';
15687 41 50       182 $record->{umode} = 'i' if !$record->{umode};
15688 41 100       196 if (!defined $record->{ircname}) {
15689 31         173 $record->{ircname} = "* I'm too lame to read the documentation *";
15690             }
15691 41 100       264 $self->{state}{stats}{invisible}++ if $record->{umode} =~ /i/;
15692 41 100       278 $self->{state}{stats}{ops_online}++ if $record->{umode} =~ /o/;
15693 41         202 $record->{idle_time} = $record->{conn_time} = $record->{ts};
15694 41   33     439 $record->{auth}{ident} = delete $record->{user} || $record->{nick};
15695             $record->{auth}{hostname} = delete $record->{hostname}
15696 41   33     346 || $self->server_name();
15697 41         166 $record->{auth}{realhost} = $record->{auth}{hostname};
15698 41 50       267 $record->{account} = '*' if !$record->{account};
15699 41         160 $record->{ipaddress} = 0;
15700 41         276 $self->{state}{users}{uc_irc($record->{nick})} = $record;
15701 41 50       849 $self->{state}{uids}{ $record->{uid} } = $record if $record->{uid};
15702 41         299 $self->{state}{peers}{uc $record->{server}}{users}{uc_irc($record->{nick})} = $record;
15703 41 50       793 $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   786 $record->{auth}{hostname});
15710 41         986 };
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         351 ];
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         292 ];
15738              
15739 41 50       176 if (my $whois = $record->{whois}) {
15740 0         0 $record->{svstags}{313} = {
15741             numeric => '313',
15742             umodes => '+',
15743             tagline => $whois,
15744             };
15745             }
15746              
15747 41         230 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         349 $self->send_event('daemon_uid', @$arrayref);
15784 41   50     5489 $self->send_event('daemon_nick', @{ $arrayref }[0..5], $record->{server}, ( $arrayref->[9] || '' ) );
  41         350  
15785 41 100       4441 if ( $record->{umode} =~ /o/ ) {
15786 34         147 my $notice = sprintf("%s{%s} is now an operator",$record->{full}->(),$record->{nick});
15787 34         201 $self->_send_to_realops($notice);
15788             }
15789 41         229 $self->_state_update_stats();
15790 41         263 return;
15791             }
15792              
15793             sub del_spoofed_nick {
15794 9     9 1 4124 my ($kernel, $self, $nick) = @_[KERNEL, OBJECT, ARG0];
15795 9 50       73 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       38 return if !$self->state_nick_exists($nick);
15801 9 50       50 return if $self->_state_user_route($nick) ne 'spoofed';
15802             }
15803 9         41 $nick = $self->state_user_nick($nick);
15804              
15805 9   100     154 my $message = $_[ARG1] || 'Client Quit';
15806             $self->send_output(
15807 9         29 @{ $self->_daemon_cmd_quit($nick, qq{"$message"}) },
  9         70  
15808             qq{"$message"},
15809             );
15810 9         59 return;
15811             }
15812              
15813             sub _spoofed_command {
15814 31     31   83372 my ($kernel, $self, $state, $nick) = @_[KERNEL, OBJECT, STATE, ARG0];
15815 31 50       175 return if !$self->state_nick_exists($nick);
15816 31 50       197 return if $self->_state_user_route($nick) ne 'spoofed';
15817              
15818 31         153 $nick = $self->state_user_nick($nick);
15819 31         497 my $uid = $self->state_user_uid($nick);
15820 31         519 $state =~ s/daemon_cmd_//;
15821 31         116 my $command = "_daemon_cmd_" . $state;
15822              
15823 31 50       213 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         2 my $chan = $_[ARG1];
15830 1 50 33     6 return if !$chan || !$self->state_chan_exists($chan);
15831 1 50       9 return if $self->state_is_chan_member($nick, $chan);
15832 1         6 $chan = $self->_state_chan_name($chan);
15833 1         31 my $ts = $self->_state_chan_timestamp($chan) - 10;
15834 1         14 $self->_daemon_peer_sjoin(
15835             'spoofed',
15836             $self->server_sid(),
15837             $ts,
15838             $chan,
15839             '+nt',
15840             '@' . $uid,
15841             );
15842 1         5 return;
15843             }
15844              
15845 30 50       369 $self->$command($nick, @_[ARG1 .. $#_]) if $self->can($command);
15846 30         144 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