File Coverage

blib/lib/Convos/Core/Connection.pm
Criterion Covered Total %
statement 36 369 9.7
branch 1 98 1.0
condition 0 67 0.0
subroutine 12 75 16.0
pod 36 36 100.0
total 85 645 13.1


line stmt bran cond sub pod time code
1             package Convos::Core::Connection;
2              
3             =head1 NAME
4              
5             Convos::Core::Connection - Represents a connection to an IRC server
6              
7             =head1 SYNOPSIS
8              
9             use Convos::Core::Connection;
10              
11             $c = Convos::Core::Connection->new(
12             name => 'magnet',
13             login => 'username',
14             redis => Mojo::Redis->new,
15             );
16              
17             $c->connect;
18              
19             Mojo::IOLoop->start;
20              
21             =head1 DESCRIPTION
22              
23             This module use L to up a connection to an IRC server. The
24             attributes used to do so is figured out from a redis server.
25              
26             There are quite a few L that this module use:
27              
28             =over 4
29              
30             =item * L events
31              
32             L.
33              
34             =item * L events
35              
36             L, L, L,
37             L, L and L.
38              
39             =item * Other events
40              
41             L, L, L, L,
42             L, L, L, L
43             L, l and L.
44              
45             =back
46              
47             =cut
48              
49 36     36   151 use Mojo::Base 'Mojo::EventEmitter';
  36         267  
  36         179  
50 36     36   21474 use Mojo::IRC;
  36         1352979  
  36         442  
51 36     36   1238 use Mojo::JSON 'j';
  36         57  
  36         1898  
52 36     36   161 no warnings 'utf8';
  36         53  
  36         1007  
53 36     36   138 use IRC::Utils;
  36         63  
  36         1024  
54 36     36   144 use Parse::IRC ();
  36         53  
  36         495  
55 36     36   125 use Scalar::Util ();
  36         49  
  36         514  
56 36     36   136 use Time::HiRes 'time';
  36         47  
  36         302  
57 36     36   18371 use Convos::Core::Util qw( as_id id_as );
  36         89  
  36         2295  
58 36     36   17310 use Sys::Hostname ();
  36         31131  
  36         817  
59 36     36   184 use constant CHANNEL_LIST_CACHE_TIMEOUT => 3600; # TODO: Figure out how long to cache channel list
  36         46  
  36         2330  
60 36 50   36   154 use constant DEBUG => $ENV{CONVOS_DEBUG} ? 1 : 0;
  36         55  
  36         212558  
