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

release-1.10release-1.8release-1.9
Last change on this file since dace02a was dace02a, checked in by Nelson Elhage <nelhage@mit.edu>, 13 years ago
Use AnyEvent::IRC::Client's channel tracking, instead our own.
  • 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;
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->conn->disconnect("Goodbye!");
397    } elsif ($conn->{reconnect_timer}) {
398        BarnOwl::admin_message('IRC',
399                               "[" . $conn->alias . "] Reconnect cancelled");
400        $conn->cancel_reconnect;
401        delete $ircnets{$conn->alias};
402    }
403}
404
405sub cmd_msg {
406    my $cmd  = shift;
407    my $conn = shift;
408    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
409    # handle multiple recipients?
410    if(@_) {
411        process_msg($conn, $to, join(" ", @_));
412    } else {
413        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
414    }
415    return;
416}
417
418sub process_msg {
419    my $conn = shift;
420    my $to = shift;
421    my $fullbody = shift;
422    my @msgs;
423    # Require the user to send in paragraphs (double-newline between) to
424    # actually send multiple PRIVMSGs, in order to play nice with autofill.
425    $fullbody =~ s/\r//g;
426    @msgs = split "\n\n", $fullbody;
427    map { tr/\n/ / } @msgs;
428    for my $body (@msgs) {
429        if ($body =~ /^\/me (.*)/) {
430            $conn->me($to, Encode::encode('utf-8', $1));
431            $body = '* '.$conn->nick.' '.$1;
432        } else {
433            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
434        }
435        my $msg = BarnOwl::Message->new(
436            type        => 'IRC',
437            direction   => is_private($to) ? 'out' : 'in',
438            server      => $conn->server,
439            network     => $conn->alias,
440            recipient   => $to,
441            body        => $body,
442            sender      => $conn->nick,
443            is_private($to) ?
444              (isprivate  => 'true') : (channel => $to),
445            replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
446            replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
447        );
448        BarnOwl::queue_message($msg);
449    }
450    return;
451}
452
453sub cmd_mode {
454    my $cmd = shift;
455    my $conn = shift;
456    my $target = shift;
457    $target ||= shift;
458    $conn->conn->send_msg(mode => $target, @_);
459    return;
460}
461
462sub cmd_join {
463    my $cmd = shift;
464    my $conn = shift;
465    my $chan = shift or die("Usage: $cmd channel\n");
466    $conn->conn->send_msg(join => $chan, @_);
467    return;
468}
469
470sub cmd_part {
471    my $cmd = shift;
472    my $conn = shift;
473    my $chan = shift;
474    $conn->conn->send_msg(part => $chan);
475    return;
476}
477
478sub cmd_nick {
479    my $cmd = shift;
480    my $conn = shift;
481    my $nick = shift or die("Usage: $cmd <new nick>\n");
482    $conn->conn->send_msg(nick => $nick);
483    return;
484}
485
486sub cmd_names {
487    my $cmd = shift;
488    my $conn = shift;
489    my $chan = shift;
490    $conn->names_tmp([]);
491    $conn->conn->send_msg(names => $chan);
492    return;
493}
494
495sub cmd_whois {
496    my $cmd = shift;
497    my $conn = shift;
498    my $who = shift || die("Usage: $cmd <user>\n");
499    $conn->conn->send_msg(whois => $who);
500    return;
501}
502
503sub cmd_motd {
504    my $cmd = shift;
505    my $conn = shift;
506    $conn->conn->send_msg('motd');
507    return;
508}
509
510sub cmd_list {
511    my $cmd = shift;
512    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
513    while (my ($alias, $conn) = each %ircnets) {
514        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
515    }
516    BarnOwl::popless_ztext($message);
517    return;
518}
519
520sub cmd_who {
521    my $cmd = shift;
522    my $conn = shift;
523    my $who = shift || die("Usage: $cmd <user>\n");
524    $conn->conn->send_msg(who => $who);
525    return;
526}
527
528sub cmd_stats {
529    my $cmd = shift;
530    my $conn = shift;
531    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
532    $conn->conn->send_msg(stats => $type, @_);
533    return;
534}
535
536sub cmd_topic {
537    my $cmd = shift;
538    my $conn = shift;
539    my $chan = shift;
540    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
541    return;
542}
543
544sub cmd_quote {
545    my $cmd = shift;
546    my $conn = shift;
547    $conn->conn->send_msg(@_);
548    return;
549}
550
551################################################################################
552########################### Utilities/Helpers ##################################
553################################################################################
554
555sub find_channel {
556    my $channel = shift;
557    my @found;
558    for my $conn (values %ircnets) {
559        if($conn->conn->{channel_list}{lc $channel}) {
560            push @found, $conn;
561        }
562    }
563    return $found[0] if(scalar @found == 1);
564}
565
566sub mk_irc_command {
567    my $sub = shift;
568    my $flags = shift || 0;
569    return sub {
570        my $cmd = shift;
571        my $conn;
572        my $alias;
573        my $channel;
574        my $getopt = Getopt::Long::Parser->new;
575        my $m = BarnOwl::getcurmsg();
576
577        local @ARGV = @_;
578        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
579        $getopt->getoptions("alias=s" => \$alias);
580
581        if(defined($alias)) {
582            $conn = get_connection_by_alias($alias,
583                                            $flags & ALLOW_DISCONNECTED);
584        }
585        if($flags & CHANNEL_ARG) {
586            $channel = $ARGV[0];
587            if(defined($channel) && $channel =~ /^#/) {
588                if(my $c = find_channel($channel)) {
589                    shift @ARGV;
590                    $conn ||= $c;
591                }
592            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
593                $channel = $m->channel;
594            } else {
595                undef $channel;
596            }
597        }
598
599        if(!$channel &&
600           ($flags & CHANNEL_ARG) &&
601           !($flags & CHANNEL_OPTIONAL)) {
602            die("Usage: $cmd <channel>\n");
603        }
604        if(!$conn) {
605            if($m && $m->type eq 'IRC') {
606                $conn = get_connection_by_alias($m->network,
607                                               $flags & ALLOW_DISCONNECTED);
608            }
609        }
610        if(!$conn && scalar keys %ircnets == 1) {
611            $conn = [values(%ircnets)]->[0];
612        }
613        if(!$conn) {
614            die("You must specify an IRC network using -a.\n");
615        }
616        if($flags & CHANNEL_ARG) {
617            $sub->($cmd, $conn, $channel, @ARGV);
618        } else {
619            $sub->($cmd, $conn, @ARGV);
620        }
621    };
622}
623
624sub get_connection_by_alias {
625    my $key = shift;
626    my $allow_disconnected = shift;
627
628    my $conn = $ircnets{$key};
629    die("No such ircnet: $key\n") unless $conn;
630    if ($conn->conn->{registered} || $allow_disconnected) {
631        return $conn;
632    }
633    die("[@{[$conn->alias]}] Not currently connected.");
634}
635
6361;
Note: See TracBrowser for help on using the repository browser.