source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 13ee8f2

release-1.8release-1.9
Last change on this file since 13ee8f2 was 5c6d661, checked in by Nelson Elhage <nelhage@mit.edu>, 11 years ago
IRC: Fix reconnect behavior.
  • Property mode set to 100644
File size: 17.1 KB
RevLine 
[b38b0b2]1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC;
5
6=head1 NAME
7
[2c40dc0]8BarnOwl::Module::IRC
[b38b0b2]9
10=head1 DESCRIPTION
11
[2c40dc0]12This module implements IRC support for barnowl.
[b38b0b2]13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::IRC;
[380b1ab]19use BarnOwl::Module::IRC::Connection qw(is_private);
[ab9cd8f]20use BarnOwl::Module::IRC::Completion;
[b38b0b2]21
[8ba9313]22use AnyEvent::IRC;
[b38b0b2]23use Getopt::Long;
[9620c8d]24use Encode;
[b38b0b2]25
[2c40dc0]26our $VERSION = 0.02;
[b38b0b2]27
28our $irc;
29
30# Hash alias -> BarnOwl::Module::IRC::Connection object
31our %ircnets;
32
33sub startup {
[b10f340]34    BarnOwl::new_variable_string('irc:nick', {
35        default     => $ENV{USER},
36        summary     => 'The default IRC nickname',
37        description => 'By default, irc-connect will use this nick '  .
38        'when connecting to a new server. See :help irc-connect for ' .
39        'more information.'
40       });
41
42    BarnOwl::new_variable_string('irc:user', {
43        default => $ENV{USER},
44        summary => 'The IRC "username" field'
45       });
46        BarnOwl::new_variable_string('irc:name', {
47        default => "",
48        summary     => 'A short name field for IRC',
49        description => 'A short (maybe 60 or so chars) piece of text, ' .
50        'originally intended to display your real name, which people '  .
51        'often use for pithy quotes and URLs.'
52       });
[cd12307]53
[b10f340]54    BarnOwl::new_variable_bool('irc:spew', {
55        default     => 0,
56        summary     => 'Show unhandled IRC events',
57        description => 'If set, display all unrecognized IRC events as ' .
[cd12307]58        'admin messages. Intended for debugging and development use only.'
[b10f340]59       });
[f81176c]60
61    BarnOwl::new_variable_string('irc:skip', {
62        default     => 'welcome yourhost created ' .
63        'luserclient luserme luserop luserchannels',
64        summary     => 'Skip messages of these types',
65        description => 'If set, each (space-separated) message type ' .
66        'provided will be hidden and ignored if received.'
67       });
68
[b38b0b2]69    register_commands();
[96f7b07]70    BarnOwl::filter(qw{irc type ^IRC$ or ( type ^admin$ and adminheader ^IRC$ )});
[b38b0b2]71}
72
73sub shutdown {
74    for my $conn (values %ircnets) {
[8ba9313]75        $conn->conn->disconnect('Quitting');
[b38b0b2]76    }
77}
78
[f17bb2c0]79sub quickstart {
80    return <<'END_QUICKSTART';
81@b[IRC:]
82Use ':irc-connect @b[server]' to connect to an IRC server, and
83':irc-join @b[#channel]' to join a channel. ':irc-msg @b[#channel]
84@b[message]' sends a message to a channel.
85END_QUICKSTART
86}
87
[da554da]88sub buddylist {
89    my $list = "";
90
91    for my $net (sort keys %ircnets) {
92        my $conn = $ircnets{$net};
93        my ($nick, $server) = ($conn->nick, $conn->server);
[6396c1e]94        $list .= BarnOwl::Style::boldify("IRC channels for $net ($nick\@$server)");
95        $list .= "\n";
[da554da]96
[dace02a]97        for my $chan (keys %{$conn->conn->{channel_list}}) {
[da554da]98            $list .= "  $chan\n";
99        }
100    }
101
102    return $list;
103}
104
[f81176c]105sub skip_msg {
106    my $class = shift;
107    my $type = lc shift;
108    my $skip = lc BarnOwl::getvar('irc:skip');
109    return grep {$_ eq $type} split ' ', $skip;
110}
111
[54b4a87]112=head2 mk_irc_command SUB FLAGS
113
114Return a subroutine that can be bound as a an IRC command. The
115subroutine will be called with arguments (COMMAND-NAME,
116IRC-CONNECTION, [CHANNEL], ARGV...).
117
118C<IRC-CONNECTION> and C<CHANNEL> will be inferred from arguments to
119the command and the current message if appropriate.
120
121The bitwise C<or> of zero or more C<FLAGS> can be passed in as a
122second argument to alter the behavior of the returned commands:
123
124=over 4
125
126=item C<CHANNEL_ARG>
127
128This command accepts the name of a channel. Pass in the C<CHANNEL>
129argument listed above, and die if no channel argument can be found.
130
131=item C<CHANNEL_OPTIONAL>
132
133Pass the channel argument, but don't die if not present. Only relevant
134with C<CHANNEL_ARG>.
135
[416241f]136=item C<ALLOW_DISCONNECTED>
137
138C<IRC-CONNECTION> may be a disconnected connection object that is
139currently pending a reconnect.
140
[54b4a87]141=back
142
143=cut
144
145use constant CHANNEL_ARG        => 1;
146use constant CHANNEL_OPTIONAL   => 2;
[330c55a]147
[416241f]148use constant ALLOW_DISCONNECTED => 4;
149
[b38b0b2]150sub register_commands {
[f17bb2c0]151    BarnOwl::new_command(
152        'irc-connect' => \&cmd_connect,
153        {
154            summary => 'Connect to an IRC server',
155            usage =>
156'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
[cd12307]157            description => <<END_DESCR
158Connect to an IRC server. Supported options are:
[f17bb2c0]159
160 -a <alias>          Define an alias for this server
161 -s                  Use SSL
162 -p <password>       Specify the password to use
163 -n <nick>           Use a non-default nick
164
165The -a option specifies an alias to use for this connection. This
166alias can be passed to the '-a' argument of any other IRC command to
167control which connection it operates on.
168
169For servers with hostnames of the form "irc.FOO.{com,org,...}", the
170alias will default to "FOO"; For other servers the full hostname is
171used.
172END_DESCR
173        }
174    );
175
176    BarnOwl::new_command(
[416241f]177        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
[f17bb2c0]178        {
179            summary => 'Disconnect from an IRC server',
180            usage   => 'irc-disconnect [-a ALIAS]',
181
182            description => <<END_DESCR
183Disconnect from an IRC server. You can specify a specific server with
184"-a SERVER-ALIAS" if necessary.
185END_DESCR
186        }
187    );
188
189    BarnOwl::new_command(
[e0fba58]190        'irc-msg' => mk_irc_command( \&cmd_msg ),
[f17bb2c0]191        {
192            summary => 'Send an IRC message',
193            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
194
195            description => <<END_DESCR
[cd12307]196Send an IRC message.
[f17bb2c0]197END_DESCR
198        }
199    );
200
201    BarnOwl::new_command(
[54b4a87]202        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
[f17bb2c0]203        {
204            summary => 'Change an IRC channel or user mode',
205            usage   => 'irc-mode [-a ALIAS] TARGET [+-]MODE OPTIONS',
206
207            description => <<END_DESCR
208Change the mode of an IRC user or channel.
209END_DESCR
210        }
211    );
212
213    BarnOwl::new_command(
214        'irc-join' => mk_irc_command( \&cmd_join ),
215        {
216            summary => 'Join an IRC channel',
[1b62a55]217            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
[f17bb2c0]218
219            description => <<END_DESCR
220Join an IRC channel.
221END_DESCR
222        }
223    );
224
225    BarnOwl::new_command(
[54b4a87]226        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
[f17bb2c0]227        {
228            summary => 'Leave an IRC channel',
229            usage   => 'irc-part [-a ALIAS] #channel',
230
231            description => <<END_DESCR
232Part from an IRC channel.
233END_DESCR
234        }
235    );
236
237    BarnOwl::new_command(
238        'irc-nick' => mk_irc_command( \&cmd_nick ),
239        {
240            summary => 'Change your IRC nick on an existing connection.',
241            usage   => 'irc-nick [-a ALIAS] NEW-NICK',
242
243            description => <<END_DESCR
244Set your IRC nickname on an existing connect. To change it prior to
245connecting, adjust the `irc:nick' variable.
246END_DESCR
247        }
248    );
249
250    BarnOwl::new_command(
[54b4a87]251        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
[f17bb2c0]252        {
253            summary => 'View the list of users in a channel',
254            usage   => 'irc-names [-a ALIAS] #channel',
255
256            description => <<END_DESCR
257`irc-names' displays the list of users in a given channel in a pop-up
258window.
259END_DESCR
260        }
261    );
262
263    BarnOwl::new_command(
264        'irc-whois' => mk_irc_command( \&cmd_whois ),
265        {
266            summary => 'Displays information about a given IRC user',
267            usage   => 'irc-whois [-a ALIAS] NICK',
268
269            description => <<END_DESCR
270Pops up information about a given IRC user.
271END_DESCR
272        }
273    );
274
275    BarnOwl::new_command(
276        'irc-motd' => mk_irc_command( \&cmd_motd ),
277        {
278            summary => 'Displays an IRC server\'s MOTD (Message of the Day)',
279            usage   => 'irc-motd [-a ALIAS]',
280
281            description => <<END_DESCR
282Displays an IRC server's message of the day.
283END_DESCR
284        }
285    );
286
287    BarnOwl::new_command(
288        'irc-list' => \&cmd_list,
289        {
290            summary => 'Show all the active IRC connections.',
291            usage   => 'irc-list',
292
293            description => <<END_DESCR
294Show all the currently active IRC connections with their aliases and
295server names.
296END_DESCR
297        }
298    );
299
300    BarnOwl::new_command( 'irc-who'   => mk_irc_command( \&cmd_who ) );
301    BarnOwl::new_command( 'irc-stats' => mk_irc_command( \&cmd_stats ) );
302
303    BarnOwl::new_command(
[54b4a87]304        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
[f17bb2c0]305        {
306            summary => 'View or change the topic of an IRC channel',
307            usage   => 'irc-topic [-a ALIAS] #channel [TOPIC]',
308
309            description => <<END_DESCR
310Without extra arguments, fetches and displays a given channel's topic.
311
312With extra arguments, changes the target channel's topic string. This
313may require +o on some channels.
314END_DESCR
315        }
316    );
317
318    BarnOwl::new_command(
319        'irc-quote' => mk_irc_command( \&cmd_quote ),
320        {
321            summary => 'Send a raw command to the IRC servers.',
322            usage   => 'irc-quote [-a ALIAS] TEXT',
323
324            description => <<END_DESCR
325Send a raw command line to an IRC server.
326
327This can be used to perform some operation not yet supported by
328BarnOwl, or to define new IRC commands.
329END_DESCR
330        }
331    );
[b38b0b2]332}
333
[f17bb2c0]334
[167044b]335$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
336$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
[f17bb2c0]337$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
[da554da]338$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
[b38b0b2]339
340################################################################################
341######################## Owl command handlers ##################################
342################################################################################
343
344sub cmd_connect {
345    my $cmd = shift;
346
[2c40dc0]347    my $nick = BarnOwl::getvar('irc:nick');
348    my $username = BarnOwl::getvar('irc:user');
349    my $ircname = BarnOwl::getvar('irc:name');
[b38b0b2]350    my $host;
351    my $port;
352    my $alias;
353    my $ssl;
354    my $password = undef;
355
356    {
357        local @ARGV = @_;
358        GetOptions(
359            "alias=s"    => \$alias,
360            "ssl"        => \$ssl,
[2c40dc0]361            "password=s" => \$password,
[b10f340]362            "nick=s"     => \$nick,
[2c40dc0]363        );
[b38b0b2]364        $host = shift @ARGV or die("Usage: $cmd HOST\n");
365        if(!$alias) {
[f094fc4]366            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
[b0c8011]367                $alias = $1;
368            } else {
369                $alias = $host;
370            }
[b38b0b2]371        }
372        $ssl ||= 0;
[f094fc4]373        $port = shift @ARGV || ($ssl ? 6697 : 6667);
[b38b0b2]374    }
375
[b0c8011]376    if(exists $ircnets{$alias}) {
377        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
378    }
379
[8ba9313]380    my $conn = BarnOwl::Module::IRC::Connection->new($alias, $host, $port, {
381        nick      => $nick,
382        user      => $username,
383        real      => $ircname,
384        password  => $password,
385        SSL       => $ssl,
386        timeout   => sub {0}
387       });
[851a0e0]388    $ircnets{$alias} = $conn;
[b38b0b2]389    return;
390}
391
392sub cmd_disconnect {
[ac374fc]393    my $cmd = shift;
394    my $conn = shift;
[851a0e0]395    if ($conn->conn->{socket}) {
[5c6d661]396        $conn->did_quit(1);
[8ba9313]397        $conn->conn->disconnect("Goodbye!");
[3713b86]398    } elsif ($conn->{reconnect_timer}) {
[416241f]399        BarnOwl::admin_message('IRC',
400                               "[" . $conn->alias . "] Reconnect cancelled");
401        $conn->cancel_reconnect;
[3713b86]402        delete $ircnets{$conn->alias};
[416241f]403    }
[b38b0b2]404}
405
406sub cmd_msg {
[330c55a]407    my $cmd  = shift;
408    my $conn = shift;
[e0fba58]409    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
[2c40dc0]410    # handle multiple recipients?
[b38b0b2]411    if(@_) {
412        process_msg($conn, $to, join(" ", @_));
413    } else {
[744769e]414        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
[b38b0b2]415    }
[48f7d12]416    return;
[b38b0b2]417}
418
419sub process_msg {
420    my $conn = shift;
421    my $to = shift;
[9a023d0]422    my $fullbody = shift;
423    my @msgs;
424    # Require the user to send in paragraphs (double-newline between) to
425    # actually send multiple PRIVMSGs, in order to play nice with autofill.
426    $fullbody =~ s/\r//g;
427    @msgs = split "\n\n", $fullbody;
428    map { tr/\n/ / } @msgs;
429    for my $body (@msgs) {
430        if ($body =~ /^\/me (.*)/) {
[8ba9313]431            $conn->me($to, Encode::encode('utf-8', $1));
[9a023d0]432            $body = '* '.$conn->nick.' '.$1;
433        } else {
[8ba9313]434            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
[9a023d0]435        }
436        my $msg = BarnOwl::Message->new(
437            type        => 'IRC',
438            direction   => is_private($to) ? 'out' : 'in',
439            server      => $conn->server,
440            network     => $conn->alias,
441            recipient   => $to,
442            body        => $body,
443            sender      => $conn->nick,
444            is_private($to) ?
445              (isprivate  => 'true') : (channel => $to),
446            replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
447            replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
448        );
449        BarnOwl::queue_message($msg);
[919535f]450    }
[48f7d12]451    return;
[b38b0b2]452}
453
[e625b5e]454sub cmd_mode {
455    my $cmd = shift;
456    my $conn = shift;
457    my $target = shift;
458    $target ||= shift;
[8ba9313]459    $conn->conn->send_msg(mode => $target, @_);
[48f7d12]460    return;
[e625b5e]461}
462
[2c40dc0]463sub cmd_join {
464    my $cmd = shift;
[330c55a]465    my $conn = shift;
[2c40dc0]466    my $chan = shift or die("Usage: $cmd channel\n");
[8ba9313]467    $conn->conn->send_msg(join => $chan, @_);
[48f7d12]468    return;
[2c40dc0]469}
[b38b0b2]470
[6858d2d]471sub cmd_part {
472    my $cmd = shift;
[330c55a]473    my $conn = shift;
474    my $chan = shift;
[8ba9313]475    $conn->conn->send_msg(part => $chan);
[48f7d12]476    return;
[6858d2d]477}
478
[6286f26]479sub cmd_nick {
480    my $cmd = shift;
[330c55a]481    my $conn = shift;
[b0c8011]482    my $nick = shift or die("Usage: $cmd <new nick>\n");
[8ba9313]483    $conn->conn->send_msg(nick => $nick);
[48f7d12]484    return;
[6286f26]485}
486
[6858d2d]487sub cmd_names {
488    my $cmd = shift;
[330c55a]489    my $conn = shift;
490    my $chan = shift;
[d264c6d]491    $conn->names_tmp([]);
[8ba9313]492    $conn->conn->send_msg(names => $chan);
[48f7d12]493    return;
[6858d2d]494}
495
[b0c8011]496sub cmd_whois {
497    my $cmd = shift;
[330c55a]498    my $conn = shift;
[b0c8011]499    my $who = shift || die("Usage: $cmd <user>\n");
[8ba9313]500    $conn->conn->send_msg(whois => $who);
[48f7d12]501    return;
[b0c8011]502}
503
[56e72d5]504sub cmd_motd {
505    my $cmd = shift;
[330c55a]506    my $conn = shift;
[8ba9313]507    $conn->conn->send_msg('motd');
[48f7d12]508    return;
[56e72d5]509}
510
[f094fc4]511sub cmd_list {
512    my $cmd = shift;
513    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
514    while (my ($alias, $conn) = each %ircnets) {
515        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
516    }
517    BarnOwl::popless_ztext($message);
[48f7d12]518    return;
[f094fc4]519}
520
521sub cmd_who {
522    my $cmd = shift;
[330c55a]523    my $conn = shift;
[f094fc4]524    my $who = shift || die("Usage: $cmd <user>\n");
[8ba9313]525    $conn->conn->send_msg(who => $who);
[48f7d12]526    return;
[f094fc4]527}
528
529sub cmd_stats {
530    my $cmd = shift;
[330c55a]531    my $conn = shift;
[f094fc4]532    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
[8ba9313]533    $conn->conn->send_msg(stats => $type, @_);
[48f7d12]534    return;
[f094fc4]535}
536
[3ad15ff]537sub cmd_topic {
538    my $cmd = shift;
[330c55a]539    my $conn = shift;
540    my $chan = shift;
[8ba9313]541    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
[48f7d12]542    return;
[3ad15ff]543}
544
[af9de56]545sub cmd_quote {
546    my $cmd = shift;
547    my $conn = shift;
[8ba9313]548    $conn->conn->send_msg(@_);
[48f7d12]549    return;
[af9de56]550}
551
[b38b0b2]552################################################################################
553########################### Utilities/Helpers ##################################
554################################################################################
555
[dace02a]556sub find_channel {
557    my $channel = shift;
558    my @found;
559    for my $conn (values %ircnets) {
560        if($conn->conn->{channel_list}{lc $channel}) {
561            push @found, $conn;
562        }
563    }
564    return $found[0] if(scalar @found == 1);
565}
566
[330c55a]567sub mk_irc_command {
568    my $sub = shift;
[54b4a87]569    my $flags = shift || 0;
[330c55a]570    return sub {
571        my $cmd = shift;
572        my $conn;
573        my $alias;
574        my $channel;
575        my $getopt = Getopt::Long::Parser->new;
576        my $m = BarnOwl::getcurmsg();
[b38b0b2]577
[330c55a]578        local @ARGV = @_;
579        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
580        $getopt->getoptions("alias=s" => \$alias);
581
582        if(defined($alias)) {
[416241f]583            $conn = get_connection_by_alias($alias,
584                                            $flags & ALLOW_DISCONNECTED);
[330c55a]585        }
[54b4a87]586        if($flags & CHANNEL_ARG) {
[e625b5e]587            $channel = $ARGV[0];
[330c55a]588            if(defined($channel) && $channel =~ /^#/) {
[dace02a]589                if(my $c = find_channel($channel)) {
[e625b5e]590                    shift @ARGV;
[dace02a]591                    $conn ||= $c;
[330c55a]592                }
[ecee82f]593            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
594                $channel = $m->channel;
595            } else {
596                undef $channel;
[330c55a]597            }
598        }
[ecee82f]599
[54b4a87]600        if(!$channel &&
601           ($flags & CHANNEL_ARG) &&
602           !($flags & CHANNEL_OPTIONAL)) {
[330c55a]603            die("Usage: $cmd <channel>\n");
604        }
605        if(!$conn) {
606            if($m && $m->type eq 'IRC') {
[416241f]607                $conn = get_connection_by_alias($m->network,
608                                               $flags & ALLOW_DISCONNECTED);
[330c55a]609            }
610        }
611        if(!$conn && scalar keys %ircnets == 1) {
612            $conn = [values(%ircnets)]->[0];
613        }
614        if(!$conn) {
615            die("You must specify an IRC network using -a.\n");
616        }
[54b4a87]617        if($flags & CHANNEL_ARG) {
[330c55a]618            $sub->($cmd, $conn, $channel, @ARGV);
619        } else {
620            $sub->($cmd, $conn, @ARGV);
621        }
622    };
[6858d2d]623}
624
[b38b0b2]625sub get_connection_by_alias {
[2c40dc0]626    my $key = shift;
[416241f]627    my $allow_disconnected = shift;
628
[3713b86]629    my $conn = $ircnets{$key};
630    die("No such ircnet: $key\n") unless $conn;
631    if ($conn->conn->{registered} || $allow_disconnected) {
632        return $conn;
633    }
634    die("[@{[$conn->alias]}] Not currently connected.");
[b38b0b2]635}
636
6371;
Note: See TracBrowser for help on using the repository browser.