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

release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 618a980 was 618a980, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
irc-disconnect on a pending reconnect should cancel the reconnect
  • Property mode set to 100644
File size: 11.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
[ba2ca66]13This module is a wrapper around Net::IRC::Connection for BarnOwl's IRC
[b38b0b2]14support
15
16=cut
17
[ba2ca66]18use Net::IRC::Connection;
19
20use base qw(Class::Accessor Exporter);
[3b4ba7d]21__PACKAGE__->mk_accessors(qw(conn alias channels motd names_tmp whois_tmp));
[2c40dc0]22our @EXPORT_OK = qw(&is_private);
[b38b0b2]23
24use BarnOwl;
25
[ba2ca66]26BEGIN {
27    no strict 'refs';
28    my @delegate = qw(nick server);
29    for my $meth (@delegate) {
30        *{"BarnOwl::Module::IRC::Connection::$meth"} = sub {
31            shift->conn->$meth(@_);
32        }
33    }
34};
35
[b38b0b2]36sub new {
37    my $class = shift;
38    my $irc = shift;
39    my $alias = shift;
40    my %args = (@_);
[ba2ca66]41    my $conn = Net::IRC::Connection->new($irc, %args);
42    my $self = bless({}, $class);
43    $self->conn($conn);
[b38b0b2]44    $self->alias($alias);
45    $self->channels([]);
[ba2ca66]46    $self->motd("");
[d264c6d]47    $self->names_tmp(0);
[38cfdb5d]48    $self->whois_tmp("");
[ba2ca66]49
50    $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
51    $self->conn->add_handler(['msg', 'notice', 'public', 'caction'],
52            sub { shift; $self->on_msg(@_) });
53    $self->conn->add_handler(['welcome', 'yourhost', 'created',
[661d2eb]54                              'luserclient', 'luserop', 'luserchannels', 'luserme',
55                              'error'],
[ba2ca66]56            sub { shift; $self->on_admin_msg(@_) });
57    $self->conn->add_handler(['myinfo', 'map', 'n_local', 'n_global',
[bc0d7bc]58            'luserconns'],
59            sub { });
[ba2ca66]60    $self->conn->add_handler(motdstart => sub { shift; $self->on_motdstart(@_) });
61    $self->conn->add_handler(motd      => sub { shift; $self->on_motd(@_) });
62    $self->conn->add_handler(endofmotd => sub { shift; $self->on_endofmotd(@_) });
63    $self->conn->add_handler(join      => sub { shift; $self->on_join(@_) });
64    $self->conn->add_handler(part      => sub { shift; $self->on_part(@_) });
[4789b17]65    $self->conn->add_handler(quit      => sub { shift; $self->on_quit(@_) });
[ba2ca66]66    $self->conn->add_handler(disconnect => sub { shift; $self->on_disconnect(@_) });
67    $self->conn->add_handler(nicknameinuse => sub { shift; $self->on_nickinuse(@_) });
68    $self->conn->add_handler(cping     => sub { shift; $self->on_ping(@_) });
[3ad15ff]69    $self->conn->add_handler(topic     => sub { shift; $self->on_topic(@_) });
70    $self->conn->add_handler(topicinfo => sub { shift; $self->on_topicinfo(@_) });
[38cfdb5d]71    $self->conn->add_handler(namreply  => sub { shift; $self->on_namreply(@_) });
72    $self->conn->add_handler(endofnames=> sub { shift; $self->on_endofnames(@_) });
[d264c6d]73    $self->conn->add_handler(endofwhois=> sub { shift; $self->on_endofwhois(@_) });
[4df2568]74    $self->conn->add_handler(mode      => sub { shift; $self->on_mode(@_) });
[7cfb1df]75    $self->conn->add_handler(nosuchchannel => sub { shift; $self->on_nosuchchannel(@_) });
[330c55a]76
[b38b0b2]77    return $self;
78}
79
[9c7a701]80sub getSocket
81{
82    my $self = shift;
83    return $self->conn->socket;
84}
85
[b38b0b2]86################################################################################
87############################### IRC callbacks ##################################
88################################################################################
89
[47b6a5f]90sub new_message {
91    my $self = shift;
92    my $evt = shift;
93    return BarnOwl::Message->new(
94        type        => 'IRC',
95        server      => $self->server,
96        network     => $self->alias,
97        sender      => $evt->nick,
98        hostname    => $evt->host,
99        from        => $evt->from,
100        @_
101       );
102}
103
[b38b0b2]104sub on_msg {
105    my ($self, $evt) = @_;
[2c40dc0]106    my ($recipient) = $evt->to;
107    my $body = strip_irc_formatting([$evt->args]->[0]);
[bc0d7bc]108    my $nick = $self->nick;
[3048f1f]109    $body = '* '.$evt->nick.' '.$body if $evt->type eq 'caction';
[47b6a5f]110    my $msg = $self->new_message($evt,
[b38b0b2]111        direction   => 'in',
[2c40dc0]112        recipient   => $recipient,
[47b6a5f]113        body => $body,
[2c40dc0]114        $evt->type eq 'notice' ?
115          (notice     => 'true') : (),
116        is_private($recipient) ?
[99c1f46]117          (private  => 'true') : (channel => $recipient),
[744769e]118        replycmd    => BarnOwl::quote('irc-msg', '-a', $self->alias,
119          (is_private($recipient) ? $evt->nick : $recipient)),
120        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
[b38b0b2]121       );
[47b6a5f]122
[b38b0b2]123    BarnOwl::queue_message($msg);
124}
125
[2c40dc0]126sub on_ping {
127    my ($self, $evt) = @_;
[ba2ca66]128    $self->conn->ctcp_reply($evt->nick, join (' ', ($evt->args)));
[2c40dc0]129}
130
[bc0d7bc]131sub on_admin_msg {
132    my ($self, $evt) = @_;
[f81176c]133    return if BarnOwl::Module::IRC->skip_msg($evt->type);
[bc0d7bc]134    BarnOwl::admin_message("IRC",
135            BarnOwl::Style::boldify('IRC ' . $evt->type . ' message from '
[1951db8]136                . $self->alias) . "\n"
[d264c6d]137            . strip_irc_formatting(join ' ', cdr($evt->args)));
[bc0d7bc]138}
139
140sub on_motdstart {
141    my ($self, $evt) = @_;
[1af21e8]142    $self->motd(join "\n", cdr($evt->args));
[bc0d7bc]143}
144
145sub on_motd {
146    my ($self, $evt) = @_;
[1af21e8]147    $self->motd(join "\n", $self->motd, cdr($evt->args));
[bc0d7bc]148}
149
150sub on_endofmotd {
151    my ($self, $evt) = @_;
[1af21e8]152    $self->motd(join "\n", $self->motd, cdr($evt->args));
[bc0d7bc]153    BarnOwl::admin_message("IRC",
[3baf77f]154            BarnOwl::Style::boldify('MOTD for ' . $self->alias) . "\n"
[ba2ca66]155            . strip_irc_formatting($self->motd));
[bc0d7bc]156}
157
[47b6a5f]158sub on_join {
159    my ($self, $evt) = @_;
160    my $msg = $self->new_message($evt,
161        loginout   => 'login',
[4789b17]162        action     => 'join',
[47b6a5f]163        channel    => $evt->to,
[744769e]164        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
165        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
[47b6a5f]166        );
167    BarnOwl::queue_message($msg);
[3b4ba7d]168    push @{$self->channels}, $evt->to;
[47b6a5f]169}
170
171sub on_part {
172    my ($self, $evt) = @_;
173    my $msg = $self->new_message($evt,
174        loginout   => 'logout',
[4789b17]175        action     => 'part',
[47b6a5f]176        channel    => $evt->to,
[744769e]177        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
178        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
[47b6a5f]179        );
180    BarnOwl::queue_message($msg);
[3b4ba7d]181    $self->channels([ grep {$_ ne $evt->to} @{$self->channels}]);
[47b6a5f]182}
183
[4789b17]184sub on_quit {
185    my ($self, $evt) = @_;
186    my $msg = $self->new_message($evt,
187        loginout   => 'logout',
188        action     => 'quit',
189        from       => $evt->to,
190        reason     => [$evt->args]->[0],
[744769e]191        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
192        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
[4789b17]193        );
194    BarnOwl::queue_message($msg);
195}
196
[3b4ba7d]197sub disconnect {
[9e02bb7]198    my $self = shift;
199    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
[0e8a0fc]200    for my $k (keys %BarnOwl::Module::IRC::channels) {
201        my @conns = grep {$_ ne $self} @{$BarnOwl::Module::IRC::channels{$k}};
202        if(@conns) {
203            $BarnOwl::Module::IRC::channels{$k} = \@conns;
204        } else {
205            delete $BarnOwl::Module::IRC::channels{$k};
206        }
207    }
[f1a2736]208    BarnOwl::remove_io_dispatch($self->{FD});
[3b4ba7d]209    $self->motd("");
210}
211
212sub on_disconnect {
213    my ($self, $evt) = @_;
214    $self->disconnect;
[9e02bb7]215    BarnOwl::admin_message('IRC',
216                           "[" . $self->alias . "] Disconnected from server");
[3b4ba7d]217    if ($evt->format and $evt->format eq "error") {
218        $self->schedule_reconnect;
219    } else {
220        $self->channels([]);
221    }
[9e02bb7]222}
223
224sub on_nickinuse {
225    my ($self, $evt) = @_;
226    BarnOwl::admin_message("IRC",
227                           "[" . $self->alias . "] " .
228                           [$evt->args]->[1] . ": Nick already in use");
[3b4ba7d]229    $self->disconnect unless $self->motd;
[9e02bb7]230}
231
[3ad15ff]232sub on_topic {
233    my ($self, $evt) = @_;
234    my @args = $evt->args;
235    if (scalar @args > 1) {
236        BarnOwl::admin_message("IRC",
237                "Topic for $args[1] on " . $self->alias . " is $args[2]");
238    } else {
239        BarnOwl::admin_message("IRC",
240                "Topic changed to $args[0]");
241    }
242}
243
244sub on_topicinfo {
245    my ($self, $evt) = @_;
246    my @args = $evt->args;
247    BarnOwl::admin_message("IRC",
248        "Topic for $args[1] set by $args[2] at " . localtime($args[3]));
249}
250
[38cfdb5d]251# IRC gives us a bunch of namreply messages, followed by an endofnames.
252# We need to collect them from the namreply and wait for the endofnames message.
253# After this happens, the names_tmp variable is cleared.
254
255sub on_namreply {
256    my ($self, $evt) = @_;
[d264c6d]257    return unless $self->names_tmp;
[38cfdb5d]258    $self->names_tmp([@{$self->names_tmp}, split(' ', [$evt->args]->[3])]);
259}
260
261sub on_endofnames {
262    my ($self, $evt) = @_;
[d264c6d]263    return unless $self->names_tmp;
[38cfdb5d]264    my $names = BarnOwl::Style::boldify("Members of " . [$evt->args]->[1] . ":\n");
265    for my $name (@{$self->names_tmp}) {
266        $names .= "  $name\n";
267    }
268    BarnOwl::popless_ztext($names);
[d264c6d]269    $self->names_tmp(0);
270}
271
272sub on_whois {
273    my ($self, $evt) = @_;
274    $self->whois_tmp(
275      $self->whois_tmp . "\n" . $evt->type . ":\n  " .
276      join("\n  ", cdr(cdr($evt->args))) . "\n"
277    );
278}
279
280sub on_endofwhois {
281    my ($self, $evt) = @_;
282    BarnOwl::popless_ztext(
283        BarnOwl::Style::boldify("/whois for " . [$evt->args]->[1] . ":\n") .
284        $self->whois_tmp
285    );
[7c83a32]286    $self->whois_tmp('');
[d264c6d]287}
288
[4df2568]289sub on_mode {
290    my ($self, $evt) = @_;
291    BarnOwl::admin_message("IRC",
292                           "[" . $self->alias . "] User " . ($evt->nick) . + " set mode " .
293                           join(" ", $evt->args) . "on " . $evt->to->[0]
294                          );
295}
296
[7cfb1df]297sub on_nosuchchannel {
298    my ($self, $evt) = @_;
299    BarnOwl::admin_message("IRC",
300                           "[" . $self->alias . "] " .
301                           "No such channel: " . [$evt->args]->[1])
302}
303
[d264c6d]304sub on_event {
305    my ($self, $evt) = @_;
306    return on_whois(@_) if ($evt->type =~ /^whois/);
307    BarnOwl::admin_message("IRC",
308            "[" . $self->alias . "] Unhandled IRC event of type " . $evt->type . ":\n"
309            . strip_irc_formatting(join("\n", $evt->args)))
310        if BarnOwl::getvar('irc:spew') eq 'on';
[38cfdb5d]311}
[9e02bb7]312
[3b4ba7d]313sub schedule_reconnect {
314    my $self = shift;
315    my $interval = shift || 5;
316    delete $BarnOwl::Module::IRC::ircnets{$self->alias};
317    $BarnOwl::Module::IRC::reconnect{$self->alias} =
318        BarnOwl::Timer->new( {
319            after => $interval,
320            cb    => sub {
321                $self->reconnect( $interval );
322            },
323        } );
[618a980]324    $BarnOwl::Module::IRC::reconnect{$self->alias}{conn} = $self;
[3b4ba7d]325}
326
327sub connected {
328    my $self = shift;
329    my $msg = shift;
330    BarnOwl::admin_message("IRC", $msg);
331    delete $BarnOwl::Module::IRC::reconnect{$self->alias};
332    $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
333    my $fd = $self->getSocket()->fileno();
334    BarnOwl::add_io_dispatch($fd, 'r', \&BarnOwl::Module::IRC::OwlProcess);
335    $self->{FD} = $fd;
336}
337
338sub reconnect {
339    my $self = shift;
340    my $backoff = shift;
341
342    $self->conn->connect;
343    if ($self->conn->connected) {
344        $self->connected("Reconnected to ".$self->alias);
345        my @channels = @{$self->channels};
346        $self->channels([]);
347        $self->conn->join($_) for @channels;
348        return;
349    }
350
351    $backoff *= 2;
352    $backoff = 60*5 if $backoff > 60*5;
353    $self->schedule_reconnect( $backoff );
354}
355
[b38b0b2]356################################################################################
357########################### Utilities/Helpers ##################################
358################################################################################
359
360sub strip_irc_formatting {
361    my $body = shift;
[214b790]362    # Strip mIRC colors. If someone wants to write code to convert
363    # these to zephyr colors, be my guest.
364    $body =~ s/\cC\d+(?:,\d+)?//g;
365    $body =~ s/\cO//g;
366   
367    my @pieces = split /\cB/, $body;
[3835ae8]368    my $out = '';
[b38b0b2]369    while(@pieces) {
370        $out .= shift @pieces;
371        $out .= BarnOwl::Style::boldify(shift @pieces) if @pieces;
372    }
373    return $out;
374}
375
[2c40dc0]376# Determines if the given message recipient is a username, as opposed to
377# a channel that starts with # or &.
378sub is_private {
379    return shift !~ /^[\#\&]/;
380}
[b38b0b2]381
[bc0d7bc]382sub cdr {
383    shift;
384    return @_;
385}
386
[b38b0b2]3871;
Note: See TracBrowser for help on using the repository browser.