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

Last change on this file since 55758dc was 8a22ff2, checked in by William Throwe <wtt6@cornell.edu>, 11 years ago
Make the -a option to irc-msg more optional The code now tries to determine the alias from the #channel argument if one is provided.
  • Property mode set to 100644
File size: 17.3 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<CHANNEL_EXPLICIT>
137
138Do not determine the channel from the current message. Only relevant
139with C<CHANNEL_ARG>.
140
141=item C<ALLOW_DISCONNECTED>
142
143C<IRC-CONNECTION> may be a disconnected connection object that is
144currently pending a reconnect.
145
146=back
147
148=cut
149
150use constant CHANNEL_ARG        => 1;
151use constant CHANNEL_OPTIONAL   => 2;
152use constant CHANNEL_EXPLICIT   => 4;
153
154use constant ALLOW_DISCONNECTED => 8;
155
156sub register_commands {
157    BarnOwl::new_command(
158        'irc-connect' => \&cmd_connect,
159        {
160            summary => 'Connect to an IRC server',
161            usage =>
162'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
163            description => <<END_DESCR
164Connect to an IRC server. Supported options are:
165
166 -a <alias>          Define an alias for this server
167 -s                  Use SSL
168 -p <password>       Specify the password to use
169 -n <nick>           Use a non-default nick
170
171The -a option specifies an alias to use for this connection. This
172alias can be passed to the '-a' argument of any other IRC command to
173control which connection it operates on.
174
175For servers with hostnames of the form "irc.FOO.{com,org,...}", the
176alias will default to "FOO"; For other servers the full hostname is
177used.
178END_DESCR
179        }
180    );
181
182    BarnOwl::new_command(
183        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
184        {
185            summary => 'Disconnect from an IRC server',
186            usage   => 'irc-disconnect [-a ALIAS]',
187
188            description => <<END_DESCR
189Disconnect from an IRC server. You can specify a specific server with
190"-a SERVER-ALIAS" if necessary.
191END_DESCR
192        }
193    );
194
195    BarnOwl::new_command(
196        'irc-msg' => mk_irc_command( \&cmd_msg, CHANNEL_ARG|CHANNEL_OPTIONAL|CHANNEL_EXPLICIT ),
197        {
198            summary => 'Send an IRC message',
199            usage   => 'irc-msg [-a ALIAS] DESTINATION [MESSAGE]',
200
201            description => <<END_DESCR
202Send an IRC message.
203END_DESCR
204        }
205    );
206
207    BarnOwl::new_command(
208        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
209        {
210            summary => 'Change an IRC channel or user mode',
211            usage   => 'irc-mode [-a ALIAS] TARGET [+-]MODE OPTIONS',
212
213            description => <<END_DESCR
214Change the mode of an IRC user or channel.
215END_DESCR
216        }
217    );
218
219    BarnOwl::new_command(
220        'irc-join' => mk_irc_command( \&cmd_join ),
221        {
222            summary => 'Join an IRC channel',
223            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
224
225            description => <<END_DESCR
226Join an IRC channel.
227END_DESCR
228        }
229    );
230
231    BarnOwl::new_command(
232        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
233        {
234            summary => 'Leave an IRC channel',
235            usage   => 'irc-part [-a ALIAS] #channel',
236
237            description => <<END_DESCR
238Part from an IRC channel.
239END_DESCR
240        }
241    );
242
243    BarnOwl::new_command(
244        'irc-nick' => mk_irc_command( \&cmd_nick ),
245        {
246            summary => 'Change your IRC nick on an existing connection.',
247            usage   => 'irc-nick [-a ALIAS] NEW-NICK',
248
249            description => <<END_DESCR
250Set your IRC nickname on an existing connect. To change it prior to
251connecting, adjust the `irc:nick' variable.
252END_DESCR
253        }
254    );
255
256    BarnOwl::new_command(
257        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
258        {
259            summary => 'View the list of users in a channel',
260            usage   => 'irc-names [-a ALIAS] #channel',
261
262            description => <<END_DESCR
263`irc-names' displays the list of users in a given channel in a pop-up
264window.
265END_DESCR
266        }
267    );
268
269    BarnOwl::new_command(
270        'irc-whois' => mk_irc_command( \&cmd_whois ),
271        {
272            summary => 'Displays information about a given IRC user',
273            usage   => 'irc-whois [-a ALIAS] NICK',
274
275            description => <<END_DESCR
276Pops up information about a given IRC user.
277END_DESCR
278        }
279    );
280
281    BarnOwl::new_command(
282        'irc-motd' => mk_irc_command( \&cmd_motd ),
283        {
284            summary => 'Displays an IRC server\'s MOTD (Message of the Day)',
285            usage   => 'irc-motd [-a ALIAS]',
286
287            description => <<END_DESCR
288Displays an IRC server's message of the day.
289END_DESCR
290        }
291    );
292
293    BarnOwl::new_command(
294        'irc-list' => \&cmd_list,
295        {
296            summary => 'Show all the active IRC connections.',
297            usage   => 'irc-list',
298
299            description => <<END_DESCR
300Show all the currently active IRC connections with their aliases and
301server names.
302END_DESCR
303        }
304    );
305
306    BarnOwl::new_command( 'irc-who'   => mk_irc_command( \&cmd_who ) );
307    BarnOwl::new_command( 'irc-stats' => mk_irc_command( \&cmd_stats ) );
308
309    BarnOwl::new_command(
310        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
311        {
312            summary => 'View or change the topic of an IRC channel',
313            usage   => 'irc-topic [-a ALIAS] #channel [TOPIC]',
314
315            description => <<END_DESCR
316Without extra arguments, fetches and displays a given channel's topic.
317
318With extra arguments, changes the target channel's topic string. This
319may require +o on some channels.
320END_DESCR
321        }
322    );
323
324    BarnOwl::new_command(
325        'irc-quote' => mk_irc_command( \&cmd_quote ),
326        {
327            summary => 'Send a raw command to the IRC servers.',
328            usage   => 'irc-quote [-a ALIAS] TEXT',
329
330            description => <<END_DESCR
331Send a raw command line to an IRC server.
332
333This can be used to perform some operation not yet supported by
334BarnOwl, or to define new IRC commands.
335END_DESCR
336        }
337    );
338}
339
340
341$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
342$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
343$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
344$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
345
346################################################################################
347######################## Owl command handlers ##################################
348################################################################################
349
350sub cmd_connect {
351    my $cmd = shift;
352
353    my $nick = BarnOwl::getvar('irc:nick');
354    my $username = BarnOwl::getvar('irc:user');
355    my $ircname = BarnOwl::getvar('irc:name');
356    my $host;
357    my $port;
358    my $alias;
359    my $ssl;
360    my $password = undef;
361
362    {
363        local @ARGV = @_;
364        GetOptions(
365            "alias=s"    => \$alias,
366            "ssl"        => \$ssl,
367            "password=s" => \$password,
368            "nick=s"     => \$nick,
369        );
370        $host = shift @ARGV or die("Usage: $cmd HOST\n");
371        if(!$alias) {
372            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
373                $alias = $1;
374            } else {
375                $alias = $host;
376            }
377        }
378        $ssl ||= 0;
379        $port = shift @ARGV || ($ssl ? 6697 : 6667);
380    }
381
382    if(exists $ircnets{$alias}) {
383        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
384    }
385
386    my $conn = BarnOwl::Module::IRC::Connection->new($alias, $host, $port, {
387        nick      => $nick,
388        user      => $username,
389        real      => $ircname,
390        password  => $password,
391        SSL       => $ssl,
392        timeout   => sub {0}
393       });
394    $ircnets{$alias} = $conn;
395    return;
396}
397
398sub cmd_disconnect {
399    my $cmd = shift;
400    my $conn = shift;
401    if ($conn->conn->{socket}) {
402        $conn->did_quit(1);
403        $conn->conn->disconnect("Goodbye!");
404    } elsif ($conn->{reconnect_timer}) {
405        BarnOwl::admin_message('IRC',
406                               "[" . $conn->alias . "] Reconnect cancelled");
407        $conn->cancel_reconnect;
408        delete $ircnets{$conn->alias};
409    }
410}
411
412sub cmd_msg {
413    my $cmd  = shift;
414    my $conn = shift;
415    my $to = shift || shift or die("Usage: $cmd [NICK|CHANNEL]\n");
416    # handle multiple recipients?
417    if(@_) {
418        process_msg($conn, $to, join(" ", @_));
419    } else {
420        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
421    }
422    return;
423}
424
425sub process_msg {
426    my $conn = shift;
427    my $to = shift;
428    my $fullbody = shift;
429    my @msgs;
430    # Require the user to send in paragraphs (double-newline between) to
431    # actually send multiple PRIVMSGs, in order to play nice with autofill.
432    $fullbody =~ s/\r//g;
433    @msgs = split "\n\n", $fullbody;
434    map { tr/\n/ / } @msgs;
435    for my $body (@msgs) {
436        if ($body =~ /^\/me (.*)/) {
437            $conn->me($to, Encode::encode('utf-8', $1));
438            $body = '* '.$conn->nick.' '.$1;
439        } else {
440            $conn->conn->send_msg('privmsg', $to, Encode::encode('utf-8', $body));
441        }
442        my $msg = BarnOwl::Message->new(
443            type        => 'IRC',
444            direction   => is_private($to) ? 'out' : 'in',
445            server      => $conn->server,
446            network     => $conn->alias,
447            recipient   => $to,
448            body        => $body,
449            sender      => $conn->nick,
450            is_private($to) ?
451              (isprivate  => 'true') : (channel => $to),
452            replycmd    => BarnOwl::quote('irc-msg',  '-a', $conn->alias, $to),
453            replysendercmd => BarnOwl::quote('irc-msg', '-a', $conn->alias, $to),
454        );
455        BarnOwl::queue_message($msg);
456    }
457    return;
458}
459
460sub cmd_mode {
461    my $cmd = shift;
462    my $conn = shift;
463    my $target = shift;
464    $target ||= shift;
465    $conn->conn->send_msg(mode => $target, @_);
466    return;
467}
468
469sub cmd_join {
470    my $cmd = shift;
471    my $conn = shift;
472    my $chan = shift or die("Usage: $cmd channel\n");
473    $conn->conn->send_msg(join => $chan, @_);
474    return;
475}
476
477sub cmd_part {
478    my $cmd = shift;
479    my $conn = shift;
480    my $chan = shift;
481    $conn->conn->send_msg(part => $chan);
482    return;
483}
484
485sub cmd_nick {
486    my $cmd = shift;
487    my $conn = shift;
488    my $nick = shift or die("Usage: $cmd <new nick>\n");
489    $conn->conn->send_msg(nick => $nick);
490    return;
491}
492
493sub cmd_names {
494    my $cmd = shift;
495    my $conn = shift;
496    my $chan = shift;
497    $conn->names_tmp([]);
498    $conn->conn->send_msg(names => $chan);
499    return;
500}
501
502sub cmd_whois {
503    my $cmd = shift;
504    my $conn = shift;
505    my $who = shift || die("Usage: $cmd <user>\n");
506    $conn->conn->send_msg(whois => $who);
507    return;
508}
509
510sub cmd_motd {
511    my $cmd = shift;
512    my $conn = shift;
513    $conn->conn->send_msg('motd');
514    return;
515}
516
517sub cmd_list {
518    my $cmd = shift;
519    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
520    while (my ($alias, $conn) = each %ircnets) {
521        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
522    }
523    BarnOwl::popless_ztext($message);
524    return;
525}
526
527sub cmd_who {
528    my $cmd = shift;
529    my $conn = shift;
530    my $who = shift || die("Usage: $cmd <user>\n");
531    $conn->conn->send_msg(who => $who);
532    return;
533}
534
535sub cmd_stats {
536    my $cmd = shift;
537    my $conn = shift;
538    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
539    $conn->conn->send_msg(stats => $type, @_);
540    return;
541}
542
543sub cmd_topic {
544    my $cmd = shift;
545    my $conn = shift;
546    my $chan = shift;
547    $conn->conn->send_msg(topic => $chan, @_ ? join(" ", @_) : undef);
548    return;
549}
550
551sub cmd_quote {
552    my $cmd = shift;
553    my $conn = shift;
554    $conn->conn->send_msg(@_);
555    return;
556}
557
558################################################################################
559########################### Utilities/Helpers ##################################
560################################################################################
561
562sub find_channel {
563    my $channel = shift;
564    my @found;
565    for my $conn (values %ircnets) {
566        if($conn->conn->{channel_list}{lc $channel}) {
567            push @found, $conn;
568        }
569    }
570    return $found[0] if(scalar @found == 1);
571}
572
573sub mk_irc_command {
574    my $sub = shift;
575    my $flags = shift || 0;
576    return sub {
577        my $cmd = shift;
578        my $conn;
579        my $alias;
580        my $channel;
581        my $getopt = Getopt::Long::Parser->new;
582        my $m = BarnOwl::getcurmsg();
583
584        local @ARGV = @_;
585        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
586        $getopt->getoptions("alias=s" => \$alias);
587
588        if(defined($alias)) {
589            $conn = get_connection_by_alias($alias,
590                                            $flags & ALLOW_DISCONNECTED);
591        }
592        if($flags & CHANNEL_ARG) {
593            $channel = $ARGV[0];
594            if(defined($channel) && $channel =~ /^#/) {
595                shift @ARGV;
596                if(my $c = find_channel($channel)) {
597                    $conn ||= $c;
598                }
599            } elsif (!($flags & CHANNEL_EXPLICIT) &&
600                     $m && $m->type eq 'IRC' && !$m->is_private) {
601                $channel = $m->channel;
602            } else {
603                undef $channel;
604            }
605        }
606
607        if(!$channel &&
608           ($flags & CHANNEL_ARG) &&
609           !($flags & CHANNEL_OPTIONAL)) {
610            die("Usage: $cmd <channel>\n");
611        }
612        if(!$conn) {
613            if($m && $m->type eq 'IRC') {
614                $conn = get_connection_by_alias($m->network,
615                                               $flags & ALLOW_DISCONNECTED);
616            }
617        }
618        if(!$conn && scalar keys %ircnets == 1) {
619            $conn = [values(%ircnets)]->[0];
620        }
621        if(!$conn) {
622            die("You must specify an IRC network using -a.\n");
623        }
624        if($flags & CHANNEL_ARG) {
625            $sub->($cmd, $conn, $channel, @ARGV);
626        } else {
627            $sub->($cmd, $conn, @ARGV);
628        }
629    };
630}
631
632sub get_connection_by_alias {
633    my $key = shift;
634    my $allow_disconnected = shift;
635
636    my $conn = $ircnets{$key};
637    die("No such ircnet: $key\n") unless $conn;
638    if ($conn->conn->{registered} || $allow_disconnected) {
639        return $conn;
640    }
641    die("[@{[$conn->alias]}] Not currently connected.");
642}
643
6441;
Note: See TracBrowser for help on using the repository browser.