Ignore:
Timestamp:
May 11, 2011, 6:03:18 PM (11 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, release-1.8, release-1.9
Children:
13ee8f2
Parents:
7b4f3be (diff), 5c6d661 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent.
Message:
Merge remote-tracking branch 'nelhage/anyevent-irc'
File:
1 edited

Legend:

Unmodified
Added
Removed
  • perl/modules/IRC/lib/BarnOwl/Module/IRC/Connection.pm

    rfb6e8e3 r5c6d661  
    1616=cut
    1717
    18 use Net::IRC::Connection;
    19 
    20 use base qw(Class::Accessor Exporter);
    21 __PACKAGE__->mk_accessors(qw(conn alias channels motd names_tmp whois_tmp));
    22 our @EXPORT_OK = qw(&is_private);
     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
     24                             server autoconnect_channels
     25                             connect_args backoff did_quit));
     26our @EXPORT_OK = qw(is_private);
    2327
    2428use BarnOwl;
    2529use Scalar::Util qw(weaken);
    2630
    27 BEGIN {
    28     no strict 'refs';
    29     my @delegate = qw(nick server);
    30     for my $meth (@delegate) {
    31         *{"BarnOwl::Module::IRC::Connection::$meth"} = sub {
    32             shift->conn->$meth(@_);
    33         }
    34     }
    35 };
    36 
    3731sub new {
    3832    my $class = shift;
    39     my $irc = shift;
    4033    my $alias = shift;
    41     my %args = (@_);
    42     my $conn = Net::IRC::Connection->new($irc, %args);
     34    my $host  = shift;
     35    my $port  = shift;
     36    my $args  = shift;
     37    my $nick = $args->{nick};
     38    my $conn = AnyEvent::IRC::Client->new();
    4339    my $self = bless({}, $class);
    4440    $self->conn($conn);
     41    $self->autoconnect_channels([]);
    4542    $self->alias($alias);
    46     $self->channels([]);
     43    $self->server($host);
    4744    $self->motd("");
    4845    $self->names_tmp(0);
     46    $self->backoff(0);
    4947    $self->whois_tmp("");
    50 
    51     $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
    52     $self->conn->add_handler(['msg', 'notice', 'public', 'caction'],
    53             sub { shift; $self->on_msg(@_) });
    54     $self->conn->add_handler(['welcome', 'yourhost', 'created',
    55                               'luserclient', 'luserop', 'luserchannels', 'luserme',
    56                               'error'],
    57             sub { shift; $self->on_admin_msg(@_) });
    58     $self->conn->add_handler(['myinfo', 'map', 'n_local', 'n_global',
    59             'luserconns'],
    60             sub { });
    61     $self->conn->add_handler(motdstart => sub { shift; $self->on_motdstart(@_) });
    62     $self->conn->add_handler(motd      => sub { shift; $self->on_motd(@_) });
    63     $self->conn->add_handler(endofmotd => sub { shift; $self->on_endofmotd(@_) });
    64     $self->conn->add_handler(join      => sub { shift; $self->on_join(@_) });
    65     $self->conn->add_handler(part      => sub { shift; $self->on_part(@_) });
    66     $self->conn->add_handler(quit      => sub { shift; $self->on_quit(@_) });
    67     $self->conn->add_handler(disconnect => sub { shift; $self->on_disconnect(@_) });
    68     $self->conn->add_handler(nicknameinuse => sub { shift; $self->on_nickinuse(@_) });
    69     $self->conn->add_handler(cping     => sub { shift; $self->on_ping(@_) });
    70     $self->conn->add_handler(topic     => sub { shift; $self->on_topic(@_) });
    71     $self->conn->add_handler(topicinfo => sub { shift; $self->on_topicinfo(@_) });
    72     $self->conn->add_handler(namreply  => sub { shift; $self->on_namreply(@_) });
    73     $self->conn->add_handler(endofnames=> sub { shift; $self->on_endofnames(@_) });
    74     $self->conn->add_handler(endofwhois=> sub { shift; $self->on_endofwhois(@_) });
    75     $self->conn->add_handler(mode      => sub { shift; $self->on_mode(@_) });
    76     $self->conn->add_handler(nosuchchannel => sub { shift; $self->on_nosuchchannel(@_) });
     48    $self->did_quit(0);
     49
     50    if(delete $args->{SSL}) {
     51        $conn->enable_ssl;
     52    }
     53    $self->connect_args([$host, $port, $args]);
     54    $conn->connect($host, $port, $args);
     55    $conn->{heap}{parent} = $self;
     56    weaken($conn->{heap}{parent});
     57
     58    sub on {
     59        my $meth = "on_" . shift;
     60        return sub {
     61            my $conn = shift;
     62            return unless $conn->{heap}{parent};
     63            $conn->{heap}{parent}->$meth(@_);
     64        }
     65    }
     66
     67    # $self->conn->add_default_handler(sub { shift; $self->on_event(@_) });
     68    $self->conn->reg_cb(registered => on("connect"),
     69                        connfail   => sub { BarnOwl::error("Connection to $host failed!") },
     70                        disconnect => on("disconnect"),
     71                        publicmsg  => on("msg"),
     72                        privatemsg => on("msg"),
     73                        irc_error  => on("error"));
     74    for my $m (qw(welcome yourhost created
     75                  luserclient luserop luserchannels luserme
     76                  error)) {
     77        $self->conn->reg_cb("irc_$m" => on("admin_msg"));
     78    }
     79    $self->conn->reg_cb(irc_375       => on("motdstart"),
     80                        irc_372       => on("motd"),
     81                        irc_376       => on("endofmotd"),
     82                        irc_join      => on("join"),
     83                        irc_part      => on("part"),
     84                        irc_quit      => on("quit"),
     85                        irc_433       => on("nickinuse"),
     86                        channel_topic => on("topic"),
     87                        irc_333       => on("topicinfo"),
     88                        irc_353       => on("namreply"),
     89                        irc_366       => on("endofnames"),
     90                        irc_311       => on("whois"),
     91                        irc_312       => on("whois"),
     92                        irc_319       => on("whois"),
     93                        irc_320       => on("whois"),
     94                        irc_318       => on("endofwhois"),
     95                        irc_mode      => on("mode"),
     96                        irc_401       => on("nosuch"),
     97                        irc_402       => on("nosuch"),
     98                        irc_403       => on("nosuch"),
     99                        nick_change   => on("nick"),
     100                        ctcp_action   => on("ctcp_action"),
     101                        'irc_*' => sub { BarnOwl::debug("IRC: " . $_[1]->{command} . " " .
     102                                                        join(" ", @{$_[1]->{params}})) });
    77103
    78104    return $self;
     105}
     106
     107sub nick {
     108    my $self = shift;
     109    return $self->conn->nick;
    79110}
    80111
     
    83114    my $self = shift;
    84115    return $self->conn->socket;
     116}
     117
     118sub me {
     119    my ($self, $to, $msg) = @_;
     120    $self->conn->send_msg('privmsg', $to,
     121                          encode_ctcp(['ACTION', $msg]))
    85122}
    86123
     
    92129    my $self = shift;
    93130    my $evt = shift;
    94     return BarnOwl::Message->new(
     131    my %args = (
    95132        type        => 'IRC',
    96133        server      => $self->server,
    97134        network     => $self->alias,
    98         sender      => $evt->nick,
    99         hostname    => $evt->host,
    100         from        => $evt->from,
    101135        @_
    102136       );
     137    if ($evt) {
     138        my ($nick, $user, $host) = split_prefix($evt);
     139        $args{sender}   ||= $nick;
     140        $args{hostname} ||= $host if defined($host);
     141        $args{from}     ||= $evt->{prefix};
     142        $args{params}   ||= join(' ', @{$evt->{params}})
     143    }
     144    return BarnOwl::Message->new(%args);
    103145}
    104146
    105147sub on_msg {
    106     my ($self, $evt) = @_;
    107     my ($recipient) = $evt->to;
    108     my $body = strip_irc_formatting([$evt->args]->[0]);
    109     my $nick = $self->nick;
    110     $body = '* '.$evt->nick.' '.$body if $evt->type eq 'caction';
     148    my ($self, $recipient, $evt) = @_;
     149    my $body = strip_irc_formatting($evt->{params}->[1]);
     150    $self->handle_message($recipient, $evt, $body);
     151}
     152
     153sub on_ctcp_action {
     154    my ($self, $src, $target, $msg) = @_;
     155    my $body = strip_irc_formatting($msg);
     156    my $evt = {
     157        params => [$src],
     158        type   => 'privmsg',
     159        prefix => $src
     160       };
     161    $self->handle_message($target, $evt, "* $body");
     162}
     163
     164sub handle_message {
     165    my ($self, $recipient, $evt, $body) = @_;
    111166    my $msg = $self->new_message($evt,
    112167        direction   => 'in',
    113168        recipient   => $recipient,
    114         body => $body,
    115         $evt->type eq 'notice' ?
     169        body        => $body,
     170        ($evt->{command}||'') eq 'notice' ?
    116171          (notice     => 'true') : (),
    117172        is_private($recipient) ?
    118173          (private  => 'true') : (channel => $recipient),
    119174        replycmd    => BarnOwl::quote('irc-msg', '-a', $self->alias,
    120           (is_private($recipient) ? $evt->nick : $recipient)),
    121         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     175           (is_private($recipient) ? prefix_nick($evt) : $recipient)),
     176        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    122177       );
    123178
     
    125180}
    126181
    127 sub on_ping {
    128     my ($self, $evt) = @_;
    129     $self->conn->ctcp_reply($evt->nick, join (' ', ($evt->args)));
    130 }
    131182
    132183sub on_admin_msg {
    133184    my ($self, $evt) = @_;
    134     return if BarnOwl::Module::IRC->skip_msg($evt->type);
    135     BarnOwl::admin_message("IRC",
    136             BarnOwl::Style::boldify('IRC ' . $evt->type . ' message from '
     185    return if BarnOwl::Module::IRC->skip_msg($evt->{command});
     186    BarnOwl::admin_message("IRC",
     187            BarnOwl::Style::boldify('IRC ' . $evt->{command} . ' message from '
    137188                . $self->alias) . "\n"
    138             . strip_irc_formatting(join ' ', cdr($evt->args)));
     189            . strip_irc_formatting(join ' ', cdr($evt->{params})));
    139190}
    140191
    141192sub on_motdstart {
    142193    my ($self, $evt) = @_;
    143     $self->motd(join "\n", cdr($evt->args));
     194    $self->motd(join "\n", cdr(@{$evt->{params}}));
    144195}
    145196
    146197sub on_motd {
    147198    my ($self, $evt) = @_;
    148     $self->motd(join "\n", $self->motd, cdr($evt->args));
     199    $self->motd(join "\n", $self->motd, cdr(@{$evt->{params}}));
    149200}
    150201
    151202sub on_endofmotd {
    152203    my ($self, $evt) = @_;
    153     $self->motd(join "\n", $self->motd, cdr($evt->args));
     204    $self->motd(join "\n", $self->motd, cdr(@{$evt->{params}}));
    154205    BarnOwl::admin_message("IRC",
    155206            BarnOwl::Style::boldify('MOTD for ' . $self->alias) . "\n"
     
    159210sub on_join {
    160211    my ($self, $evt) = @_;
     212    my $chan = $evt->{params}[0];
    161213    my $msg = $self->new_message($evt,
    162214        loginout   => 'login',
    163215        action     => 'join',
    164         channel    => $evt->to,
    165         replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
    166         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     216        channel    => $chan,
     217        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $chan),
     218        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    167219        );
    168220    BarnOwl::queue_message($msg);
    169     push @{$self->channels}, $evt->to;
    170221}
    171222
    172223sub on_part {
    173224    my ($self, $evt) = @_;
     225    my $chan = $evt->{params}[0];
    174226    my $msg = $self->new_message($evt,
    175227        loginout   => 'logout',
    176228        action     => 'part',
    177         channel    => $evt->to,
    178         replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->to),
    179         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     229        channel    => $chan,
     230        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $chan),
     231        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    180232        );
    181233    BarnOwl::queue_message($msg);
    182     $self->channels([ grep {$_ ne $evt->to} @{$self->channels}]);
    183234}
    184235
     
    188239        loginout   => 'logout',
    189240        action     => 'quit',
    190         from       => $evt->to,
    191         reason     => [$evt->args]->[0],
    192         replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
    193         replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, $evt->nick),
     241        from       => $evt->{prefix},
     242        reason     => $evt->{params}->[0],
     243        replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
     244        replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias, prefix_nick($evt)),
    194245        );
    195246    BarnOwl::queue_message($msg);
     
    198249sub disconnect {
    199250    my $self = shift;
    200     delete $BarnOwl::Module::IRC::ircnets{$self->alias};
    201     for my $k (keys %BarnOwl::Module::IRC::channels) {
    202         my @conns = grep {$_ ne $self} @{$BarnOwl::Module::IRC::channels{$k}};
    203         if(@conns) {
    204             $BarnOwl::Module::IRC::channels{$k} = \@conns;
    205         } else {
    206             delete $BarnOwl::Module::IRC::channels{$k};
    207         }
    208     }
    209     BarnOwl::remove_io_dispatch($self->{FD});
     251    $self->conn->disconnect;
     252}
     253
     254sub on_disconnect {
     255    my ($self, $why) = @_;
     256    BarnOwl::admin_message('IRC',
     257                           "[" . $self->alias . "] Disconnected from server: $why");
    210258    $self->motd("");
    211 }
    212 
    213 sub on_disconnect {
    214     my ($self, $evt) = @_;
    215     $self->disconnect;
    216     BarnOwl::admin_message('IRC',
    217                            "[" . $self->alias . "] Disconnected from server");
    218     if ($evt->format and $evt->format eq "error") {
     259    if (!$self->did_quit) {
    219260        $self->schedule_reconnect;
    220261    } else {
    221         $self->channels([]);
    222     }
     262        delete $BarnOwl::Module::IRC::ircnets{$self->alias};
     263    }
     264}
     265
     266sub on_error {
     267    my ($self, $evt) = @_;
     268    BarnOwl::admin_message('IRC',
     269                           "[" . $self->alias . "] " .
     270                           "Error: " . join(" ", @{$evt->{params}}));
    223271}
    224272
     
    227275    BarnOwl::admin_message("IRC",
    228276                           "[" . $self->alias . "] " .
    229                            [$evt->args]->[1] . ": Nick already in use");
    230     $self->disconnect unless $self->motd;
     277                           $evt->{params}->[1] . ": Nick already in use");
     278}
     279
     280sub on_nick {
     281    my ($self, $old_nick, $new_nick, $is_me) = @_;
     282    if ($is_me) {
     283        BarnOwl::admin_message("IRC",
     284                               "[" . $self->alias . "] " .
     285                               "You are now known as $new_nick");
     286    } else {
     287        my $msg = $self->new_message('',
     288            loginout   => 'login',
     289            action     => 'nick change',
     290            from       => $new_nick,
     291            sender     => $new_nick,
     292            replycmd   => BarnOwl::quote('irc-msg', '-a', $self->alias,
     293                                         $new_nick),
     294            replysendercmd => BarnOwl::quote('irc-msg', '-a', $self->alias,
     295                                             $new_nick),
     296            old_nick   => $old_nick);
     297        BarnOwl::queue_message($msg);
     298    }
    231299}
    232300
    233301sub on_topic {
    234     my ($self, $evt) = @_;
    235     my @args = $evt->args;
    236     if (scalar @args > 1) {
     302    my ($self, $channel, $topic, $who) = @_;
     303    if ($channel) {
    237304        BarnOwl::admin_message("IRC",
    238                 "Topic for $args[1] on " . $self->alias . " is $args[2]");
     305                "Topic for $channel on " . $self->alias . " is $topic");
    239306    } else {
    240307        BarnOwl::admin_message("IRC",
    241                 "Topic changed to $args[0]");
     308                "Topic changed to $channel");
    242309    }
    243310}
     
    245312sub on_topicinfo {
    246313    my ($self, $evt) = @_;
    247     my @args = $evt->args;
     314    my @args = @{$evt->{params}};
    248315    BarnOwl::admin_message("IRC",
    249316        "Topic for $args[1] set by $args[2] at " . localtime($args[3]));
     
    257324    my ($self, $evt) = @_;
    258325    return unless $self->names_tmp;
    259     $self->names_tmp([@{$self->names_tmp}, split(' ', [$evt->args]->[3])]);
     326    $self->names_tmp([@{$self->names_tmp},
     327                      map {prefix_nick($_)} split(' ', $evt->{params}[3])]);
    260328}
    261329
     
    272340    my ($self, $evt) = @_;
    273341    return unless $self->names_tmp;
    274     my $names = BarnOwl::Style::boldify("Members of " . [$evt->args]->[1] . ":\n");
     342    my $names = BarnOwl::Style::boldify("Members of " . $evt->{params}->[1] . ":\n");
    275343    for my $name (sort {cmp_user($a, $b)} @{$self->names_tmp}) {
    276344        $names .= "  $name\n";
     
    282350sub on_whois {
    283351    my ($self, $evt) = @_;
     352    my %names = (
     353        311 => 'user',
     354        312 => 'server',
     355        319 => 'channels',
     356        330 => 'whowas',
     357       );
    284358    $self->whois_tmp(
    285       $self->whois_tmp . "\n" . $evt->type . ":\n  " .
    286       join("\n  ", cdr(cdr($evt->args))) . "\n"
    287     );
     359        $self->whois_tmp . "\n" . $names{$evt->{command}} . ":\n  " .
     360        join("\n  ", cdr(cdr(@{$evt->{params}}))) . "\n"
     361       );
    288362}
    289363
     
    291365    my ($self, $evt) = @_;
    292366    BarnOwl::popless_ztext(
    293         BarnOwl::Style::boldify("/whois for " . [$evt->args]->[1] . ":\n") .
     367        BarnOwl::Style::boldify("/whois for " . $evt->{params}->[1] . ":\n") .
    294368        $self->whois_tmp
    295369    );
     
    300374    my ($self, $evt) = @_;
    301375    BarnOwl::admin_message("IRC",
    302                            "[" . $self->alias . "] User " . ($evt->nick) . + " set mode " .
    303                            join(" ", $evt->args) . "on " . $evt->to->[0]
     376                           "[" . $self->alias . "] User " . (prefix_nick($evt)) . + " set mode " .
     377                           join(" ", cdr(@{$evt->{params}})) . " on " . $evt->{params}->[0]
    304378                          );
    305379}
    306380
    307 sub on_nosuchchannel {
    308     my ($self, $evt) = @_;
     381sub on_nosuch {
     382    my ($self, $evt) = @_;
     383    my %things = (401 => 'nick', 402 => 'server', 403 => 'channel');
    309384    BarnOwl::admin_message("IRC",
    310385                           "[" . $self->alias . "] " .
    311                            "No such channel: " . [$evt->args]->[1])
     386                           "No such @{[$things{$evt->{command}}]}: @{[$evt->{params}->[1]]}")
    312387}
    313388
     
    323398sub schedule_reconnect {
    324399    my $self = shift;
    325     my $interval = shift || 5;
    326     delete $BarnOwl::Module::IRC::ircnets{$self->alias};
    327     $BarnOwl::Module::IRC::reconnect{$self->alias} = $self;
     400    my $interval = $self->backoff;
     401    if ($interval) {
     402        $interval *= 2;
     403        $interval = 60*5 if $interval > 60*5;
     404    } else {
     405        $interval = 5;
     406    }
     407    $self->backoff($interval);
     408
    328409    my $weak = $self;
    329410    weaken($weak);
     
    343424sub cancel_reconnect {
    344425    my $self = shift;
    345     delete $BarnOwl::Module::IRC::reconnect{$self->alias};
     426
    346427    if (defined $self->{reconnect_timer}) {
    347428        $self->{reconnect_timer}->stop;
    348429    }
    349430    delete $self->{reconnect_timer};
     431}
     432
     433sub on_connect {
     434    my $self = shift;
     435    $self->connected("Connected to " . $self->alias . " as " . $self->nick)
    350436}
    351437
     
    355441    BarnOwl::admin_message("IRC", $msg);
    356442    $self->cancel_reconnect;
    357     $BarnOwl::Module::IRC::ircnets{$self->alias} = $self;
    358     my $fd = $self->getSocket()->fileno();
    359     BarnOwl::add_io_dispatch($fd, 'r', \&BarnOwl::Module::IRC::OwlProcess);
    360     $self->{FD} = $fd;
     443    if ($self->autoconnect_channels) {
     444        for my $c (@{$self->autoconnect_channels}) {
     445            $self->conn->send_msg(join => $c);
     446        }
     447        $self->autoconnect_channels([]);
     448    }
     449    $self->conn->enable_ping(60, sub {
     450                                 $self->on_disconnect("Connection timed out.");
     451                                 $self->schedule_reconnect;
     452                             });
     453    $self->backoff(0);
    361454}
    362455
    363456sub reconnect {
    364457    my $self = shift;
    365     my $backoff = shift;
    366 
    367     $self->conn->connect;
    368     if ($self->conn->connected) {
    369         $self->connected("Reconnected to ".$self->alias);
    370         my @channels = @{$self->channels};
    371         $self->channels([]);
    372         $self->conn->join($_) for @channels;
    373         return;
    374     }
    375 
    376     $backoff *= 2;
    377     $backoff = 60*5 if $backoff > 60*5;
    378     $self->schedule_reconnect( $backoff );
     458    my $backoff = $self->backoff;
     459
     460    $self->autoconnect_channels([keys(%{$self->{channel_list}})]);
     461    $self->conn->connect(@{$self->connect_args});
    379462}
    380463
Note: See TracChangeset for help on using the changeset viewer.