source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 5c6d661

release-1.10release-1.8release-1.9
Last change on this file since 5c6d661 was 5c6d661, checked in by Nelson Elhage <nelhage@mit.edu>, 15 years ago
IRC: Fix reconnect behavior.
  • Property mode set to 100644
File size: 17.1 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC;
5
6=head1 NAME
7
8BarnOwl::Module::IRC
9
10=head1 DESCRIPTION
11
12This module implements IRC support for barnowl.
13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::IRC;
19use BarnOwl::Module::IRC::Connection qw(is_private);
20use BarnOwl::Module::IRC::Completion;
21
22use AnyEvent::IRC;
23use Getopt::Long;
24use Encode;
25
26our $VERSION = 0.02;
27
28our $irc;
29
30# Hash alias -> BarnOwl::Module::IRC::Connection object
31our %ircnets;
32
33sub startup {
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       });
53
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 ' .
58        'admin messages. Intended for debugging and development use only.'
59       });
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
69    register_commands();
70    BarnOwl::filter(qw{irc type ^IRC$ or ( type ^admin$ and adminheader ^IRC$ )});
71}
72
73sub shutdown {
74    for my $conn (values %ircnets) {
75        $conn->conn->disconnect('Quitting');
76    }
77}
78
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
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);
94        $list .= BarnOwl::Style::boldify("IRC channels for $net ($nick\@$server)");
95        $list .= "\n";
96
97        for my $chan (keys %{$conn->conn->{channel_list}}) {
98            $list .= "  $chan\n";
99        }
100    }
101
102    return $list;
103}
104
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
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
136=item C<ALLOW_DISCONNECTED>
137
138C<IRC-CONNECTION> may be a disconnected connection object that is
139currently pending a reconnect.
140
141=back
142
143=cut
144
145use constant CHANNEL_ARG        => 1;
146use constant CHANNEL_OPTIONAL   => 2;
147
148use constant ALLOW_DISCONNECTED => 4;
149
150sub register_commands {
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]',
157            description => <<END_DESCR
158Connect to an IRC server. Supported options are:
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(
177        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
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(
190        'irc-msg' => mk_irc_command( \&cmd_msg ),
191        {
192            summary => 'Send an IRC message',
193            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
194
195            description => <<END_DESCR
196Send an IRC message.
197END_DESCR
198        }
199    );
200
201    BarnOwl::new_command(
202        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
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',
217            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
218
219            description => <<END_DESCR
220Join an IRC channel.
221END_DESCR
222        }
223    );
224
225    BarnOwl::new_command(
226        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
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(
251        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
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(
304        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
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    );
332}
333
334
335$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
336$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
337$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
338$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
339
340################################################################################
341######################## Owl command handlers ##################################
342################################################################################
343
344sub cmd_connect {
345    my $cmd = shift;
346
347    my $nick = BarnOwl::getvar('irc:nick');
348    my $username = BarnOwl::getvar('irc:user');
349    my $ircname = BarnOwl::getvar('irc:name');
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,
361            "password=s" => \$password,
362            "nick=s"     => \$nick,
363        );
364        $host = shift @ARGV or die("Usage: $cmd HOST\n");
365        if(!$alias) {
366            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
367                $alias = $1;
368            } else {
369                $alias = $host;
370            }
371        }
372        $ssl ||= 0;
373        $port = shift @ARGV || ($ssl ? 6697 : 6667);
374    }
375
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
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       });
388    $ircnets{$alias} = $conn;
389    return;
390}
391
392sub cmd_disconnect {
393    my $cmd = shift;
394    my $conn = shift;
395    if ($conn->conn->{socket}) {
396        $conn->did_quit(1);
397        $conn->conn->disconnect("Goodbye!");
398    } elsif ($conn->{reconnect_timer}) {
399        BarnOwl::admin_message('IRC',
400                               "[" . $conn->alias . "] Reconnect cancelled");
401        $conn->cancel_reconnect;
402        delete $ircnets{$conn->alias};
403    }
404}
405
406sub cmd_msg {
407    my $cmd  = shift;
408    my $conn = shift;
409    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
410    # handle multiple recipients?
411    if(@_) {
412        process_msg($conn, $to, join(" ", @_));
413    } else {
414        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
415    }
416    return;
417}
418
419sub process_msg {
420    my $conn = shift;
421    my $to = shift;
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 (.*)/) {
431            $conn->me($to, Encode::encode('utf-8', $1));
432            $body = '* '.$conn->nick.' '.$1;
433        } else {
434            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
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);
450    }
451    return;
452}
453
454sub cmd_mode {
455    my $cmd = shift;
456    my $conn = shift;
457    my $target = shift;
458    $target ||= shift;
459    $conn->conn->send_msg(mode => $target, @_);
460    return;
461}
462
463sub cmd_join {
464    my $cmd = shift;
465    my $conn = shift;
466    my $chan = shift or die("Usage: $cmd channel\n");
467    $conn->conn->send_msg(join => $chan, @_);
468    return;
469}
470
471sub cmd_part {
472    my $cmd = shift;
473    my $conn = shift;
474    my $chan = shift;
475    $conn->conn->send_msg(part => $chan);
476    return;
477}
478
479sub cmd_nick {
480    my $cmd = shift;
481    my $conn = shift;
482    my $nick = shift or die("Usage: $cmd <new nick>\n");
483    $conn->conn->send_msg(nick => $nick);
484    return;
485}
486
487sub cmd_names {
488    my $cmd = shift;
489    my $conn = shift;
490    my $chan = shift;
491    $conn->names_tmp([]);
492    $conn->conn->send_msg(names => $chan);
493    return;
494}
495
496sub cmd_whois {
497    my $cmd = shift;
498    my $conn = shift;
499    my $who = shift || die("Usage: $cmd <user>\n");
500    $conn->conn->send_msg(whois => $who);
501    return;
502}
503
504sub cmd_motd {
505    my $cmd = shift;
506    my $conn = shift;
507    $conn->conn->send_msg('motd');
508    return;
509}
510
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);
518    return;
519}
520
521sub cmd_who {
522    my $cmd = shift;
523    my $conn = shift;
524    my $who = shift || die("Usage: $cmd <user>\n");
525    $conn->conn->send_msg(who => $who);
526    return;
527}
528
529sub cmd_stats {
530    my $cmd = shift;
531    my $conn = shift;
532    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
533    $conn->conn->send_msg(stats => $type, @_);
534    return;
535}
536
537sub cmd_topic {
538    my $cmd = shift;
539    my $conn = shift;
540    my $chan = shift;
541    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
542    return;
543}
544
545sub cmd_quote {
546    my $cmd = shift;
547    my $conn = shift;
548    $conn->conn->send_msg(@_);
549    return;
550}
551
552################################################################################
553########################### Utilities/Helpers ##################################
554################################################################################
555
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
567sub mk_irc_command {
568    my $sub = shift;
569    my $flags = shift || 0;
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();
577
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)) {
583            $conn = get_connection_by_alias($alias,
584                                            $flags & ALLOW_DISCONNECTED);
585        }
586        if($flags & CHANNEL_ARG) {
587            $channel = $ARGV[0];
588            if(defined($channel) && $channel =~ /^#/) {
589                if(my $c = find_channel($channel)) {
590                    shift @ARGV;
591                    $conn ||= $c;
592                }
593            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
594                $channel = $m->channel;
595            } else {
596                undef $channel;
597            }
598        }
599
600        if(!$channel &&
601           ($flags & CHANNEL_ARG) &&
602           !($flags & CHANNEL_OPTIONAL)) {
603            die("Usage: $cmd <channel>\n");
604        }
605        if(!$conn) {
606            if($m && $m->type eq 'IRC') {
607                $conn = get_connection_by_alias($m->network,
608                                               $flags & ALLOW_DISCONNECTED);
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        }
617        if($flags & CHANNEL_ARG) {
618            $sub->($cmd, $conn, $channel, @ARGV);
619        } else {
620            $sub->($cmd, $conn, @ARGV);
621        }
622    };
623}
624
625sub get_connection_by_alias {
626    my $key = shift;
627    my $allow_disconnected = shift;
628
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.");
635}
636
6371;
Note: See TracBrowser for help on using the repository browser.