source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 3713b86

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