source: perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm @ be43554

release-1.10
Last change on this file since be43554 was be43554, checked in by Jason Gross <jgross@mit.edu>, 11 years ago
Add a ~/.owl/ircchannels file, persist channels All irc channel subscriptions persist across reconnects. irc-{part,join} now have a -t flag, which makes the channels not persist across BarnOwl sessions. irc-loadchannels loads persistent channels. It does not unload existing channels.
  • Property mode set to 100644
File size: 14.7 KB
RevLine 
[b38b0b2]1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC::Connection;
[3b4ba7d]5use BarnOwl::Timer;
[b38b0b2]6
7=head1 NAME
8
9BarnOwl::Module::IRC::Connection
10
11=head1 DESCRIPTION
12
[13ee8f2]13This module is a wrapper around AnyEvent::IRC::Client for BarnOwl's IRC
[b38b0b2]14support
15
16=cut
17
[8ba9313]18use AnyEvent::IRC::Client;
[09bd74c]19use AnyEvent::IRC::Util qw(split_prefix prefix_nick encode_ctcp);
[ba2ca66]20
[8ba9313]21use base qw(Class::Accessor);
22use Exporter 'import';
[5c6d661]23__PACKAGE__->mk_accessors(qw(conn alias motd names_tmp whois_tmp
24                             server autoconnect_channels
25                             connect_args backoff did_quit));
[8ba9313]26our @EXPORT_OK = qw(is_private);
[b38b0b2]27
28use BarnOwl;
[3acab0e]29use Scalar::Util qw(weaken);
[b38b0b2]30
31sub new {
32    my $class = shift;
33    my $alias = shift;
[8ba9313]34    my $host  = shift;
35    my $port  = shift;
36    my $args  = shift;
37    my $nick = $args->{nick};
38    my $conn = AnyEvent::IRC::Client->new();
[ba2ca66]39    my $self = bless({}, $class);
40    $self->conn($conn);
[be43554]41    # TODO(jgross): use // when we move to requiring perl 5.10
42    $self->autoconnect_channels(defined $args->{autoconnect_channels} ? $args->{autoconnect_channels} : []);
[b38b0b2]43    $self->alias($alias);
[8ba9313]44    $self->server($host);
[ba2ca66]45    $self->motd("");
[d264c6d]46    $self->names_tmp(0);
[5c6d661]47    $self->backoff(0);
[38cfdb5d]48    $self->whois_tmp("");
[5c6d661]49    $self->did_quit(0);
[ba2ca66]50
[851a0e0]51    if(delete $args->{SSL}) {
52        $conn->enable_ssl;
53    }
[5c6d661]54    $self->connect_args([$host, $port, $args]);
[851a0e0]55    $conn->connect($host, $port, $args);
56    $conn->{heap}{parent} = $self;
57    weaken($conn->{heap}{parent});
58
59    sub on {
60        my $meth = "on_" . shift;
61        return sub {
62            my $conn = shift;
63            return unless $conn->{heap}{parent};
64            $conn->{heap}{parent}->$meth(@_);
65        }
66    }
67
[8ba9313]68    # $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
[249bbbe]69    $self->conn->reg_cb(registered => on("connect"),
[851a0e0]70                        connfail   => sub { BarnOwl::error("Connection to $host failed!") },
71                        disconnect => on("disconnect"),
72                        publicmsg  => on("msg"),
[41ade7f]73                        privatemsg => on("msg"),
74                        irc_error  => on("error"));
[8ba9313]75    for my $m (qw(welcome yourhost created
76                  luserclient luserop luserchannels luserme
77                  error)) {
[851a0e0]78        $self->conn->reg_cb("irc_$m" => on("admin_msg"));
[8ba9313]79    }
[851a0e0]80    $self->conn->reg_cb(irc_375       => on("motdstart"),
81                        irc_372       => on("motd"),
82                        irc_376       => on("endofmotd"),
83                        irc_join      => on("join"),
84                        irc_part      => on("part"),
85                        irc_quit      => on("quit"),
86                        irc_433       => on("nickinuse"),
87                        channel_topic => on("topic"),
88                        irc_333       => on("topicinfo"),
89                        irc_353       => on("namreply"),
90                        irc_366       => on("endofnames"),
91                        irc_311       => on("whois"),
92                        irc_312       => on("whois"),
93                        irc_319       => on("whois"),
94                        irc_320       => on("whois"),
95                        irc_318       => on("endofwhois"),
96                        irc_mode      => on("mode"),
97                        irc_401       => on("nosuch"),
98                        irc_402       => on("nosuch"),
99                        irc_403       => on("nosuch"),
100                        nick_change   => on("nick"),
[09bd74c]101                        ctcp_action   => on("ctcp_action"),
[5c6d661]102                        'irc_*' => sub { BarnOwl::debug("IRC: " . $_[1]->{command} . " " .
[41ade7f]103                                                        join(" ", @{$_[1]->{params}})) });
[330c55a]104
[b38b0b2]105    return $self;
106}
107
[4787581]108sub nick {
109    my $self = shift;
110    return $self->conn->nick;
111}
112
[9c7a701]113sub getSocket
114{
115    my $self = shift;
116    return $self->conn->socket;
117}
118
[09bd74c]119sub me {
120    my ($self, $to, $msg) = @_;
121    $self->conn->send_msg('privmsg', $to,
122                          encode_ctcp(['ACTION', $msg]))
123}
124
[b38b0b2]125################################################################################
126############################### IRC callbacks ##################################
127################################################################################
128
[47b6a5f]129sub new_message {
130    my $self = shift;
131    my $evt = shift;
[60b49a7]132    my %args = (
[47b6a5f]133        type        => 'IRC',
134        server      => $self->server,
135        network     => $self->alias,
136        @_
137       );
[60b49a7]138    if ($evt) {
139        my ($nick, $user, $host) = split_prefix($evt);
140        $args{sender}   ||= $nick;
141        $args{hostname} ||= $host if defined($host);
142        $args{from}     ||= $evt->{prefix};
143        $args{params}   ||= join(' ', @{$evt->{params}})
144    }
145    return BarnOwl::Message->new(%args);
[47b6a5f]146}
147
[b38b0b2]148sub on_msg {
[8ba9313]149    my ($self, $recipient, $evt) = @_;
150    my $body = strip_irc_formatting($evt->{params}->[1]);
[09bd74c]151    $self->handle_message($recipient, $evt, $body);
152}
[8ba9313]153
[09bd74c]154sub on_ctcp_action {
155    my ($self, $src, $target, $msg) = @_;
156    my $body = strip_irc_formatting($msg);
157    my $evt = {
158        params => [$src],
159        type   => 'privmsg',
160        prefix => $src
161       };
162    $self->handle_message($target, $evt, "* $body");
163}
164
165sub handle_message {
166    my ($self, $recipient, $evt, $body) = @_;
[47b6a5f]167    my $msg = $self->new_message($evt,
[b38b0b2]168        direction   => 'in',
[2c40dc0]169        recipient   => $recipient,
[8ba9313]170        body        => $body,
[0b0e460]171        ($evt->{command}||'') eq 'notice' ?
[2c40dc0]172          (notice     => 'true') : (),
173        is_private($recipient) ?
[99c1f46]174          (private  => 'true') : (channel => $recipient),
[744769e]175        replycmd    => BarnOwl::quote('irc-msg', '-a', $self->alias,
[8ba9313]176           (is_private($recipient) ? prefix_nick($evt) : $recipient)),
177        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
[b38b0b2]178       );
[47b6a5f]179
[b38b0b2]180    BarnOwl::queue_message($msg);
181}
182
[09bd74c]183
[bc0d7bc]184sub on_admin_msg {
185    my ($self, $evt) = @_;
[8ba9313]186    return if BarnOwl::Module::IRC->skip_msg($evt->{command});
[bc0d7bc]187    BarnOwl::admin_message("IRC",
[8ba9313]188            BarnOwl::Style::boldify('IRC ' . $evt->{command} . ' message from '
[1951db8]189                . $self->alias) . "\n"
[8ba9313]190            . strip_irc_formatting(join ' ', cdr($evt->{params})));
[bc0d7bc]191}
192
193sub on_motdstart {
194    my ($self, $evt) = @_;
[8ba9313]195    $self->motd(join "\n", cdr(@{$evt->{params}}));
[bc0d7bc]196}
197
198sub on_motd {
199    my ($self, $evt) = @_;
[8ba9313]200    $self->motd(join "\n", $self->motd, cdr(@{$evt->{params}}));
[bc0d7bc]201}
202
203sub on_endofmotd {
204    my ($self, $evt) = @_;
[8ba9313]205    $self->motd(join "\n", $self->motd, cdr(@{$evt->{params}}));
[bc0d7bc]206    BarnOwl::admin_message("IRC",
[3baf77f]207            BarnOwl::Style::boldify('MOTD for ' . $self->alias) . "\n"
[ba2ca66]208            . strip_irc_formatting($self->motd));
[bc0d7bc]209}
210
[47b6a5f]211sub on_join {
212    my ($self, $evt) = @_;
[8ba9313]213    my $chan = $evt->{params}[0];
[47b6a5f]214    my $msg = $self->new_message($evt,
215        loginout   => 'login',
[4789b17]216        action     => 'join',
[8ba9313]217        channel    => $chan,
218        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $chan),
219        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
[47b6a5f]220        );
221    BarnOwl::queue_message($msg);
222}
223
224sub on_part {
225    my ($self, $evt) = @_;
[8ba9313]226    my $chan = $evt->{params}[0];
[47b6a5f]227    my $msg = $self->new_message($evt,
228        loginout   => 'logout',
[4789b17]229        action     => 'part',
[8ba9313]230        channel    => $chan,
231        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $chan),
232        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
[47b6a5f]233        );
234    BarnOwl::queue_message($msg);
235}
236
[4789b17]237sub on_quit {
238    my ($self, $evt) = @_;
239    my $msg = $self->new_message($evt,
240        loginout   => 'logout',
241        action     => 'quit',
[8ba9313]242        from       => $evt->{prefix},
[5d4262c]243        reason     => $evt->{params}->[0],
[8ba9313]244        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
245        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
[4789b17]246        );
247    BarnOwl::queue_message($msg);
248}
249
[3b4ba7d]250sub disconnect {
[9e02bb7]251    my $self = shift;
[5c6d661]252    $self->conn->disconnect;
[3b4ba7d]253}
254
255sub on_disconnect {
[8ba9313]256    my ($self, $why) = @_;
[9e02bb7]257    BarnOwl::admin_message('IRC',
[5c6d661]258                           "[" . $self->alias . "] Disconnected from server: $why");
259    $self->motd("");
260    if (!$self->did_quit) {
[3b4ba7d]261        $self->schedule_reconnect;
[5c6d661]262    } else {
263        delete $BarnOwl::Module::IRC::ircnets{$self->alias};
[3b4ba7d]264    }
[9e02bb7]265}
266
[41ade7f]267sub on_error {
268    my ($self, $evt) = @_;
269    BarnOwl::admin_message('IRC',
270                           "[" . $self->alias . "] " .
271                           "Error: " . join(" ", @{$evt->{params}}));
272}
273
[9e02bb7]274sub on_nickinuse {
275    my ($self, $evt) = @_;
276    BarnOwl::admin_message("IRC",
277                           "[" . $self->alias . "] " .
[8ba9313]278                           $evt->{params}->[1] . ": Nick already in use");
[9e02bb7]279}
280
[38d50c2]281sub on_nick {
282    my ($self, $old_nick, $new_nick, $is_me) = @_;
283    if ($is_me) {
284        BarnOwl::admin_message("IRC",
285                               "[" . $self->alias . "] " .
286                               "You are now known as $new_nick");
287    } else {
[60b49a7]288        my $msg = $self->new_message('',
289            loginout   => 'login',
290            action     => 'nick change',
291            from       => $new_nick,
292            sender     => $new_nick,
293            replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias,
294                                         $new_nick),
295            replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias,
296                                             $new_nick),
297            old_nick   => $old_nick);
298        BarnOwl::queue_message($msg);
[38d50c2]299    }
300}
301
[3ad15ff]302sub on_topic {
[8ba9313]303    my ($self, $channel, $topic, $who) = @_;
304    if ($channel) {
[3ad15ff]305        BarnOwl::admin_message("IRC",
[8ba9313]306                "Topic for $channel on " . $self->alias . " is $topic");
[3ad15ff]307    } else {
308        BarnOwl::admin_message("IRC",
[8ba9313]309                "Topic changed to $channel");
[3ad15ff]310    }
311}
312
313sub on_topicinfo {
314    my ($self, $evt) = @_;
[8ba9313]315    my @args = @{$evt->{params}};
[3ad15ff]316    BarnOwl::admin_message("IRC",
317        "Topic for $args[1] set by $args[2] at " . localtime($args[3]));
318}
319
[38cfdb5d]320# IRC gives us a bunch of namreply messages, followed by an endofnames.
321# We need to collect them from the namreply and wait for the endofnames message.
322# After this happens, the names_tmp variable is cleared.
323
324sub on_namreply {
325    my ($self, $evt) = @_;
[d264c6d]326    return unless $self->names_tmp;
[b9a642a]327    $self->names_tmp([@{$self->names_tmp},
328                      map {prefix_nick($_)} split(' ', $evt->{params}[3])]);
[38cfdb5d]329}
330
[fb6e8e3]331sub cmp_user {
332    my ($lhs, $rhs) = @_;
333    my ($sigil_l) = ($lhs =~ m{^([+@]?)});
334    my ($sigil_r) = ($rhs =~ m{^([+@]?)});
335    my %rank = ('@' => 1, '+' => 2, '' => 3);
336    return ($rank{$sigil_l} <=> $rank{$sigil_r}) ||
337            $lhs cmp $rhs;
338}
339
[38cfdb5d]340sub on_endofnames {
341    my ($self, $evt) = @_;
[d264c6d]342    return unless $self->names_tmp;
[8ba9313]343    my $names = BarnOwl::Style::boldify("Members of " . $evt->{params}->[1] . ":\n");
[fb6e8e3]344    for my $name (sort {cmp_user($a, $b)} @{$self->names_tmp}) {
[38cfdb5d]345        $names .= "  $name\n";
346    }
347    BarnOwl::popless_ztext($names);
[d264c6d]348    $self->names_tmp(0);
349}
350
351sub on_whois {
352    my ($self, $evt) = @_;
[8ba9313]353    my %names = (
354        311 => 'user',
355        312 => 'server',
356        319 => 'channels',
357        330 => 'whowas',
358       );
[d264c6d]359    $self->whois_tmp(
[8ba9313]360        $self->whois_tmp . "\n" . $names{$evt->{command}} . ":\n  " .
361        join("\n  ", cdr(cdr(@{$evt->{params}}))) . "\n"
362       );
[d264c6d]363}
364
365sub on_endofwhois {
366    my ($self, $evt) = @_;
367    BarnOwl::popless_ztext(
[8ba9313]368        BarnOwl::Style::boldify("/whois for " . $evt->{params}->[1] . ":\n") .
[d264c6d]369        $self->whois_tmp
370    );
[7c83a32]371    $self->whois_tmp('');
[d264c6d]372}
373
[4df2568]374sub on_mode {
375    my ($self, $evt) = @_;
376    BarnOwl::admin_message("IRC",
[8ba9313]377                           "[" . $self->alias . "] User " . (prefix_nick($evt)) . + " set mode " .
[ab6d8f0]378                           join(" ", cdr(@{$evt->{params}})) . " on " . $evt->{params}->[0]
[4df2568]379                          );
380}
381
[8ba9313]382sub on_nosuch {
[7cfb1df]383    my ($self, $evt) = @_;
[8ba9313]384    my %things = (401 => 'nick', 402 => 'server', 403 => 'channel');
[7cfb1df]385    BarnOwl::admin_message("IRC",
386                           "[" . $self->alias . "] " .
[8ba9313]387                           "No such @{[$things{$evt->{command}}]}: @{[$evt->{params}->[1]]}")
[7cfb1df]388}
389
[d264c6d]390sub on_event {
391    my ($self, $evt) = @_;
392    return on_whois(@_) if ($evt->type =~ /^whois/);
393    BarnOwl::admin_message("IRC",
394            "[" . $self->alias . "] Unhandled IRC event of type " . $evt->type . ":\n"
395            . strip_irc_formatting(join("\n", $evt->args)))
396        if BarnOwl::getvar('irc:spew') eq 'on';
[38cfdb5d]397}
[9e02bb7]398
[3b4ba7d]399sub schedule_reconnect {
400    my $self = shift;
[5c6d661]401    my $interval = $self->backoff;
402    if ($interval) {
403        $interval *= 2;
404        $interval = 60*5 if $interval > 60*5;
405    } else {
406        $interval = 5;
407    }
408    $self->backoff($interval);
[3713b86]409
[3acab0e]410    my $weak = $self;
411    weaken($weak);
[c8d9f84]412    if (defined $self->{reconnect_timer}) {
413        $self->{reconnect_timer}->stop;
414    }
[be43554]415    $self->{reconnect_timer} =
[3b4ba7d]416        BarnOwl::Timer->new( {
[c6adf17]417            name  => 'IRC (' . $self->alias . ') reconnect_timer',
[3b4ba7d]418            after => $interval,
419            cb    => sub {
[3acab0e]420                $weak->reconnect( $interval ) if $weak;
[3b4ba7d]421            },
422        } );
423}
424
[416241f]425sub cancel_reconnect {
426    my $self = shift;
[3713b86]427
[c8d9f84]428    if (defined $self->{reconnect_timer}) {
429        $self->{reconnect_timer}->stop;
430    }
[416241f]431    delete $self->{reconnect_timer};
432}
433
[851a0e0]434sub on_connect {
435    my $self = shift;
[0ccf5ab]436    $self->connected("Connected to " . $self->alias . " as " . $self->nick)
[851a0e0]437}
438
[3b4ba7d]439sub connected {
440    my $self = shift;
441    my $msg = shift;
442    BarnOwl::admin_message("IRC", $msg);
[416241f]443    $self->cancel_reconnect;
[8ba9313]444    if ($self->autoconnect_channels) {
445        for my $c (@{$self->autoconnect_channels}) {
446            $self->conn->send_msg(join => $c);
447        }
448    }
449    $self->conn->enable_ping(60, sub {
[5c6d661]450                                 $self->on_disconnect("Connection timed out.");
[8ba9313]451                                 $self->schedule_reconnect;
452                             });
[5c6d661]453    $self->backoff(0);
[3b4ba7d]454}
455
456sub reconnect {
457    my $self = shift;
[5c6d661]458    my $backoff = $self->backoff;
[3b4ba7d]459
[5c6d661]460    $self->conn->connect(@{$self->connect_args});
[3b4ba7d]461}
462
[b38b0b2]463################################################################################
464########################### Utilities/Helpers ##################################
465################################################################################
466
467sub strip_irc_formatting {
468    my $body = shift;
[214b790]469    # Strip mIRC colors. If someone wants to write code to convert
470    # these to zephyr colors, be my guest.
471    $body =~ s/\cC\d+(?:,\d+)?//g;
472    $body =~ s/\cO//g;
473   
474    my @pieces = split /\cB/, $body;
[3835ae8]475    my $out = '';
[b38b0b2]476    while(@pieces) {
477        $out .= shift @pieces;
478        $out .= BarnOwl::Style::boldify(shift @pieces) if @pieces;
479    }
480    return $out;
481}
482
[2c40dc0]483# Determines if the given message recipient is a username, as opposed to
484# a channel that starts with # or &.
485sub is_private {
486    return shift !~ /^[\#\&]/;
487}
[b38b0b2]488
[bc0d7bc]489sub cdr {
490    shift;
491    return @_;
492}
493
[b38b0b2]4941;
Note: See TracBrowser for help on using the repository browser.