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

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