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

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