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

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