61              
62             =head1 ATTRIBUTES
63              
64             =head2 name
65              
66             Name of the connection. Example: "freenode", "magnet" or "efnet".
67              
68             =head2 log
69              
70             Holds a L object.
71              
72             =head2 login
73              
74             The username of the owner.
75              
76             =head2 redis
77              
78             Holds a L object.
79              
80             =cut
81              
82             has name => '';
83             has log => sub { Mojo::Log->new };
84             has login => 0;
85             has redis => sub { die 'redis connection required in constructor' };
86              
87             my @ADD_MESSAGE_EVENTS = qw( irc_privmsg ctcp_action irc_notice );
88             my @ADD_SERVER_MESSAGE_EVENTS = qw(
89             irc_rpl_yourhost irc_rpl_motdstart irc_rpl_motd irc_rpl_endofmotd
90             irc_rpl_welcome rpl_luserclient
91             );
92             my @OTHER_EVENTS = qw(
93             irc_rpl_welcome irc_rpl_myinfo irc_join irc_nick irc_part irc_479
94             irc_rpl_whoisuser irc_rpl_whoisidle irc_rpl_whoischannels irc_rpl_endofwhois
95             irc_rpl_topic irc_topic
96             irc_rpl_topicwhotime irc_rpl_notopic err_nosuchchannel err_nosuchnick
97             err_notonchannel err_bannedfromchan irc_rpl_list
98             irc_rpl_listend irc_mode irc_quit irc_kick irc_error
99             irc_rpl_namreply irc_rpl_endofnames err_nicknameinuse
100             );
101              
102             has _irc => sub {
103             my $self = shift;
104             my $irc = Mojo::IRC->new(debug_key => join ':', $self->login, $self->name);
105              
106             $irc->parser(Parse::IRC->new(ctcp => 1));
107              
108             Scalar::Util::weaken($self);
109             $irc->register_default_event_handlers;
110             $irc->on(close => sub { $self->_irc_close });
111             $irc->on(error => sub { $self->_irc_error($_[1]) });
112              
113             for my $event (@ADD_MESSAGE_EVENTS) {
114             $irc->on($event => sub { $self->add_message($_[1]) });
115             }
116             for my $event (@ADD_SERVER_MESSAGE_EVENTS) {
117             $irc->on($event => sub { $self->add_server_message($_[1]) });
118             }
119             for my $event (@OTHER_EVENTS) {
120             $irc->on($event => sub { $_[1]->{handled}++ or $self->$event($_[1]) });
121             }
122              
123             $irc;
124             };
125              
126             sub _irc_close {
127 0     0     my $self = shift;
128 0           my $name = $self->_irc->name;
129              
130 0           $self->_state('disconnected');
131              
132 0 0         if ($self->{stop}) {
133 0           $self->_publish_and_save(server_message => {status => 200, message => 'Disconnected.'});
134 0           return;
135             }
136              
137 0           $self->_publish_and_save(server_message => {status => 500, message => "Disconnected from $name."});
138 0           $self->_reconnect;
139             }
140              
141             sub _irc_error {
142 0     0     my ($self, $error) = @_;
143 0           my $name = $self->_irc->name;
144              
145 0 0         $self->{stop} and return $self->_state('disconnected');
146 0           $self->_state('disconnected');
147 0           $self->_publish_and_save(server_message => {status => 500, message => "Connection to $name failed: $error"});
148 0           $self->_reconnect;
149             }
150              
151             =head1 METHODS
152              
153             =head2 new
154              
155             Checks for mandatory attributes: L and L.
156              
157             =cut
158              
159             sub new {
160 0     0 1   my $self = shift->SUPER::new(@_);
161              
162 0 0         $self->{login} or die "login is required";
163 0 0         $self->{name} or die "name is required";
164 0           $self->{conversation_path} = "user:$self->{login}:conversations";
165 0           $self->{path} = "user:$self->{login}:connection:$self->{name}";
166 0           $self->{state} = 'disconnected';
167 0           $self;
168             }
169              
170             =head2 connect
171              
172             $self = $self->connect;
173              
174             This method will create a new L object with attribute data from
175             L. The values fetched from the backend is identified by L and
176             L. This method then call L after the object is set
177             up.
178              
179             Attributes fetched from backend: nick, user, host and channels. The latter
180             is set in L and used by L.
181              
182             =cut
183              
184             sub connect {
185 0     0 1   my ($self) = @_;
186 0           my $irc = $self->_irc;
187              
188 0           Scalar::Util::weaken($self);
189 0           $self->{core_connect_timer} = 0;
190 0   0 0     $self->{keepnick_tid} ||= $irc->ioloop->recurring(60 => sub { $self->_steal_nick });
  0            
191 0           $self->_subscribe;
192              
193             $self->redis->execute(
194             [hgetall => $self->{path}],
195             [get => 'convos:frontend:url'],
196             sub {
197 0     0     my ($redis, $args, $url) = @_;
198 0 0         $self->redis->hset($self->{path} => tls => $self->{disable_tls} ? 0 : 1);
199 0   0       $irc->name($url || 'Convos');
200 0   0       $irc->nick($args->{nick} || $self->login);
201 0 0         $irc->pass($args->{password}) if $args->{password};
202 0   0       $irc->server($args->{server} || $args->{host});
203 0 0         $irc->tls($self->{disable_tls} ? undef : {});
204 0   0       $irc->user($args->{username} || $self->login);
205             $irc->connect(
206             sub {
207 0           my ($irc, $error) = @_;
208 0 0         $error and return $self->_connect_failed($error);
209 0           $self->_publish_and_save(server_message => {status => 200, message => "Connected to IRC server"});
210 0           $self->_state('connected');
211             },
212 0           );
213             },
214 0           );
215              
216 0           $self;
217             }
218              
219             sub _state {
220 0     0     my ($self, $state) = @_;
221              
222 0           $self->{state} = $state;
223 0           $self->redis->hset($self->{path}, state => $state);
224 0           $self;
225             }
226              
227             sub _steal_nick {
228 0     0     my $self = shift;
229              
230             # We will try to "steal" the nich we really want every 60 second
231             Mojo::IOLoop->delay(
232             sub {
233 0     0     my ($delay) = @_;
234 0           $self->redis->hget($self->{path}, 'nick', $delay->begin);
235             },
236             sub {
237 0     0     my ($delay, $nick) = @_;
238 0 0 0       $self->_irc->write(NICK => $nick) if $nick and $self->_irc->nick ne $nick;
239             }
240 0           );
241             }
242              
243             sub _subscribe {
244 0     0     my $self = shift;
245 0           my $irc = $self->_irc;
246              
247 0           Scalar::Util::weaken($self);
248 0           $self->{messages} = $self->redis->subscribe("convos:user:@{[$self->login]}:@{[$self->name]}");
  0            
  0            
249             $self->{messages}->on(
250             error => sub {
251 0     0     my ($sub, $error) = @_;
252 0           $self->log->warn("[$self->{path}] Re-subcribing to messages to @{[$irc->name]}. ($error)");
  0            
253 0           $self->_subscribe;
254             },
255 0           );
256             $self->{messages}->on(
257             message => sub {
258 0     0     my ($sub, $raw_message) = @_;
259 0           my ($uuid, $message);
260              
261 0           $raw_message =~ s/(\S+)\s//;
262 0           $uuid = $1;
263 0           $raw_message = sprintf ':%s %s', $irc->nick, $raw_message;
264 0           $message = Parse::IRC::parse_irc($raw_message);
265              
266 0 0         unless (ref $message) {
267 0           $self->_publish_and_save(
268             server_message => {status => 400, message => "Unable to parse: $raw_message", uuid => $uuid});
269 0           return;
270             }
271              
272 0           $message->{uuid} = $uuid;
273              
274             $irc->write(
275             $raw_message,
276             sub {
277 0           my ($irc, $error) = @_;
278              
279 0 0         if ($error) {
    0          
    0          
280 0           $self->_publish_and_save(server_message =>
281 0           {status => 500, message => "Could not send message to @{[$irc->name]}: $error", uuid => $uuid});
282             }
283             elsif ($message->{command} eq 'PRIVMSG') {
284 0           $self->add_message($message);
285             }
286             elsif (my $method = $self->can('cmd_' . lc $message->{command})) {
287 0           $self->$method($message);
288             }
289             }
290 0           );
291             }
292 0           );
293              
294 0           $self;
295             }
296              
297             =head2 channels_from_conversations
298              
299             @channels = $self->channels_from_conversations(\@conversations);
300              
301             This method returns an array ref of channels based on the conversations
302             input. It will use L to filter out the right list.
303              
304             =cut
305              
306             sub channels_from_conversations {
307 0     0 1   my ($self, $conversations) = @_;
308              
309 0 0         map { lc $_->[1] } grep { $_->[0] eq $self->name and $_->[1] =~ /^[#&]/ } map { [id_as $_ ] } @{$conversations || []};
  0 0          
  0            
  0            
  0            
310             }
311              
312             =head2 add_server_message
313              
314             $self->add_server_message(\%message);
315              
316             Will look at L<%message> and add it to the database as a server message
317             if it looks like one. Returns true if the message was added to redis.
318              
319             =cut
320              
321             sub add_server_message {
322 0     0 1   my ($self, $message) = @_;
323 0           my $params = $message->{params};
324 0           my $data = {status => 200};
325              
326 0           shift @$params; # I think this removes our own nick... Not quite sure though
327 0           $data->{message} = join ' ', @$params;
328 0   0       $message->{command} ||= '';
329              
330 0           $self->_state('connected');
331 0           $self->_publish_and_save(server_message => $data);
332             }
333              
334             =head2 add_message
335              
336             $self->add_message(\%message);
337              
338             Will add a private message to the database.
339              
340             =cut
341              
342             sub add_message {
343 0     0 1   my ($self, $message) = @_;
344 0           my $current_nick = $self->_irc->nick;
345 0           my $is_private_message = $message->{params}[0] eq $current_nick;
346 0           my $data = {highlight => 0, message => $message->{params}[1], timestamp => time, uuid => $message->{uuid},};
347              
348 0 0         @$data{qw( nick user host )} = IRC::Utils::parse_user($message->{prefix}) if $message->{prefix};
349 0 0         $data->{target} = lc($is_private_message ? $data->{nick} : $message->{params}[0]);
350 0   0       $data->{host} ||= 'localhost';
351              
352 0 0         if ($data->{nick}) {
353 0 0 0       if ($data->{nick} eq $current_nick) {
    0          
354 0   0       $data->{user} ||= $self->_irc->user;
355             }
356             elsif ($is_private_message or $data->{message} =~ /\b$current_nick\b/) {
357 0 0 0       $self->_add_conversation($data->{target}) if $is_private_message and $data->{user};
358 0           $data->{highlight} = 1;
359             }
360             }
361              
362 0 0         if (!$data->{user}) { # server notice/message
363 0           return $self->add_server_message($message);
364             }
365              
366             # need to take care of when the current user also writes /me...
367             # this is not yet tested, since i have no time right now :(
368 0 0         if ($data->{message} =~ s/\x{1}ACTION (.*)\x{1}/$1/) {
369 0           $message->{command} = "CTCP_ACTION";
370             }
371              
372 0 0         $self->_publish_and_save($message->{command} eq 'CTCP_ACTION' ? 'action_message' : 'message', $data);
373             }
374              
375             sub _add_conversation {
376 0     0     my ($self, $target) = @_;
377 0           my $name = as_id $self->name, $target;
378              
379             Mojo::IOLoop->delay(
380             sub {
381 0     0     my ($delay) = @_;
382 0           $self->redis->zincrby($self->{conversation_path}, 0, $name, $delay->begin);
383             },
384             sub {
385 0     0     my ($delay, $part_of_conversation_list) = @_;
386 0 0         $part_of_conversation_list and return;
387 0           $self->redis->zrevrange($self->{conversation_path}, 0, 0, 'WITHSCORES', $delay->begin);
388             },
389             sub {
390 0     0     my ($delay, $score) = @_;
391 0           $self->redis->zadd($self->{conversation_path}, $score->[1] - 0.0001, $name, $delay->begin);
392             },
393             sub {
394 0     0     my ($delay) = @_;
395 0           $self->_publish(add_conversation => {target => $target});
396             },
397 0           );
398             }
399              
400             =head2 disconnect
401              
402             Will disconnect from the L server.
403              
404             =cut
405              
406             sub disconnect {
407 0     0 1   my ($self, $cb) = @_;
408 0           $self->{stop} = 1;
409 0   0 0     $self->_irc->disconnect($cb || sub { });
  0            
410             }
411              
412             =head1 EVENT HANDLERS
413              
414             =head2 irc_rpl_welcome
415              
416             Example message:
417              
418             :Zurich.CH.EU.Undernet.Org 001 somenick :Welcome to the UnderNet IRC Network, somenick
419              
420             =cut
421              
422             sub irc_rpl_welcome {
423 0     0 1   my ($self, $message) = @_;
424              
425 0           $self->{attempts} = 0;
426              
427 0           Scalar::Util::weaken($self);
428             $self->redis->zrange(
429             $self->{conversation_path},
430             0, -1,
431             sub {
432 0     0     for my $channel ($self->channels_from_conversations($_[1])) {
433             $self->redis->hget(
434             "$self->{path}:$channel",
435             key => sub {
436 0 0         $_[1] ? $self->_irc->write(JOIN => $channel, $_[1]) : $self->_irc->write(JOIN => $channel);
437             }
438 0           );
439             }
440             }
441 0           );
442             }
443              
444             =head2 irc_rpl_endofwhois
445              
446             Use data from L, L and
447             L.
448              
449             =cut
450              
451             sub irc_rpl_endofwhois {
452 0     0 1   my ($self, $message) = @_;
453 0           my $nick = $message->{params}[1];
454 0   0       my $whois = delete $self->{whois}{$nick} || {};
455              
456 0   0       $whois->{channels} ||= [];
457 0   0       $whois->{idle} ||= 0;
458 0   0       $whois->{realname} ||= '';
459 0   0       $whois->{user} ||= '';
460 0           $whois->{nick} = $nick;
461 0 0         $self->_publish(whois => $whois) if $whois->{host};
462             }
463              
464             =head2 irc_rpl_whoisidle
465              
466             Store idle info internally. See L.
467              
468             =cut
469              
470             sub irc_rpl_whoisidle {
471 0     0 1   my ($self, $message) = @_;
472 0           my $nick = $message->{params}[1];
473              
474 0   0       $self->{whois}{$nick}{idle} = $message->{params}[2] || 0;
475             }
476              
477             =head2 irc_rpl_whoisuser
478              
479             Store user info internally. See L.
480              
481             =cut
482              
483             sub irc_rpl_whoisuser {
484 0     0 1   my ($self, $message) = @_;
485 0           my $params = $message->{params};
486 0           my $nick = $params->[1];
487              
488 0           $self->{whois}{$nick}{host} = $params->[3];
489 0           $self->{whois}{$nick}{realname} = $params->[5];
490 0           $self->{whois}{$nick}{user} = $params->[2];
491             }
492              
493             =head2 irc_rpl_whoischannels
494              
495             Reply with user channels
496              
497             =cut
498              
499             sub irc_rpl_whoischannels {
500 0     0 1   my ($self, $message) = @_;
501 0           my $nick = $message->{params}[1];
502              
503 0   0       push @{$self->{whois}{$nick}{channels}}, split ' ', $message->{params}[2] || '';
  0            
504             }
505              
506             =head2 irc_rpl_notopic
507              
508             :server 331 nick #channel :No topic is set.
509              
510             =cut
511              
512             sub irc_rpl_notopic {
513 0     0 1   my ($self, $message) = @_;
514 0           my $target = lc $message->{params}[1];
515              
516 0           $self->redis->hset("$self->{path}:$target", topic => '');
517 0           $self->_publish(topic => {topic => '', target => $target});
518             }
519              
520             =head2 irc_rpl_topic
521              
522             Reply with topic
523              
524             =cut
525              
526             sub irc_rpl_topic {
527 0     0 1   my ($self, $message) = @_;
528 0           my $target = lc $message->{params}[1];
529 0           my $topic = $message->{params}[2];
530              
531 0           $self->redis->hset("$self->{path}:$target", topic => $topic);
532 0           $self->_publish(topic => {topic => $topic, target => $target});
533             }
534              
535             =head2 irc_topic
536              
537             :nick!~user@hostname TOPIC #channel :some topic
538              
539             =cut
540              
541             sub irc_topic {
542 0     0 1   my ($self, $message) = @_;
543 0           my $target = lc $message->{params}[0];
544 0           my $topic = $message->{params}[1];
545              
546 0           $self->redis->hset("$self->{path}:$target", topic => $topic);
547 0           $self->_publish(topic => {topic => $topic, target => $target});
548             }
549              
550             =head2 irc_rpl_topicwhotime
551              
552             Reply with who and when for topic change
553              
554             =cut
555              
556             sub irc_rpl_topicwhotime {
557 0     0 1   my ($self, $message) = @_;
558              
559 0           $self->_publish(topic_by =>
560             {timestamp => $message->{params}[3], nick => $message->{params}[2], target => lc $message->{params}[1],});
561             }
562              
563             =head2 irc_rpl_myinfo
564              
565             Example message:
566              
567             :Tampa.FL.US.Undernet.org 004 somenick Tampa.FL.US.Undernet.org u2.10.12.14 dioswkgx biklmnopstvrDR bklov
568              
569             =cut
570              
571             sub irc_rpl_myinfo {
572 0     0 1   my ($self, $message) = @_;
573 0           my @keys = qw/ current_nick real_host version available_user_modes available_channel_modes /;
574 0           my $i = 0;
575              
576 0   0       $self->redis->hmset($self->{path}, map { $_, $message->{params}[$i++] // '' } @keys);
  0            
577             }
578              
579             =head2 irc_479
580              
581             Invalid channel name.
582              
583             =cut
584              
585             sub irc_479 {
586 0     0 1   my ($self, $message) = @_;
587              
588             # params => [ 'nickname', '1', 'Illegal channel name' ],
589 0   0       $self->_publish(server_message => {status => 400, message => $message->{params}[2] || 'Illegal channel name'});
590             }
591              
592             =head2 irc_join
593              
594             See L.
595              
596             =cut
597              
598             sub irc_join {
599 0     0 1   my ($self, $message) = @_;
600 0           my ($nick, $user, $host) = IRC::Utils::parse_user($message->{prefix});
601 0           my $channel = lc $message->{params}[0];
602              
603 0 0         if ($nick eq $self->_irc->nick) {
604 0           $self->redis->hset("$self->{path}:$channel", topic => '');
605 0           $self->redis->hset("convos:host2convos" => $host => 'loopback');
606 0           $self->_add_conversation($channel);
607             }
608             else {
609 0           $self->_publish(nick_joined => {nick => $nick, target => $channel});
610             }
611             }
612              
613             =head2 irc_nick
614              
615             :old_nick!~username@1.2.3.4 NICK :new_nick
616              
617             =cut
618              
619             sub irc_nick {
620 0     0 1   my ($self, $message) = @_;
621 0           my ($old_nick) = IRC::Utils::parse_user($message->{prefix});
622 0           my $new_nick = $message->{params}[0];
623              
624 0 0         if ($new_nick eq $self->_irc->nick) {
625 0           delete $self->{supress}{err_nicknameinuse};
626 0           $self->redis->hset($self->{path}, current_nick => $new_nick);
627             }
628              
629 0           $self->_publish(nick_change => {old_nick => $old_nick, new_nick => $new_nick});
630             }
631              
632             =head2 irc_quit
633              
634             {
635             params => [ 'Quit: leaving' ],
636             raw_line => ':nick!~user@localhost QUIT :Quit: leaving',
637             command => 'QUIT',
638             prefix => 'nick!~user@localhost'
639             };
640              
641             =cut
642              
643             sub irc_quit {
644 0     0 1   my ($self, $message) = @_;
645 0           my ($nick) = IRC::Utils::parse_user($message->{prefix});
646              
647 0           Scalar::Util::weaken($self);
648 0           $self->_publish(nick_quit => {nick => $nick, message => $message->{params}[0]});
649             }
650              
651             =head2 irc_kick
652              
653             'raw_line' => ':testing!~marcus@home.means.no KICK #testmore :marcus_',
654             'params' => [ '#testmore', 'marcus_' ],
655             'command' => 'KICK',
656             'handled' => 1,
657             'prefix' => 'testing!~marcus@40.101.45.31.customer.cdi.no'
658              
659             =cut
660              
661             sub irc_kick {
662 0     0 1   my ($self, $message) = @_;
663 0           my ($by) = IRC::Utils::parse_user($message->{prefix});
664 0           my $channel = lc $message->{params}[0];
665 0           my $nick = $message->{params}[1];
666              
667 0 0         if ($nick eq $self->_irc->nick) {
668 0           my $name = as_id $self->name, $channel;
669 0     0     $self->redis->zrem($self->{conversation_path}, $name, sub { });
  0            
670             }
671              
672 0           $self->_publish(nick_kicked => {by => $by, nick => $nick, target => $channel});
673             }
674              
675             =head2 irc_part
676              
677             =cut
678              
679             sub irc_part {
680 0     0 1   my ($self, $message) = @_;
681 0           my ($nick) = IRC::Utils::parse_user($message->{prefix});
682 0           my $channel = lc $message->{params}[0];
683              
684 0           Scalar::Util::weaken($self);
685 0 0         if ($nick eq $self->_irc->nick) {
686 0           my $name = as_id $self->name, $channel;
687              
688             $self->redis->zrem(
689             $self->{conversation_path},
690             $name,
691             sub {
692 0     0     $self->_publish(remove_conversation => {target => $channel});
693             }
694 0           );
695             }
696             else {
697 0           $self->_publish(nick_parted => {nick => $nick, target => $channel});
698             }
699             }
700              
701             =head2 err_bannedfromchan
702              
703             :electret.shadowcat.co.uk 474 nick #channel :Cannot join channel (+b)
704              
705             =cut
706              
707             sub err_bannedfromchan {
708 0     0 1   my ($self, $message) = @_;
709 0           my $channel = lc $message->{params}[1];
710 0           my $name = as_id $self->name, $channel;
711              
712 0           $self->_publish_and_save(server_message => {status => 401, message => $message->{params}[2]});
713              
714 0           Scalar::Util::weaken($self);
715             $self->redis->zrem(
716             $self->{conversation_path},
717             $name,
718             sub {
719 0     0     $self->_publish(remove_conversation => {target => $channel});
720             }
721 0           );
722             }
723              
724             =head2 err_nicknameinuse
725              
726             =cut
727              
728             sub err_nicknameinuse {
729 0     0 1   my ($self, $message) = @_;
730              
731 0 0         if ($self->{supress}{err_nicknameinuse}++) {
732 0           return;
733             }
734              
735 0           $self->_publish(server_message => {status => 500, message => $message->{params}[2],});
736             }
737              
738             =head2 err_nosuchchannel
739              
740             :astral.shadowcat.co.uk 403 nick #channel :No such channel
741              
742             =cut
743              
744             sub err_nosuchchannel {
745 0     0 1   my ($self, $message) = @_;
746 0           my $channel = lc $message->{params}[1];
747 0           my $name = as_id $self->name, $channel;
748              
749 0           $self->_publish(server_message => {status => 400, message => qq(No such channel "$channel")});
750              
751 0 0         if ($channel =~ /^[#&]/) {
752 0           Scalar::Util::weaken($self);
753             $self->redis->zrem(
754             $self->{conversation_path},
755             $name,
756             sub {
757 0     0     $self->_publish(remove_conversation => {target => $channel});
758             }
759 0           );
760             }
761             }
762              
763             =head2 err_nosuchnick
764              
765             :electret.shadowcat.co.uk 442 sender nick :No such nick
766              
767             =cut
768              
769             sub err_nosuchnick {
770 0     0 1   my ($self, $message) = @_;
771              
772 0           $self->_publish(err_nosuchnick => {nick => $message->{params}[1]});
773             }
774              
775             =head2 err_notonchannel
776              
777             :electret.shadowcat.co.uk 442 nick #channel :You're not on that channel
778              
779             =cut
780              
781             sub err_notonchannel {
782 0     0 1   shift->err_nosuchchannel(@_);
783             }
784              
785             =head2 irc_rpl_endofnames
786              
787             Example message:
788              
789             :magnet.llarian.net 366 somenick #channel :End of /NAMES list.
790              
791             =cut
792              
793             sub irc_rpl_endofnames {
794 0     0 1   my ($self, $message) = @_;
795 0 0         my $channel = lc $message->{params}[1] or return;
796 0   0       my $nicks = delete $self->{nicks}{$channel} || [];
797              
798 0           $self->_publish(rpl_namreply => {nicks => $nicks, target => $channel});
799             }
800              
801             =head2 irc_rpl_namreply
802              
803             Example message:
804              
805             :Budapest.Hu.Eu.Undernet.org 353 somenick = #channel :somenick Indig0 Wildblue @HTML @CSS @Luch1an @Steaua_ Indig0_ Pilum @fade
806              
807             =cut
808              
809             sub irc_rpl_namreply {
810 0     0 1   my ($self, $message) = @_;
811 0 0         my $channel = lc $message->{params}[2] or return;
812 0   0       my $nicks = $self->{nicks}{$channel} ||= [];
813              
814 0           for my $nick (sort { lc $a cmp lc $b } split /\s+/, $message->{params}[3]) { # 3 = "+nick0 @nick1 nick2"
  0            
815 0 0         my $mode = $nick =~ s/^([@~+*])// ? $1 : '';
816 0           push @$nicks, {nick => $nick, mode => $mode};
817             }
818             }
819              
820             =head2 irc_rpl_list
821              
822             :servername 322 somenick #channel 10 :[+n] some topic
823              
824             =cut
825              
826             sub irc_rpl_list {
827 0     0 1   my ($self, $message) = @_;
828 0           my $network = $self->name;
829 0           my $name = $message->{params}[1];
830 0   0       my %info = (name => $name, visible => $message->{params}[2], title => $message->{params}[3] // '');
831              
832 0           $self->_publish(channel_info => {name => $name, network => $network, info => \%info});
833 0 0         $self->redis->hset("convos:irc:$network:channels", $name => j \%info) if $self->{save_channels};
834             }
835              
836             =head2 irc_rpl_listend
837              
838             :servername 323 somenick :End of /LIST
839              
840             =cut
841              
842             sub irc_rpl_listend {
843 0     0 1   my ($self, $message) = @_;
844 0           my $network = $self->name;
845              
846 0 0         $self->redis->expire("convos:irc:$network:channels", CHANNEL_LIST_CACHE_TIMEOUT) if delete $self->{save_channels};
847             }
848              
849             =head2 irc_mode
850              
851             :nick!user@host MODE #channel +o othernick
852             :nick!user@host MODE yournick +i
853              
854             =cut
855              
856             sub irc_mode {
857 0     0 1   my ($self, $message) = @_;
858 0           my $target = lc shift @{$message->{params}};
  0            
859 0           my $mode = shift @{$message->{params}};
  0            
860              
861 0 0         if ($target eq lc $self->_irc->nick) {
862 0           $self->_publish(server_message =>
863 0           {status => 200, target => $self->name, message => "You are connected to @{[$self->name]} with mode $mode"});
864             }
865             else {
866 0           $self->_publish(mode => {target => $target, mode => $mode, args => join(' ', @{$message->{params}})});
  0            
867             }
868             }
869              
870             =head2 irc_error
871              
872             Example message:
873              
874             ERROR :Closing Link: somenick by Tampa.FL.US.Undernet.org (Sorry, your connection class is full - try again later or try another server)
875              
876             =cut
877              
878             sub irc_error {
879 0     0 1   my ($self, $message) = @_;
880              
881             # Server dislikes us, we'll back off more
882 0           $self->{attempts} += 10;
883 0           $self->_publish_and_save(server_message => {status => 500, message => join(' ', @{$message->{params}})});
  0            
884             }
885              
886             =head2 cmd_nick
887              
888             Handle nick commands from user. Change nick and set new nick in redis.
889              
890             =cut
891              
892             sub cmd_nick {
893 0     0 1   my ($self, $message) = @_;
894 0           my $new_nick = $message->{params}[0];
895              
896 0 0         if ($new_nick =~ /^[\w-]+$/) {
897 0           $self->redis->hset($self->{path}, nick => $new_nick);
898 0           $self->_publish(server_message => {status => 200, message => 'Set nick to ' . $new_nick});
899             }
900             else {
901 0           $self->_publish(server_message => {status => 400, message => 'Invalid nick'});
902             }
903             }
904              
905             =head2 cmd_join
906              
907             Store keys on channel join.
908              
909             =cut
910              
911             sub cmd_join {
912 0     0 1   my ($self, $message) = @_;
913              
914 0           my $channel = $message->{params}[0];
915 0 0         if (my $key = $message->{params}[1]) {
916 0           $self->redis->hset("$self->{path}:$channel", key => $key);
917             }
918             }
919              
920             =head2 cmd_list
921              
922             =cut
923              
924             sub cmd_list {
925 0     0 1   my ($self, $message) = @_;
926 0           my $network = $self->name;
927              
928 0           $self->{channels} = {};
929              
930 0 0 0       if (my $filter = $message->{params}[0] || '') {
931 0           $self->{channels}{lc($_)} = {name => $_, topic => '', not_found => 1} for split /,/, $filter;
932             }
933             else {
934 0           $self->redis->del("convos:irc:$network:channels");
935 0           $self->{save_channels} = 1;
936             }
937             }
938              
939             sub _connect_failed {
940 0     0     my ($self, $error) = @_;
941 0           my $server = $self->_irc->server;
942              
943             # SSL connect attempt failed with unknown error
944             # error:140770FC:SSL routines:SSL23_GET_SERVER_HELLO:unknown protocol
945 0 0         if ($error =~ /SSL\d*_GET_SERVER_HELLO/) {
946 0           $self->_state('reconnecting');
947 0           $self->_publish_and_save(
948             server_message => {status => 400, message => "This IRC network ($server) does not support SSL/TLS."});
949 0           $self->{disable_tls} = 1;
950 0           $self->{core_connect_timer} = 1;
951             }
952             else {
953 0           $self->_state('disconnected');
954 0           $self->_publish_and_save(server_message => {status => 500, message => "Could not connect to $server: $error"});
955 0           $self->_reconnect;
956             }
957             }
958              
959             sub _publish {
960 0     0     my ($self, $event, $data) = @_;
961 0           my $login = $self->login;
962 0           my $name = $self->name;
963 0           my $message;
964              
965 0           local $data->{state} = $self->{state};
966              
967 0           $data->{event} = $event;
968 0           $data->{network} = $name;
969 0   0       $data->{timestamp} ||= time;
970 0   0       $data->{uuid} ||= Mojo::Util::md5_sum($data->{timestamp} . $$); # not really an uuid
971 0           $message = j $data;
972              
973 0 0 0       if ($event eq 'server_message' and $data->{status} != 200) {
974 0           $self->log->warn("[$login:$name] $data->{message}");
975             }
976              
977 0           $self->redis->publish("convos:user:$login:out", $message);
978 0           $message;
979             }
980              
981             sub _publish_and_save {
982 0     0     my ($self, $event, $data) = @_;
983 0           my $login = $self->login;
984 0           my $message = $self->_publish($event, $data);
985              
986 0 0         if ($data->{highlight}) {
987              
988             # Ooops! This must be broken: We're clearing the notification by index in
989             # Client.pm, but the index we're clearing does not have to be the index in
990             # the list. The bug should appear if we use an old ?notification=42 link
991             # and in the meanwhile we have added more notifications..?
992 0           $self->redis->lpush("user:$login:notifications", $message);
993             }
994              
995 0 0         if ($data->{target}) {
996 0           $self->redis->zadd("$self->{path}:$data->{target}:msg", $data->{timestamp}, $message);
997             }
998             else {
999 0           $self->redis->zadd("$self->{path}:msg", $data->{timestamp}, $message);
1000             }
1001              
1002 0           $self->emit(save => $data);
1003             }
1004              
1005             sub _reconnect {
1006 0     0     my $self = shift;
1007 0           $self->{attempts}++;
1008 0           $self->{core_connect_timer} = 30 * $self->{attempts}; # CONNECT_INTERVAL * 30 = 60 seconds
1009             }
1010              
1011             sub DESTROY {
1012 0     0     warn "DESTROY $_[0]->{path}\n" if DEBUG;
1013 0           my $self = shift;
1014 0 0         my $ioloop = $self->{_irc}{ioloop} or return;
1015 0 0         my $keepnick_tid = $self->{keepnick_tid} or return;
1016 0           $ioloop->remove($keepnick_tid);
1017             }
1018              
1019             =head1 COPYRIGHT
1020              
1021             See L.
1022              
1023             =head1 AUTHOR
1024              
1025             Jan Henning Thorsen
1026              
1027             Marcus Ramberg
1028              
1029             =cut
1030              
1031             1;