source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 731e921

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