source: perl/modules/IRC/lib/BarnOwl/Module/IRC.pm @ 618a980

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