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

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