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

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