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

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