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>, 11 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
RevLine 
[b38b0b2]1use strict;
2use warnings;
3
4package BarnOwl::Module::IRC;
5
6=head1 NAME
7
[2c40dc0]8BarnOwl::Module::IRC
[b38b0b2]9
10=head1 DESCRIPTION
11
[2c40dc0]12This module implements IRC support for barnowl.
[b38b0b2]13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::IRC;
[380b1ab]19use BarnOwl::Module::IRC::Connection qw(is_private);
[ab9cd8f]20use BarnOwl::Module::IRC::Completion;
[b38b0b2]21
22use Net::IRC;
23use Getopt::Long;
[9620c8d]24use Encode;
[b38b0b2]25
[2c40dc0]26our $VERSION = 0.02;
[b38b0b2]27
28our $irc;
29
30# Hash alias -> BarnOwl::Module::IRC::Connection object
31our %ircnets;
[fe8cad8]32our %channels;
[3b4ba7d]33our %reconnect;
[b38b0b2]34
35sub startup {
[b10f340]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       });
[cd12307]55
[b10f340]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 ' .
[cd12307]60        'admin messages. Intended for debugging and development use only.'
[b10f340]61       });
[f81176c]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
[b38b0b2]71    register_commands();
72    register_handlers();
[96f7b07]73    BarnOwl::filter(qw{irc type ^IRC$ or ( type ^admin$ and adminheader ^IRC$ )});
[b38b0b2]74}
75
76sub shutdown {
77    for my $conn (values %ircnets) {
[ba2ca66]78        $conn->conn->disconnect();
[b38b0b2]79    }
80}
81
[f17bb2c0]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
[da554da]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);
[6396c1e]97        $list .= BarnOwl::Style::boldify("IRC channels for $net ($nick\@$server)");
98        $list .= "\n";
[da554da]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
[9c7a701]109#sub mainloop_hook {
110#    return unless defined $irc;
111#    eval {
112#        $irc->do_one_loop();
113#    };
114#    return;
115#}
116
117sub OwlProcess {
[b38b0b2]118    return unless defined $irc;
119    eval {
120        $irc->do_one_loop();
121    };
122    return;
123}
124
[9c7a701]125
[b38b0b2]126sub register_handlers {
127    if(!$irc) {
128        $irc = Net::IRC->new;
129        $irc->timeout(0);
130    }
131}
132
[f81176c]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
[54b4a87]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
[416241f]164=item C<ALLOW_DISCONNECTED>
165
166C<IRC-CONNECTION> may be a disconnected connection object that is
167currently pending a reconnect.
168
[54b4a87]169=back
170
171=cut
172
173use constant CHANNEL_ARG        => 1;
174use constant CHANNEL_OPTIONAL   => 2;
[330c55a]175
[416241f]176use constant ALLOW_DISCONNECTED => 4;
177
[b38b0b2]178sub register_commands {
[f17bb2c0]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]',
[cd12307]185            description => <<END_DESCR
186Connect to an IRC server. Supported options are:
[f17bb2c0]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(
[416241f]205        'irc-disconnect' => mk_irc_command( \&cmd_disconnect, ALLOW_DISCONNECTED ),
[f17bb2c0]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(
[e0fba58]218        'irc-msg' => mk_irc_command( \&cmd_msg ),
[f17bb2c0]219        {
220            summary => 'Send an IRC message',
221            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
222
223            description => <<END_DESCR
[cd12307]224Send an IRC message.
[f17bb2c0]225END_DESCR
226        }
227    );
228
229    BarnOwl::new_command(
[54b4a87]230        'irc-mode' => mk_irc_command( \&cmd_mode, CHANNEL_OPTIONAL|CHANNEL_ARG ),
[f17bb2c0]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',
[1b62a55]245            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
[f17bb2c0]246
247            description => <<END_DESCR
248Join an IRC channel.
249END_DESCR
250        }
251    );
252
253    BarnOwl::new_command(
[54b4a87]254        'irc-part' => mk_irc_command( \&cmd_part, CHANNEL_ARG ),
[f17bb2c0]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(
[54b4a87]279        'irc-names' => mk_irc_command( \&cmd_names, CHANNEL_ARG ),
[f17bb2c0]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(
[54b4a87]332        'irc-topic' => mk_irc_command( \&cmd_topic, CHANNEL_ARG ),
[f17bb2c0]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    );
[b38b0b2]360}
361
[f17bb2c0]362
[167044b]363$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
364$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
[f17bb2c0]365$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
[da554da]366$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::IRC::buddylist");
[b38b0b2]367
368################################################################################
369######################## Owl command handlers ##################################
370################################################################################
371
372sub cmd_connect {
373    my $cmd = shift;
374
[2c40dc0]375    my $nick = BarnOwl::getvar('irc:nick');
376    my $username = BarnOwl::getvar('irc:user');
377    my $ircname = BarnOwl::getvar('irc:name');
[b38b0b2]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,
[2c40dc0]389            "password=s" => \$password,
[b10f340]390            "nick=s"     => \$nick,
[2c40dc0]391        );
[b38b0b2]392        $host = shift @ARGV or die("Usage: $cmd HOST\n");
393        if(!$alias) {
[f094fc4]394            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
[b0c8011]395                $alias = $1;
396            } else {
397                $alias = $host;
398            }
[b38b0b2]399        }
400        $ssl ||= 0;
[f094fc4]401        $port = shift @ARGV || ($ssl ? 6697 : 6667);
[b38b0b2]402    }
403
[b0c8011]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
[b38b0b2]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
[cab045b]419    if ($conn->conn->connected) {
[3b4ba7d]420        $conn->connected("Connected to $alias as $nick");
[5ff830a]421    } else {
422        die("IRC::Connection->connect failed: $!");
423    }
424
[b38b0b2]425    return;
426}
427
428sub cmd_disconnect {
[ac374fc]429    my $cmd = shift;
430    my $conn = shift;
[416241f]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    }
[b38b0b2]438}
439
440sub cmd_msg {
[330c55a]441    my $cmd  = shift;
442    my $conn = shift;
[e0fba58]443    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
[2c40dc0]444    # handle multiple recipients?
[b38b0b2]445    if(@_) {
446        process_msg($conn, $to, join(" ", @_));
447    } else {
[744769e]448        BarnOwl::start_edit_win(BarnOwl::quote('/msg', '-a', $conn->alias, $to), sub {process_msg($conn, $to, @_)});
[b38b0b2]449    }
[48f7d12]450    return;
[b38b0b2]451}
452
453sub process_msg {
454    my $conn = shift;
455    my $to = shift;
[9a023d0]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);
[919535f]484    }
[48f7d12]485    return;
[b38b0b2]486}
487
[e625b5e]488sub cmd_mode {
489    my $cmd = shift;
490    my $conn = shift;
491    my $target = shift;
492    $target ||= shift;
493    $conn->conn->mode($target, @_);
[48f7d12]494    return;
[e625b5e]495}
496
[2c40dc0]497sub cmd_join {
498    my $cmd = shift;
[330c55a]499    my $conn = shift;
[2c40dc0]500    my $chan = shift or die("Usage: $cmd channel\n");
[fe8cad8]501    $channels{$chan} ||= [];
502    push @{$channels{$chan}}, $conn;
[1b62a55]503    $conn->conn->join($chan, @_);
[48f7d12]504    return;
[2c40dc0]505}
[b38b0b2]506
[6858d2d]507sub cmd_part {
508    my $cmd = shift;
[330c55a]509    my $conn = shift;
510    my $chan = shift;
[fe8cad8]511    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
[ba2ca66]512    $conn->conn->part($chan);
[48f7d12]513    return;
[6858d2d]514}
515
[6286f26]516sub cmd_nick {
517    my $cmd = shift;
[330c55a]518    my $conn = shift;
[b0c8011]519    my $nick = shift or die("Usage: $cmd <new nick>\n");
[ba2ca66]520    $conn->conn->nick($nick);
[48f7d12]521    return;
[6286f26]522}
523
[6858d2d]524sub cmd_names {
525    my $cmd = shift;
[330c55a]526    my $conn = shift;
527    my $chan = shift;
[d264c6d]528    $conn->names_tmp([]);
[ba2ca66]529    $conn->conn->names($chan);
[48f7d12]530    return;
[6858d2d]531}
532
[b0c8011]533sub cmd_whois {
534    my $cmd = shift;
[330c55a]535    my $conn = shift;
[b0c8011]536    my $who = shift || die("Usage: $cmd <user>\n");
[ba2ca66]537    $conn->conn->whois($who);
[48f7d12]538    return;
[b0c8011]539}
540
[56e72d5]541sub cmd_motd {
542    my $cmd = shift;
[330c55a]543    my $conn = shift;
[ba2ca66]544    $conn->conn->motd;
[48f7d12]545    return;
[56e72d5]546}
547
[f094fc4]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);
[48f7d12]555    return;
[f094fc4]556}
557
558sub cmd_who {
559    my $cmd = shift;
[330c55a]560    my $conn = shift;
[f094fc4]561    my $who = shift || die("Usage: $cmd <user>\n");
[330c55a]562    BarnOwl::error("WHO $cmd $conn $who");
[f094fc4]563    $conn->conn->who($who);
[48f7d12]564    return;
[f094fc4]565}
566
567sub cmd_stats {
568    my $cmd = shift;
[330c55a]569    my $conn = shift;
[f094fc4]570    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
571    $conn->conn->stats($type, @_);
[48f7d12]572    return;
[f094fc4]573}
574
[3ad15ff]575sub cmd_topic {
576    my $cmd = shift;
[330c55a]577    my $conn = shift;
578    my $chan = shift;
579    $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
[48f7d12]580    return;
[3ad15ff]581}
582
[af9de56]583sub cmd_quote {
584    my $cmd = shift;
585    my $conn = shift;
586    $conn->conn->sl(join(" ", @_));
[48f7d12]587    return;
[af9de56]588}
589
[b38b0b2]590################################################################################
591########################### Utilities/Helpers ##################################
592################################################################################
593
[330c55a]594sub mk_irc_command {
595    my $sub = shift;
[54b4a87]596    my $flags = shift || 0;
[330c55a]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();
[b38b0b2]604
[330c55a]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)) {
[416241f]610            $conn = get_connection_by_alias($alias,
611                                            $flags & ALLOW_DISCONNECTED);
[330c55a]612        }
[54b4a87]613        if($flags & CHANNEL_ARG) {
[e625b5e]614            $channel = $ARGV[0];
[330c55a]615            if(defined($channel) && $channel =~ /^#/) {
616                if($channels{$channel} && @{$channels{$channel}} == 1) {
[e625b5e]617                    shift @ARGV;
[ecee82f]618                    $conn = $channels{$channel}[0] unless $conn;
[330c55a]619                }
[ecee82f]620            } elsif ($m && $m->type eq 'IRC' && !$m->is_private) {
621                $channel = $m->channel;
622            } else {
623                undef $channel;
[330c55a]624            }
625        }
[ecee82f]626
[54b4a87]627        if(!$channel &&
628           ($flags & CHANNEL_ARG) &&
629           !($flags & CHANNEL_OPTIONAL)) {
[330c55a]630            die("Usage: $cmd <channel>\n");
631        }
632        if(!$conn) {
633            if($m && $m->type eq 'IRC') {
[416241f]634                $conn = get_connection_by_alias($m->network,
635                                               $flags & ALLOW_DISCONNECTED);
[330c55a]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        }
[54b4a87]644        if($flags & CHANNEL_ARG) {
[330c55a]645            $sub->($cmd, $conn, $channel, @ARGV);
646        } else {
647            $sub->($cmd, $conn, @ARGV);
648        }
649    };
[6858d2d]650}
651
[b38b0b2]652sub get_connection_by_alias {
[2c40dc0]653    my $key = shift;
[416241f]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")
[b38b0b2]659}
660
6611;
Note: See TracBrowser for help on using the repository browser.