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

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