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

debianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 7433402 was 1b62a55, checked in by Alex Vandiver <alexmv@mit.edu>, 15 years ago
Add support for private channel keys
  • Property mode set to 100644
File size: 14.7 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);
20
21use Net::IRC;
22use Getopt::Long;
23
24our $VERSION = 0.02;
25
26our $irc;
27
28# Hash alias -> BarnOwl::Module::IRC::Connection object
29our %ircnets;
30our %channels;
31
32sub startup {
33    BarnOwl::new_variable_string('irc:nick', {
34        default     => $ENV{USER},
35        summary     => 'The default IRC nickname',
36        description => 'By default, irc-connect will use this nick '  .
37        'when connecting to a new server. See :help irc-connect for ' .
38        'more information.'
39       });
40
41    BarnOwl::new_variable_string('irc:user', {
42        default => $ENV{USER},
43        summary => 'The IRC "username" field'
44       });
45        BarnOwl::new_variable_string('irc:name', {
46        default => "",
47        summary     => 'A short name field for IRC',
48        description => 'A short (maybe 60 or so chars) piece of text, ' .
49        'originally intended to display your real name, which people '  .
50        'often use for pithy quotes and URLs.'
51       });
52   
53    BarnOwl::new_variable_bool('irc:spew', {
54        default     => 0,
55        summary     => 'Show unhandled IRC events',
56        description => 'If set, display all unrecognized IRC events as ' .
57        'admin messages. Intended for debugging and development use only '
58       });
59   
60    register_commands();
61    register_handlers();
62    BarnOwl::filter('irc type ^IRC$');
63}
64
65sub shutdown {
66    for my $conn (values %ircnets) {
67        $conn->conn->disconnect();
68    }
69}
70
71sub quickstart {
72    return <<'END_QUICKSTART';
73@b[IRC:]
74Use ':irc-connect @b[server]' to connect to an IRC server, and
75':irc-join @b[#channel]' to join a channel. ':irc-msg @b[#channel]
76@b[message]' sends a message to a channel.
77END_QUICKSTART
78}
79
80#sub mainloop_hook {
81#    return unless defined $irc;
82#    eval {
83#        $irc->do_one_loop();
84#    };
85#    return;
86#}
87
88sub OwlProcess {
89    return unless defined $irc;
90    eval {
91        $irc->do_one_loop();
92    };
93    return;
94}
95
96
97sub register_handlers {
98    if(!$irc) {
99        $irc = Net::IRC->new;
100        $irc->timeout(0);
101    }
102}
103
104use constant OPTIONAL_CHANNEL => 1;
105use constant REQUIRE_CHANNEL => 2;
106
107sub register_commands {
108    BarnOwl::new_command(
109        'irc-connect' => \&cmd_connect,
110        {
111            summary => 'Connect to an IRC server',
112            usage =>
113'irc-connect [-a ALIAS ] [-s] [-p PASSWORD] [-n NICK] SERVER [port]',
114            description =>
115
116              <<END_DESCR
117Connect to an IRC server. Supported options are
118
119 -a <alias>          Define an alias for this server
120 -s                  Use SSL
121 -p <password>       Specify the password to use
122 -n <nick>           Use a non-default nick
123
124The -a option specifies an alias to use for this connection. This
125alias can be passed to the '-a' argument of any other IRC command to
126control which connection it operates on.
127
128For servers with hostnames of the form "irc.FOO.{com,org,...}", the
129alias will default to "FOO"; For other servers the full hostname is
130used.
131END_DESCR
132        }
133    );
134
135    BarnOwl::new_command(
136        'irc-disconnect' => mk_irc_command( \&cmd_disconnect ),
137        {
138            summary => 'Disconnect from an IRC server',
139            usage   => 'irc-disconnect [-a ALIAS]',
140
141            description => <<END_DESCR
142Disconnect from an IRC server. You can specify a specific server with
143"-a SERVER-ALIAS" if necessary.
144END_DESCR
145        }
146    );
147
148    BarnOwl::new_command(
149        'irc-msg' => mk_irc_command( \&cmd_msg ),
150        {
151            summary => 'Send an IRC message',
152            usage   => 'irc-msg [-a ALIAS] DESTINATION MESSAGE',
153
154            description => <<END_DESCR
155Send an IRC message
156END_DESCR
157        }
158    );
159
160    BarnOwl::new_command(
161        'irc-mode' => mk_irc_command( \&cmd_mode, OPTIONAL_CHANNEL ),
162        {
163            summary => 'Change an IRC channel or user mode',
164            usage   => 'irc-mode [-a ALIAS] TARGET [+-]MODE OPTIONS',
165
166            description => <<END_DESCR
167
168Change the mode of an IRC user or channel.
169END_DESCR
170        }
171    );
172
173    BarnOwl::new_command(
174        'irc-join' => mk_irc_command( \&cmd_join ),
175        {
176            summary => 'Join an IRC channel',
177            usage   => 'irc-join [-a ALIAS] #channel [KEY]',
178
179            description => <<END_DESCR
180
181Join an IRC channel.
182END_DESCR
183        }
184    );
185
186    BarnOwl::new_command(
187        'irc-part' => mk_irc_command( \&cmd_part, REQUIRE_CHANNEL ),
188        {
189            summary => 'Leave an IRC channel',
190            usage   => 'irc-part [-a ALIAS] #channel',
191
192            description => <<END_DESCR
193
194Part from an IRC channel.
195END_DESCR
196        }
197    );
198
199    BarnOwl::new_command(
200        'irc-nick' => mk_irc_command( \&cmd_nick ),
201        {
202            summary => 'Change your IRC nick on an existing connection.',
203            usage   => 'irc-nick [-a ALIAS] NEW-NICK',
204
205            description => <<END_DESCR
206
207Set your IRC nickname on an existing connect. To change it prior to
208connecting, adjust the `irc:nick' variable.
209END_DESCR
210        }
211    );
212
213    BarnOwl::new_command(
214        'irc-names' => mk_irc_command( \&cmd_names, REQUIRE_CHANNEL ),
215        {
216            summary => 'View the list of users in a channel',
217            usage   => 'irc-names [-a ALIAS] #channel',
218
219            description => <<END_DESCR
220
221`irc-names' displays the list of users in a given channel in a pop-up
222window.
223END_DESCR
224        }
225    );
226
227    BarnOwl::new_command(
228        'irc-whois' => mk_irc_command( \&cmd_whois ),
229        {
230            summary => 'Displays information about a given IRC user',
231            usage   => 'irc-whois [-a ALIAS] NICK',
232
233            description => <<END_DESCR
234
235Pops up information about a given IRC user.
236END_DESCR
237        }
238    );
239
240    BarnOwl::new_command(
241        'irc-motd' => mk_irc_command( \&cmd_motd ),
242        {
243            summary => 'Displays an IRC server\'s MOTD (Message of the Day)',
244            usage   => 'irc-motd [-a ALIAS]',
245
246            description => <<END_DESCR
247
248Displays an IRC server's message of the day.
249END_DESCR
250        }
251    );
252
253    BarnOwl::new_command(
254        'irc-list' => \&cmd_list,
255        {
256            summary => 'Show all the active IRC connections.',
257            usage   => 'irc-list',
258
259            description => <<END_DESCR
260
261Show all the currently active IRC connections with their aliases and
262server names.
263END_DESCR
264        }
265    );
266
267    BarnOwl::new_command( 'irc-who'   => mk_irc_command( \&cmd_who ) );
268    BarnOwl::new_command( 'irc-stats' => mk_irc_command( \&cmd_stats ) );
269
270    BarnOwl::new_command(
271        'irc-topic' => mk_irc_command( \&cmd_topic, REQUIRE_CHANNEL ),
272        {
273            summary => 'View or change the topic of an IRC channel',
274            usage   => 'irc-topic [-a ALIAS] #channel [TOPIC]',
275
276            description => <<END_DESCR
277
278Without extra arguments, fetches and displays a given channel's topic.
279
280With extra arguments, changes the target channel's topic string. This
281may require +o on some channels.
282END_DESCR
283        }
284    );
285
286    BarnOwl::new_command(
287        'irc-quote' => mk_irc_command( \&cmd_quote ),
288        {
289            summary => 'Send a raw command to the IRC servers.',
290            usage   => 'irc-quote [-a ALIAS] TEXT',
291
292            description => <<END_DESCR
293
294Send a raw command line to an IRC server.
295
296This can be used to perform some operation not yet supported by
297BarnOwl, or to define new IRC commands.
298END_DESCR
299        }
300    );
301}
302
303
304$BarnOwl::Hooks::startup->add('BarnOwl::Module::IRC::startup');
305$BarnOwl::Hooks::shutdown->add('BarnOwl::Module::IRC::shutdown');
306$BarnOwl::Hooks::getQuickstart->add('BarnOwl::Module::IRC::quickstart');
307
308################################################################################
309######################## Owl command handlers ##################################
310################################################################################
311
312sub cmd_connect {
313    my $cmd = shift;
314
315    my $nick = BarnOwl::getvar('irc:nick');
316    my $username = BarnOwl::getvar('irc:user');
317    my $ircname = BarnOwl::getvar('irc:name');
318    my $host;
319    my $port;
320    my $alias;
321    my $ssl;
322    my $password = undef;
323
324    {
325        local @ARGV = @_;
326        GetOptions(
327            "alias=s"    => \$alias,
328            "ssl"        => \$ssl,
329            "password=s" => \$password,
330            "nick=s"     => \$nick,
331        );
332        $host = shift @ARGV or die("Usage: $cmd HOST\n");
333        if(!$alias) {
334            if($host =~ /^(?:irc[.])?([\w-]+)[.]\w+$/) {
335                $alias = $1;
336            } else {
337                $alias = $host;
338            }
339        }
340        $ssl ||= 0;
341        $port = shift @ARGV || ($ssl ? 6697 : 6667);
342    }
343
344    if(exists $ircnets{$alias}) {
345        die("Already connected to a server with alias '$alias'. Either disconnect or specify an alias with -a.\n");
346    }
347
348    my $conn = BarnOwl::Module::IRC::Connection->new($irc, $alias,
349        Nick      => $nick,
350        Server    => $host,
351        Port      => $port,
352        Username  => $username,
353        Ircname   => $ircname,
354        Port      => $port,
355        Password  => $password,
356        SSL       => $ssl
357       );
358
359    if ($conn->conn->connected) {
360        BarnOwl::admin_message("IRC", "Connected to $alias as $nick");
361        $ircnets{$alias} = $conn;
362        my $fd = $conn->getSocket()->fileno();
363        BarnOwl::add_dispatch($fd, \&OwlProcess);
364        $conn->{FD} = $fd;
365    } else {
366        die("IRC::Connection->connect failed: $!");
367    }
368
369    return;
370}
371
372sub cmd_disconnect {
373    my $cmd = shift;
374    my $conn = shift;
375    $conn->conn->disconnect;
376    delete $ircnets{$conn->alias};
377}
378
379sub cmd_msg {
380    my $cmd  = shift;
381    my $conn = shift;
382    my $to = shift or die("Usage: $cmd [NICK|CHANNEL]\n");
383    # handle multiple recipients?
384    if(@_) {
385        process_msg($conn, $to, join(" ", @_));
386    } else {
387        BarnOwl::start_edit_win("/msg -a " . $conn->alias . " $to", sub {process_msg($conn, $to, @_)});
388    }
389}
390
391sub process_msg {
392    my $conn = shift;
393    my $to = shift;
394    my $body = shift;
395    # Strip whitespace. In the future -- send one message/line?
396    $body =~ tr/\n\r/  /;
397    if ($body =~ /^\/me (.*)/) {
398        $conn->conn->me($to, $1);
399        $body = '* '.$conn->nick.' '.$1;
400    } else {
401        $conn->conn->privmsg($to, $body);
402    }
403    my $msg = BarnOwl::Message->new(
404        type        => 'IRC',
405        direction   => is_private($to) ? 'out' : 'in',
406        server      => $conn->server,
407        network     => $conn->alias,
408        recipient   => $to,
409        body        => $body,
410        sender      => $conn->nick,
411        is_private($to) ?
412          (isprivate  => 'true') : (channel => $to),
413        replycmd    => "irc-msg -a " . $conn->alias . " $to",
414        replysendercmd => "irc-msg -a " . $conn->alias . " $to"
415       );
416    BarnOwl::queue_message($msg);
417}
418
419sub cmd_mode {
420    my $cmd = shift;
421    my $conn = shift;
422    my $target = shift;
423    $target ||= shift;
424    $conn->conn->mode($target, @_);
425}
426
427sub cmd_join {
428    my $cmd = shift;
429    my $conn = shift;
430    my $chan = shift or die("Usage: $cmd channel\n");
431    $channels{$chan} ||= [];
432    push @{$channels{$chan}}, $conn;
433    $conn->conn->join($chan, @_);
434}
435
436sub cmd_part {
437    my $cmd = shift;
438    my $conn = shift;
439    my $chan = shift;
440    $channels{$chan} = [grep {$_ ne $conn} @{$channels{$chan} || []}];
441    $conn->conn->part($chan);
442}
443
444sub cmd_nick {
445    my $cmd = shift;
446    my $conn = shift;
447    my $nick = shift or die("Usage: $cmd <new nick>\n");
448    $conn->conn->nick($nick);
449}
450
451sub cmd_names {
452    my $cmd = shift;
453    my $conn = shift;
454    my $chan = shift;
455    $conn->names_tmp([]);
456    $conn->conn->names($chan);
457}
458
459sub cmd_whois {
460    my $cmd = shift;
461    my $conn = shift;
462    my $who = shift || die("Usage: $cmd <user>\n");
463    $conn->conn->whois($who);
464}
465
466sub cmd_motd {
467    my $cmd = shift;
468    my $conn = shift;
469    $conn->conn->motd;
470}
471
472sub cmd_list {
473    my $cmd = shift;
474    my $message = BarnOwl::Style::boldify('Current IRC networks:') . "\n";
475    while (my ($alias, $conn) = each %ircnets) {
476        $message .= '  ' . $alias . ' => ' . $conn->nick . '@' . $conn->server . "\n";
477    }
478    BarnOwl::popless_ztext($message);
479}
480
481sub cmd_who {
482    my $cmd = shift;
483    my $conn = shift;
484    my $who = shift || die("Usage: $cmd <user>\n");
485    BarnOwl::error("WHO $cmd $conn $who");
486    $conn->conn->who($who);
487}
488
489sub cmd_stats {
490    my $cmd = shift;
491    my $conn = shift;
492    my $type = shift || die("Usage: $cmd <chiklmouy> [server] \n");
493    $conn->conn->stats($type, @_);
494}
495
496sub cmd_topic {
497    my $cmd = shift;
498    my $conn = shift;
499    my $chan = shift;
500    $conn->conn->topic($chan, @_ ? join(" ", @_) : undef);
501}
502
503sub cmd_quote {
504    my $cmd = shift;
505    my $conn = shift;
506    $conn->conn->sl(join(" ", @_));
507}
508
509################################################################################
510########################### Utilities/Helpers ##################################
511################################################################################
512
513sub mk_irc_command {
514    my $sub = shift;
515    my $use_channel = shift || 0;
516    return sub {
517        my $cmd = shift;
518        my $conn;
519        my $alias;
520        my $channel;
521        my $getopt = Getopt::Long::Parser->new;
522        my $m = BarnOwl::getcurmsg();
523
524        local @ARGV = @_;
525        $getopt->configure(qw(pass_through permute no_getopt_compat prefix_pattern=-|--));
526        $getopt->getoptions("alias=s" => \$alias);
527
528        if(defined($alias)) {
529            $conn = get_connection_by_alias($alias);
530        }
531        if(!$conn && $use_channel) {
532            $channel = $ARGV[0];
533            if(defined($channel) && $channel =~ /^#/) {
534                if($channels{$channel} && @{$channels{$channel}} == 1) {
535                    shift @ARGV;
536                    $conn = $channels{$channel}[0];
537                } 
538            } else {
539                if($m && $m->type eq 'IRC' && !$m->is_private) {
540                    $channel = $m->channel;
541                } else {
542                    undef $channel;
543                }
544            }
545        }
546        if(!$channel && $use_channel == REQUIRE_CHANNEL) {
547            die("Usage: $cmd <channel>\n");
548        }
549        if(!$conn) {
550            if($m && $m->type eq 'IRC') {
551                $conn = get_connection_by_alias($m->network);
552            }
553        }
554        if(!$conn && scalar keys %ircnets == 1) {
555            $conn = [values(%ircnets)]->[0];
556        }
557        if(!$conn) {
558            die("You must specify an IRC network using -a.\n");
559        }
560        if($use_channel) {
561            $sub->($cmd, $conn, $channel, @ARGV);
562        } else {
563            $sub->($cmd, $conn, @ARGV);
564        }
565    };
566}
567
568sub get_connection_by_alias {
569    my $key = shift;
570    die("No such ircnet: $key\n") unless exists $ircnets{$key};
571    return $ircnets{$key};
572}
573
5741;
Note: See TracBrowser for help on using the repository browser.