source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm @ 89b700e

release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 89b700e was 89b700e, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 12 years ago
Broaden recognition of 'normal' messages As per RFC 3921, Section 2.1.1.: if an application receives a message with no 'type' attribute or the application does not understand the value of the 'type' attribute provided, it MUST consider the message to be of type "normal" (i.e., "normal" is the default).
  • Property mode set to 100644
File size: 44.6 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Module::Jabber;
5
6=head1 NAME
7
8BarnOwl::Module::Jabber
9
10=head1 DESCRIPTION
11
12This module implements Jabber support for barnowl.
13
14=cut
15
16use BarnOwl;
17use BarnOwl::Hooks;
18use BarnOwl::Message::Jabber;
19use BarnOwl::Module::Jabber::Connection;
20use BarnOwl::Module::Jabber::ConnectionManager;
21use BarnOwl::Completion::Util qw(complete_flags);
22
23use Authen::SASL qw(Perl);
24use Net::Jabber;
25use Net::Jabber::MUC;
26use Net::DNS;
27use Getopt::Long;
28Getopt::Long::Configure(qw(no_getopt_compat prefix_pattern=-|--));
29
30use utf8;
31
32our $VERSION = 0.1;
33
34BEGIN {
35    if(eval {require IO::Socket::SSL;}) {
36        if($IO::Socket::SSL::VERSION eq "0.97") {
37            BarnOwl::error("You are using IO::Socket:SSL 0.97, which \n" .
38                           "contains bugs causing it not to work with barnowl's\n" .
39                           "Jabber support. We recommend updating to the latest\n" .
40                           "IO::Socket::SSL from CPAN. \n");
41            die("Not loading Jabber.par\n");
42        }
43    }
44}
45
46no warnings 'redefine';
47
48################################################################################
49# owl perl jabber support
50#
51# XXX Todo:
52# Rosters for MUCs
53# More user feedback
54#  * joining MUC
55#  * parting MUC
56#  * presence (Roster and MUC)
57# Implementing formatting and logging callbacks for C
58# Appropriate callbacks for presence subscription messages.
59#
60################################################################################
61
62our $conn;
63$conn ||= BarnOwl::Module::Jabber::ConnectionManager->new;
64our %vars;
65our %completion_jids;
66
67sub onStart {
68    if ( *BarnOwl::queue_message{CODE} ) {
69        register_owl_commands();
70        register_keybindings();
71        register_filters();
72        $BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::Jabber::onGetBuddyList");
73        $BarnOwl::Hooks::getQuickstart->add("BarnOwl::Module::Jabber::onGetQuickstart");
74        $vars{show} = '';
75        BarnOwl::new_variable_bool("jabber:show_offline_buddies",
76                                   { default => 1,
77                                     summary => 'Show offline or pending buddies.'});
78        BarnOwl::new_variable_bool("jabber:show_logins",
79                                   { default => 0,
80                                     summary => 'Show login/logout messages.'});
81        BarnOwl::new_variable_bool("jabber:spew",
82                                   { default => 0,
83                                     summary => 'Display unrecognized Jabber messages.'});
84        BarnOwl::new_variable_int("jabber:auto_away_timeout",
85                                  { default => 5,
86                                    summary => 'After minutes idle, auto away.',
87                                  });
88        BarnOwl::new_variable_int("jabber:auto_xa_timeout",
89                                  { default => 15,
90                                    summary => 'After minutes idle, auto extended away.'
91                                });
92        BarnOwl::new_variable_bool("jabber:reconnect",
93                                  { default => 1,
94                                    summary => 'Auto-reconnect when disconnected from servers.'
95                                });
96        # Force these. Reload can screw them up.
97        # Taken from Net::Jabber::Protocol.
98        $Net::XMPP::Protocol::NEWOBJECT{'iq'}       = "Net::Jabber::IQ";
99        $Net::XMPP::Protocol::NEWOBJECT{'message'}  = "Net::Jabber::Message";
100        $Net::XMPP::Protocol::NEWOBJECT{'presence'} = "Net::Jabber::Presence";
101        $Net::XMPP::Protocol::NEWOBJECT{'jid'}      = "Net::Jabber::JID";
102    } else {
103        # Our owl doesn't support queue_message. Unfortunately, this
104        # means it probably *also* doesn't support BarnOwl::error. So just
105        # give up silently.
106    }
107}
108
109$BarnOwl::Hooks::startup->add("BarnOwl::Module::Jabber::onStart");
110
111sub do_keep_alive_and_auto_away {
112    if ( !$conn->connected() ) {
113        # We don't need this timer any more.
114        delete $vars{keepAliveTimer};
115        return;
116    }
117
118    $vars{status_changed} = 0;
119    my $auto_away = BarnOwl::getvar('jabber:auto_away_timeout');
120    my $auto_xa = BarnOwl::getvar('jabber:auto_xa_timeout');
121    my $idletime = BarnOwl::getidletime();
122    if ($auto_xa != 0 && $idletime >= (60 * $auto_xa) && ($vars{show} eq 'away' || $vars{show} eq '' )) {
123        $vars{show} = 'xa';
124        $vars{status} = 'Auto extended-away after '.$auto_xa.' minute'.($auto_xa == 1 ? '' : 's').' idle.';
125        $vars{status_changed} = 1;
126    } elsif ($auto_away != 0 && $idletime >= (60 * $auto_away) && $vars{show} eq '') {
127        $vars{show} = 'away';
128        $vars{status} = 'Auto away after '.$auto_away.' minute'.($auto_away == 1 ? '' : 's').' idle.';
129        $vars{status_changed} = 1;
130    } elsif ($idletime <= $vars{idletime} && $vars{show} ne '') {
131        $vars{show} = '';
132        $vars{status} = '';
133        $vars{status_changed} = 1;
134    }
135    $vars{idletime} = $idletime;
136
137    foreach my $jid ( $conn->getJIDs() ) {
138        next if $conn->jidActive($jid);
139        $conn->tryReconnect($jid);
140    }
141
142    foreach my $jid ( $conn->getJIDs() ) {
143        next unless $conn->jidActive($jid);
144
145        my $client = $conn->getConnectionFromJID($jid);
146        unless($client) {
147            $conn->removeConnection($jid);
148            BarnOwl::error("Connection for $jid undefined -- error in reload?");
149        }
150        my $status = $client->Process(0); # keep-alive
151        if ( !defined($status) ) {
152            $conn->scheduleReconnect($jid);
153        }
154        if ($::shutdown) {
155            do_logout($jid);
156            next;
157        }
158
159        if ($vars{status_changed}) {
160            my $p = new Net::Jabber::Presence;
161            $p->SetShow($vars{show}) if $vars{show};
162            $p->SetStatus($vars{status}) if $vars{status};
163            $client->Send($p);
164        }
165    }
166}
167
168our $showOffline = 0;
169
170sub blist_listBuddy {
171    my $roster = shift;
172    my $buddy  = shift;
173    my $blistStr .= "    ";
174    my %jq  = $roster->query($buddy);
175    my $res = $roster->resource($buddy);
176
177    my $name = $jq{name} || $buddy->GetUserID();
178
179    $blistStr .= sprintf '%-15s %s', $name, $buddy->GetJID();
180    $completion_jids{$name} = 1;
181    $completion_jids{$buddy->GetJID()} = 1;
182
183    if ($res) {
184        my %rq = $roster->resourceQuery( $buddy, $res );
185        $blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]";
186        $blistStr .= " " . $rq{status} if $rq{status};
187        $blistStr = BarnOwl::Style::boldify($blistStr) if $showOffline;
188    }
189    else {
190        return '' unless $showOffline;
191        if ($jq{ask}) {
192            $blistStr .= " [pending]";
193        }
194        elsif ($jq{subscription} eq 'none' || $jq{subscription} eq 'from') {
195            $blistStr .= " [not subscribed]";
196        }
197        else {
198            $blistStr .= " [offline]";
199        }
200    }
201    return $blistStr . "\n";
202}
203
204# Sort, ignoring markup.
205sub blistSort {
206    return uc(BarnOwl::ztext_stylestrip($a)) cmp uc(BarnOwl::ztext_stylestrip($b));
207}
208
209sub getSingleBuddyList {
210    my $jid = shift;
211    $jid = resolveConnectedJID($jid);
212    return "" unless $jid;
213    my $blist = "";
214    my $roster = $conn->getRosterFromJID($jid);
215    if ($roster) {
216        $blist .= BarnOwl::Style::boldify("Jabber roster for $jid\n");
217
218        my @gTexts = ();
219        foreach my $group ( $roster->groups() ) {
220            my @buddies = $roster->jids( 'group', $group );
221            my @bTexts = ();
222            foreach my $buddy ( @buddies ) {
223                push(@bTexts, blist_listBuddy( $roster, $buddy ));
224            }
225            push(@gTexts, "  Group: $group\n".join('',sort blistSort @bTexts));
226        }
227        # Sort groups before adding ungrouped entries.
228        @gTexts = sort blistSort @gTexts;
229
230        my @unsorted = $roster->jids('nogroup');
231        if (@unsorted) {
232            my @bTexts = ();
233            foreach my $buddy (@unsorted) {
234                push(@bTexts, blist_listBuddy( $roster, $buddy ));
235            }
236            push(@gTexts, "  [unsorted]\n".join('',sort blistSort @bTexts));
237        }
238        $blist .= join('', @gTexts);
239    }
240    return $blist;
241}
242
243sub onGetBuddyList {
244    $showOffline = BarnOwl::getvar('jabber:show_offline_buddies') eq 'on';
245    my $blist = "";
246    foreach my $jid ($conn->getJIDs()) {
247        $blist .= getSingleBuddyList($jid);
248    }
249    return $blist;
250}
251
252sub onGetQuickstart {
253    return <<'EOF'
254@b(Jabber:)
255Type ':jabberlogin @b(username@mit.edu)' to log in to Jabber. The command
256':jroster sub @b(somebody@gmail.com)' will request that they let you message
257them. Once you get a message saying you are subscribed, you can message
258them by typing ':jwrite @b(somebody@gmail.com)' or just 'j @b(somebody)'.
259EOF
260}
261
262################################################################################
263### Owl Commands
264sub register_owl_commands() {
265    BarnOwl::new_command(
266        jabberlogin => \&cmd_login,
267        {
268            summary => "Log in to Jabber",
269            usage   => "jabberlogin <jid> [<password>]"
270        }
271    );
272    BarnOwl::new_command(
273        jabberlogout => \&cmd_logout,
274        {
275            summary => "Log out of Jabber",
276            usage   => "jabberlogout [-A|<jid>]",
277            description => "jabberlogout logs you out of Jabber.\n\n"
278              . "If you are connected to one account, no further arguments are necessary.\n\n"
279              . "-A            Log out of all accounts.\n"
280              . "<jid>         Which account to log out of.\n"
281        }
282    );
283    BarnOwl::new_command(
284        jwrite => \&cmd_jwrite,
285        {
286            summary => "Send a Jabber Message",
287            usage   => "jwrite <jid> [-t <thread>] [-s <subject>]"
288        }
289    );
290    BarnOwl::new_command(
291        jaway => \&cmd_jaway,
292        {
293            summary => "Set Jabber away / presence information",
294            usage   => "jaway [-s online|dnd|...] [<message>]"
295        }
296    );
297    BarnOwl::new_command(
298        jlist => \&cmd_jlist,
299        {
300            summary => "Show your Jabber roster.",
301            usage   => "jlist"
302        }
303    );
304    BarnOwl::new_command(
305        jmuc => \&cmd_jmuc,
306        {
307            summary     => "Jabber MUC related commands.",
308            description => "jmuc sends Jabber commands related to MUC.\n\n"
309              . "The following commands are available\n\n"
310              . "join <muc>  Join a MUC.\n\n"
311              . "part <muc>  Part a MUC.\n"
312              . "            The MUC is taken from the current message if not supplied.\n\n"
313              . "invite <jid> [<muc>]\n"
314              . "            Invite <jid> to <muc>.\n"
315              . "            The MUC is taken from the current message if not supplied.\n\n"
316              . "configure [<muc>]\n"
317              . "            Configures a MUC.\n"
318              . "            Necessary to initalize a new MUC.\n"
319              . "            At present, only the default configuration is supported.\n"
320              . "            The MUC is taken from the current message if not supplied.\n\n"
321              . "presence [<muc>]\n"
322              . "            Shows the roster for <muc>.\n"
323              . "            The MUC is taken from the current message if not supplied.\n\n"
324              . "presence -a\n"
325              . "            Shows rosters for all MUCs you're participating in.\n\n",
326            usage => "jmuc <command> [<args>]"
327        }
328    );
329    BarnOwl::new_command(
330        jroster => \&cmd_jroster,
331        {
332            summary     => "Jabber roster related commands.",
333            description => "jroster sends Jabber commands related to rosters.\n\n"
334              . "The following commands are available\n\n"
335              . "sub <jid>     Subscribe to <jid>'s presence. (implicit add)\n\n"
336              . "add <jid>     Adds <jid> to your roster.\n\n"
337              . "unsub <jid>   Unsubscribe from <jid>'s presence.\n\n"
338              . "remove <jid>  Removes <jid> from your roster. (implicit unsub)\n\n"
339              . "auth <jid>    Authorizes <jid> to subscribe to your presence.\n\n"
340              . "deauth <jid>  De-authorizes <jid>'s subscription to your presence.\n\n"
341              . "The following arguments are supported for all commands\n\n"
342              . "-a <jid>      Specify which account to make the roster changes on.\n"
343              . "              Required if you're signed into more than one account.\n\n"
344              . "The following arguments only work with the add and sub commands.\n\n"
345              . "-g <group>    Add <jid> to group <group>.\n"
346              . "              May be specified more than once, will not remove <jid> from any groups.\n\n"
347              . "-p            Purge. Removes <jid> from all groups.\n"
348              . "              May be combined with -g.\n\n"
349              . "-n <name>     Sets <name> as <jid>'s short name.\n\n"
350              . "Note: Unless -n is used, you can specify multiple <jid> arguments.\n",
351            usage       => "jroster <command> <args>"
352        }
353    );
354}
355
356sub register_keybindings {
357    BarnOwl::bindkey(qw(recv j command start-command), 'jwrite ');
358}
359
360sub register_filters {
361    BarnOwl::filter(qw(jabber type ^jabber$));
362}
363
364sub cmd_login {
365    my $cmd = shift;
366    my $jidStr = shift;
367    my $jid = new Net::Jabber::JID;
368    $jid->SetJID($jidStr);
369    my $password = '';
370    $password = shift if @_;
371
372    my $uid           = $jid->GetUserID();
373    my $componentname = $jid->GetServer();
374    my $resource      = $jid->GetResource();
375
376    if ($resource eq '') {
377        my $cjidStr = $conn->baseJIDExists($jidStr);
378        if ($cjidStr) {
379            BarnOwl::error("Already logged in as $cjidStr.");
380            return;
381        }
382    }
383
384    $resource ||= 'barnowl';
385    $jid->SetResource($resource);
386    $jidStr = $jid->GetJID('full');
387
388    if ( !$uid || !$componentname ) {
389        BarnOwl::error("usage: $cmd JID");
390        return;
391    }
392
393    if ( $conn->jidActive($jidStr) ) {
394        BarnOwl::error("Already logged in as $jidStr.");
395        return;
396    } elsif ($conn->jidExists($jidStr)) {
397        return $conn->tryReconnect($jidStr, 1);
398    }
399
400    my ( $server, $port ) = getServerFromJID($jid);
401
402    $vars{jlogin_jid} = $jidStr;
403    $vars{jlogin_connhash} = {
404        hostname      => $server,
405        tls           => 1,
406        port          => $port,
407        componentname => $componentname
408    };
409    $vars{jlogin_authhash} =
410      { username => $uid,
411        resource => $resource,
412    };
413
414    return do_login($password);
415}
416
417sub do_login {
418    $vars{jlogin_password} = shift;
419    $vars{jlogin_authhash}->{password} = sub { return $vars{jlogin_password} || '' };
420    my $jidStr = $vars{jlogin_jid};
421    if ( !$jidStr && $vars{jlogin_havepass}) {
422        BarnOwl::error("Got password but have no JID!");
423    }
424    else
425    {
426        my $client = $conn->addConnection($jidStr);
427
428        #XXX Todo: Add more callbacks.
429        # * MUC presence handlers
430        # We use the anonymous subrefs in order to have the correct behavior
431        # when we reload
432        $client->SetMessageCallBacks(
433            chat      => sub { BarnOwl::Module::Jabber::process_incoming_chat_message(@_) },
434            error     => sub { BarnOwl::Module::Jabber::process_incoming_error_message(@_) },
435            groupchat => sub { BarnOwl::Module::Jabber::process_incoming_groupchat_message(@_) },
436            headline  => sub { BarnOwl::Module::Jabber::process_incoming_headline_message(@_) },
437            normal    => sub { BarnOwl::Module::Jabber::process_incoming_normal_message(@_) }
438        );
439        $client->SetPresenceCallBacks(
440            available    => sub { BarnOwl::Module::Jabber::process_presence_available(@_) },
441            unavailable  => sub { BarnOwl::Module::Jabber::process_presence_available(@_) },
442            subscribe    => sub { BarnOwl::Module::Jabber::process_presence_subscribe(@_) },
443            subscribed   => sub { BarnOwl::Module::Jabber::process_presence_subscribed(@_) },
444            unsubscribe  => sub { BarnOwl::Module::Jabber::process_presence_unsubscribe(@_) },
445            unsubscribed => sub { BarnOwl::Module::Jabber::process_presence_unsubscribed(@_) },
446            error        => sub { BarnOwl::Module::Jabber::process_presence_error(@_) });
447
448        my $status = $client->Connect( %{ $vars{jlogin_connhash} } );
449        if ( !$status ) {
450            $conn->removeConnection($jidStr);
451            BarnOwl::error("We failed to connect.");
452        } else {
453            my @result = $client->AuthSend( %{ $vars{jlogin_authhash} } );
454
455            if ( !@result || $result[0] ne 'ok' ) {
456                if ( !$vars{jlogin_havepass} && ( !@result || $result[0] eq '401' || $result[0] eq 'error') ) {
457                    $vars{jlogin_havepass} = 1;
458                    $conn->removeConnection($jidStr);
459                    BarnOwl::start_password("Password for $jidStr: ", \&do_login );
460                    return "";
461                }
462                $conn->removeConnection($jidStr);
463                BarnOwl::error( "Error in connect: " . join( " ", @result ) );
464            } else {
465                $conn->setAuth(
466                    $jidStr,
467                    {   %{ $vars{jlogin_authhash} },
468                        password => $vars{jlogin_password}
469                    }
470                );
471                $client->onConnect($conn, $jidStr);
472            }
473        }
474    }
475    delete $vars{jlogin_jid};
476    $vars{jlogin_password} =~ tr/\0-\377/x/ if $vars{jlogin_password};
477    delete $vars{jlogin_password};
478    delete $vars{jlogin_havepass};
479    delete $vars{jlogin_connhash};
480    delete $vars{jlogin_authhash};
481
482    return "";
483}
484
485sub do_logout {
486    my $jid = shift;
487    my $disconnected = $conn->removeConnection($jid);
488    queue_admin_msg("Jabber disconnected ($jid).") if $disconnected;
489}
490
491sub cmd_logout {
492    return "You are not logged into Jabber." unless ($conn->connected() > 0);
493    # Logged into multiple accounts
494    if ( $conn->connected() > 1 ) {
495        # Logged into multiple accounts, no accout specified.
496        if ( !$_[1] ) {
497            my $errStr =
498              "You are logged into multiple accounts. Please specify an account to log out of.\n";
499            foreach my $jid ( $conn->getJIDs() ) {
500                $errStr .= "\t$jid\n";
501            }
502            queue_admin_msg($errStr);
503        }
504        # Logged into multiple accounts, account specified.
505        else {
506            if ( $_[1] eq '-A' )    #All accounts.
507            {
508                foreach my $jid ( $conn->getJIDs() ) {
509                    do_logout($jid);
510                }
511            }
512            else                    #One account.
513            {
514                my $jid = resolveConnectedJID( $_[1] );
515                do_logout($jid) if ( $jid ne '' );
516            }
517        }
518    }
519    else                            # Only one account logged in.
520    {
521        do_logout( ( $conn->getJIDs() )[0] );
522    }
523    return "";
524}
525
526sub cmd_jlist {
527    if ( !( scalar $conn->getJIDs() ) ) {
528        BarnOwl::error("You are not logged in to Jabber.");
529        return;
530    }
531    BarnOwl::popless_ztext( onGetBuddyList() );
532}
533
534sub cmd_jwrite {
535    if ( !$conn->connected() ) {
536        BarnOwl::error("You are not logged in to Jabber.");
537        return;
538    }
539
540    my $jwrite_to      = "";
541    my $jwrite_from    = "";
542    my $jwrite_sid     = "";
543    my $jwrite_thread  = "";
544    my $jwrite_subject = "";
545    my ($to, $from);
546    my $jwrite_type    = "chat";
547
548    my @args = @_;
549    shift;
550    local @ARGV = @_;
551    my $gc;
552    GetOptions(
553        'thread=s'  => \$jwrite_thread,
554        'subject=s' => \$jwrite_subject,
555        'account=s' => \$from,
556        'id=s'     =>  \$jwrite_sid,
557    ) or die("Usage: jwrite <jid> [-t <thread>] [-s <subject>] [-a <account>]\n");
558    $jwrite_type = 'groupchat' if $gc;
559
560    if ( scalar @ARGV != 1 ) {
561        BarnOwl::error(
562            "Usage: jwrite <jid> [-t <thread>] [-s <subject>] [-a <account>]");
563        return;
564    }
565    else {
566      $to = shift @ARGV;
567    }
568
569    my @candidates = guess_jwrite($from, $to);
570
571    unless(scalar @candidates) {
572        die("Unable to resolve JID $to");
573    }
574
575    @candidates = grep {defined $_->[0]} @candidates;
576
577    unless(scalar @candidates) {
578        if(!$from) {
579            die("You must specify an account with -a");
580        } else {
581            die("Unable to resolve account $from");
582        }
583    }
584
585
586    ($jwrite_from, $jwrite_to, $jwrite_type) = @{$candidates[0]};
587
588    $vars{jwrite} = {
589        to      => $jwrite_to,
590        from    => $jwrite_from,
591        sid     => $jwrite_sid,
592        subject => $jwrite_subject,
593        thread  => $jwrite_thread,
594        type    => $jwrite_type
595    };
596
597    if(scalar @candidates > 1) {
598        BarnOwl::message(
599            "Warning: Guessing account and/or destination JID"
600           );
601    } else  {
602        BarnOwl::message(
603            "Type your message below.  End with a dot on a line by itself.  ^C will quit."
604           );
605    }
606
607    my @cmd = ('jwrite', $jwrite_to, '-a', $jwrite_from);
608    push @cmd, '-t', $jwrite_thread if $jwrite_thread;
609    push @cmd, '-s', $jwrite_subject if $jwrite_subject;
610
611    BarnOwl::start_edit_win(BarnOwl::quote(@cmd), \&process_owl_jwrite);
612}
613
614sub cmd_jmuc {
615    die "You are not logged in to Jabber" unless $conn->connected();
616    my $ocmd = shift;
617    my $cmd  = shift;
618    if ( !$cmd ) {
619
620        #XXX TODO: Write general usage for jmuc command.
621        return;
622    }
623
624    my %jmuc_commands = (
625        join      => \&jmuc_join,
626        part      => \&jmuc_part,
627        invite    => \&jmuc_invite,
628        configure => \&jmuc_configure,
629        presence  => \&jmuc_presence
630    );
631    my $func = $jmuc_commands{$cmd};
632    if ( !$func ) {
633        BarnOwl::error("jmuc: Unknown command: $cmd");
634        return;
635    }
636
637    {
638        local @ARGV = @_;
639        my $jid;
640        my $muc;
641        my $m = BarnOwl::getcurmsg();
642        if ( $m && $m->is_jabber && $m->{jtype} eq 'groupchat' ) {
643            $muc = $m->{room};
644            $jid = $m->{to};
645        }
646
647        my $getopt = Getopt::Long::Parser->new;
648        $getopt->configure('pass_through', 'no_getopt_compat');
649        $getopt->getoptions( 'account=s' => \$jid );
650        $jid ||= defaultJID();
651        if ($jid) {
652            $jid = resolveConnectedJID($jid);
653            return unless $jid;
654        }
655        else {
656            BarnOwl::error('You must specify an account with -a <jid>');
657        }
658        return $func->( $jid, $muc, @ARGV );
659    }
660}
661
662sub jmuc_join {
663    my ( $jid, $muc, @args ) = @_;
664    local @ARGV = @args;
665    my $password;
666    GetOptions( 'password=s' => \$password );
667
668    $muc = shift @ARGV
669      or die("Usage: jmuc join <muc> [-p <password>] [-a <account>]");
670
671    die("Error: Must specify a fully-qualified MUC name (e.g. barnowl\@conference.mit.edu)\n")
672        unless $muc =~ /@/;
673    $muc = Net::Jabber::JID->new($muc);
674    $jid = Net::Jabber::JID->new($jid);
675    $muc->SetResource($jid->GetJID('full')) unless length $muc->GetResource();
676
677    $conn->getConnectionFromJID($jid)->MUCJoin(JID      => $muc,
678                                               Password => $password,
679                                               History  => {
680                                                   MaxChars => 0
681                                                  });
682    $completion_jids{$muc} = 1;
683    return;
684}
685
686sub jmuc_part {
687    my ( $jid, $muc, @args ) = @_;
688
689    $muc = shift @args if scalar @args;
690    die("Usage: jmuc part [<muc>] [-a <account>]") unless $muc;
691
692    if($conn->getConnectionFromJID($jid)->MUCLeave(JID => $muc)) {
693        queue_admin_msg("$jid has left $muc.");
694    } else {
695        die("Error: Not joined to $muc");
696    }
697}
698
699sub jmuc_invite {
700    my ( $jid, $muc, @args ) = @_;
701
702    my $invite_jid = shift @args;
703    $muc = shift @args if scalar @args;
704
705    die('Usage: jmuc invite <jid> [<muc>] [-a <account>]')
706      unless $muc && $invite_jid;
707
708    my $message = Net::Jabber::Message->new();
709    $message->SetTo($muc);
710    my $x = $message->NewChild('http://jabber.org/protocol/muc#user');
711    $x->AddInvite();
712    $x->GetInvite()->SetTo($invite_jid);
713    $conn->getConnectionFromJID($jid)->Send($message);
714    queue_admin_msg("$jid has invited $invite_jid to $muc.");
715}
716
717sub jmuc_configure {
718    my ( $jid, $muc, @args ) = @_;
719    $muc = shift @args if scalar @args;
720    die("Usage: jmuc configure [<muc>]") unless $muc;
721    my $iq = Net::Jabber::IQ->new();
722    $iq->SetTo($muc);
723    $iq->SetType('set');
724    my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner");
725    my $x     = $query->NewChild("jabber:x:data");
726    $x->SetType('submit');
727
728    $conn->getConnectionFromJID($jid)->Send($iq);
729    queue_admin_msg("Accepted default instant configuration for $muc");
730}
731
732sub jmuc_presence_single {
733    my $m = shift;
734    my @jids = $m->Presence();
735
736    my $presence = "JIDs present in " . $m->BaseJID;
737    $completion_jids{$m->BaseJID} = 1;
738    if($m->Anonymous) {
739        $presence .= " [anonymous MUC]";
740    }
741    $presence .= "\n\t";
742    $presence .= join("\n\t", map {pp_jid($m, $_);} @jids) . "\n";
743    return $presence;
744}
745
746sub pp_jid {
747    my ($m, $jid) = @_;
748    my $nick = $jid->GetResource;
749    my $full = $m->GetFullJID($jid);
750    if($full && $full ne $nick) {
751        return "$nick ($full)";
752    } else {
753        return "$nick";
754    }
755}
756
757sub jmuc_presence {
758    my ( $jid, $muc, @args ) = @_;
759
760    $muc = shift @args if scalar @args;
761    die("Usage: jmuc presence [<muc>]") unless $muc;
762
763    if ($muc eq '-a') {
764        my $str = "";
765        foreach my $jid ($conn->getJIDs()) {
766            $str .= BarnOwl::Style::boldify("Conferences for $jid:\n");
767            my $connection = $conn->getConnectionFromJID($jid);
768            foreach my $muc ($connection->MUCs) {
769                $str .= jmuc_presence_single($muc)."\n";
770            }
771        }
772        BarnOwl::popless_ztext($str);
773    }
774    else {
775        my $m = $conn->getConnectionFromJID($jid)->FindMUC(jid => $muc);
776        die("No such muc: $muc") unless $m;
777        BarnOwl::popless_ztext(jmuc_presence_single($m));
778    }
779}
780
781
782#XXX TODO: Consider merging this with jmuc and selecting off the first two args.
783sub cmd_jroster {
784    die "You are not logged in to Jabber" unless $conn->connected();
785    my $ocmd = shift;
786    my $cmd  = shift;
787    if ( !$cmd ) {
788
789        #XXX TODO: Write general usage for jroster command.
790        return;
791    }
792
793    my %jroster_commands = (
794        sub      => \&jroster_sub,
795        unsub    => \&jroster_unsub,
796        add      => \&jroster_add,
797        remove   => \&jroster_remove,
798        auth     => \&jroster_auth,
799        deauth   => \&jroster_deauth
800    );
801    my $func = $jroster_commands{$cmd};
802    if ( !$func ) {
803        BarnOwl::error("jroster: Unknown command: $cmd");
804        return;
805    }
806
807    {
808        local @ARGV = @_;
809        my $jid;
810        my $name;
811        my @groups;
812        my $purgeGroups;
813        my $getopt = Getopt::Long::Parser->new;
814        $getopt->configure('pass_through', 'no_getopt_compat');
815        $getopt->getoptions(
816            'account=s' => \$jid,
817            'group=s' => \@groups,
818            'purgegroups' => \$purgeGroups,
819            'name=s' => \$name
820        );
821        $jid ||= defaultJID();
822        if ($jid) {
823            $jid = resolveConnectedJID($jid);
824            return unless $jid;
825        }
826        else {
827            BarnOwl::error('You must specify an account with -a <jid>');
828        }
829        return $func->( $jid, $name, \@groups, $purgeGroups,  @ARGV );
830    }
831}
832
833sub cmd_jaway {
834    my $cmd = shift;
835    local @ARGV = @_;
836    my $getopt = Getopt::Long::Parser->new;
837    my ($jid, $show);
838    my $p = new Net::Jabber::Presence;
839
840    $getopt->configure('pass_through', 'no_getopt_compat');
841    $getopt->getoptions(
842        'account=s' => \$jid,
843        'show=s'    => \$show
844    );
845    $jid ||= defaultJID();
846    if ($jid) {
847        $jid = resolveConnectedJID($jid);
848        return unless $jid;
849    }
850    else {
851        BarnOwl::error('You must specify an account with -a <jid>');
852    }
853
854    $p->SetShow($show eq "online" ? "" : $show) if $show;
855    $p->SetStatus(join(' ', @ARGV)) if @ARGV;
856    $conn->getConnectionFromJID($jid)->Send($p);
857}
858
859
860sub jroster_sub {
861    my $jid = shift;
862    my $name = shift;
863    my @groups = @{ shift() };
864    my $purgeGroups = shift;
865    my $baseJID = baseJID($jid);
866
867    my $roster = $conn->getRosterFromJID($jid);
868
869    # Adding lots of users with the same name is a bad idea.
870    $name = "" unless (1 == scalar(@ARGV));
871
872    my $p = new Net::Jabber::Presence;
873    $p->SetType('subscribe');
874
875    foreach my $to (@ARGV) {
876        jroster_add($jid, $name, \@groups, $purgeGroups, ($to)) unless ($roster->exists($to));
877
878        $p->SetTo($to);
879        $conn->getConnectionFromJID($jid)->Send($p);
880        queue_admin_msg("You ($baseJID) have requested a subscription to ($to)'s presence.");
881    }
882}
883
884sub jroster_unsub {
885    my $jid = shift;
886    my $name = shift;
887    my @groups = @{ shift() };
888    my $purgeGroups = shift;
889    my $baseJID = baseJID($jid);
890
891    my $p = new Net::Jabber::Presence;
892    $p->SetType('unsubscribe');
893    foreach my $to (@ARGV) {
894        $p->SetTo($to);
895        $conn->getConnectionFromJID($jid)->Send($p);
896        queue_admin_msg("You ($baseJID) have unsubscribed from ($to)'s presence.");
897    }
898}
899
900sub jroster_add {
901    my $jid = shift;
902    my $name = shift;
903    my @groups = @{ shift() };
904    my $purgeGroups = shift;
905    my $baseJID = baseJID($jid);
906
907    my $roster = $conn->getRosterFromJID($jid);
908
909    # Adding lots of users with the same name is a bad idea.
910    $name = "" unless (1 == scalar(@ARGV));
911
912    $completion_jids{$baseJID} = 1;
913    $completion_jids{$name} = 1 if $name;
914
915    foreach my $to (@ARGV) {
916        my %jq  = $roster->query($to);
917        my $iq = new Net::Jabber::IQ;
918        $iq->SetType('set');
919        my $item = new XML::Stream::Node('item');
920        $iq->NewChild('jabber:iq:roster')->AddChild($item);
921
922        my %allGroups = ();
923
924        foreach my $g (@groups) {
925            $allGroups{$g} = $g;
926        }
927
928        unless ($purgeGroups) {
929            foreach my $g (@{$jq{groups}}) {
930                $allGroups{$g} = $g;
931            }
932        }
933
934        foreach my $g (keys %allGroups) {
935            $item->add_child('group')->add_cdata($g);
936        }
937
938        $item->put_attrib(jid => $to);
939        $item->put_attrib(name => $name) if $name;
940        $conn->getConnectionFromJID($jid)->Send($iq);
941        my $msg = "$baseJID: "
942          . ($name ? "$name ($to)" : "($to)")
943          . " is on your roster in the following groups: { "
944          . join(" , ", keys %allGroups)
945          . " }";
946        queue_admin_msg($msg);
947    }
948}
949
950sub jroster_remove {
951    my $jid = shift;
952    my $name = shift;
953    my @groups = @{ shift() };
954    my $purgeGroups = shift;
955    my $baseJID = baseJID($jid);
956
957    my $iq = new Net::Jabber::IQ;
958    $iq->SetType('set');
959    my $item = new XML::Stream::Node('item');
960    $iq->NewChild('jabber:iq:roster')->AddChild($item);
961    $item->put_attrib(subscription=> 'remove');
962    foreach my $to (@ARGV) {
963        $item->put_attrib(jid => $to);
964        $conn->getConnectionFromJID($jid)->Send($iq);
965        queue_admin_msg("You ($baseJID) have removed ($to) from your roster.");
966    }
967}
968
969sub jroster_auth {
970    my $jid = shift;
971    my $name = shift;
972    my @groups = @{ shift() };
973    my $purgeGroups = shift;
974    my $baseJID = baseJID($jid);
975
976    my $p = new Net::Jabber::Presence;
977    $p->SetType('subscribed');
978    foreach my $to (@ARGV) {
979        $p->SetTo($to);
980        $conn->getConnectionFromJID($jid)->Send($p);
981        queue_admin_msg("($to) has been subscribed to your ($baseJID) presence.");
982    }
983}
984
985sub jroster_deauth {
986    my $jid = shift;
987    my $name = shift;
988    my @groups = @{ shift() };
989    my $purgeGroups = shift;
990    my $baseJID = baseJID($jid);
991
992    my $p = new Net::Jabber::Presence;
993    $p->SetType('unsubscribed');
994    foreach my $to (@ARGV) {
995        $p->SetTo($to);
996        $conn->getConnectionFromJID($jid)->Send($p);
997        queue_admin_msg("($to) has been unsubscribed from your ($baseJID) presence.");
998    }
999}
1000
1001################################################################################
1002### Owl Callbacks
1003sub process_owl_jwrite {
1004    my $body = shift;
1005
1006    my $j = new Net::Jabber::Message;
1007    $body =~ s/\n\z//;
1008    $j->SetMessage(
1009        to   => $vars{jwrite}{to},
1010        from => $vars{jwrite}{from},
1011        type => $vars{jwrite}{type},
1012        body => $body
1013    );
1014
1015    $j->SetThread( $vars{jwrite}{thread} )   if ( $vars{jwrite}{thread} );
1016    $j->SetSubject( $vars{jwrite}{subject} ) if ( $vars{jwrite}{subject} );
1017
1018    my $m = j2o( $j, { direction => 'out' } );
1019    if ( $vars{jwrite}{type} ne 'groupchat') {
1020        BarnOwl::queue_message($m);
1021    }
1022
1023    $j->RemoveFrom(); # Kludge to get around gtalk's random bits after the resource.
1024    if ($vars{jwrite}{sid} && $conn->sidExists( $vars{jwrite}{sid} )) {
1025        $conn->getConnectionFromSid($vars{jwrite}{sid})->Send($j);
1026    }
1027    else {
1028        $conn->getConnectionFromJID($vars{jwrite}{from})->Send($j);
1029    }
1030
1031    delete $vars{jwrite};
1032    BarnOwl::message("");   # Kludge to make the ``type your message...'' message go away
1033}
1034
1035### XMPP Callbacks
1036
1037sub process_incoming_chat_message {
1038    my ( $sid, $j ) = @_;
1039    if ($j->DefinedBody() || BarnOwl::getvar('jabber:spew') eq 'on') {
1040        BarnOwl::queue_message( j2o( $j, { direction => 'in',
1041                                           sid => $sid } ) );
1042    }
1043}
1044
1045sub process_incoming_error_message {
1046    my ( $sid, $j ) = @_;
1047    my %jhash = j2hash( $j, { direction => 'in',
1048                              sid => $sid } );
1049    $jhash{type} = 'admin';
1050   
1051    BarnOwl::queue_message( BarnOwl::Message->new(%jhash) );
1052}
1053
1054sub process_incoming_groupchat_message {
1055    my ( $sid, $j ) = @_;
1056
1057    # HACK IN PROGRESS (ignoring delayed messages)
1058    return if ( $j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay') );
1059    BarnOwl::queue_message( j2o( $j, { direction => 'in',
1060                                   sid => $sid } ) );
1061}
1062
1063sub process_incoming_headline_message {
1064    my ( $sid, $j ) = @_;
1065    BarnOwl::queue_message( j2o( $j, { direction => 'in',
1066                                   sid => $sid } ) );
1067}
1068
1069sub process_incoming_normal_message {
1070    my ( $sid, $j ) = @_;
1071    my %jhash = j2hash( $j, { direction => 'in',
1072                              sid => $sid } );
1073
1074    # XXX TODO: handle things such as MUC invites here.
1075
1076    #    if ($j->HasX('http://jabber.org/protocol/muc#user'))
1077    #    {
1078    #   my $x = $j->GetX('http://jabber.org/protocol/muc#user');
1079    #   if ($x->HasChild('invite'))
1080    #   {
1081    #       $props
1082    #   }
1083    #    }
1084    #
1085    if ($j->DefinedBody() || BarnOwl::getvar('jabber:spew') eq 'on') {
1086        BarnOwl::queue_message( BarnOwl::Message->new(%jhash) );
1087    }
1088}
1089
1090sub process_muc_presence {
1091    my ( $sid, $p ) = @_;
1092    return unless ( $p->HasX('http://jabber.org/protocol/muc#user') );
1093}
1094
1095
1096sub process_presence_available {
1097    my ( $sid, $p ) = @_;
1098    my $from = $p->GetFrom('jid')->GetJID('base');
1099    $completion_jids{$from} = 1;
1100    return unless (BarnOwl::getvar('jabber:show_logins') eq 'on');
1101    my $to = $p->GetTo();
1102    my $type = $p->GetType();
1103    my %props = (
1104        to => $to,
1105        from => $p->GetFrom(),
1106        recipient => $to,
1107        sender => $from,
1108        type => 'jabber',
1109        jtype => $p->GetType(),
1110        status => $p->GetStatus(),
1111        show => $p->GetShow(),
1112        xml => $p->GetXML(),
1113        direction => 'in');
1114
1115    if ($type eq '' || $type eq 'available') {
1116        $props{body} = "$from is now online. ";
1117        $props{loginout} = 'login';
1118    }
1119    else {
1120        $props{body} = "$from is now offline. ";
1121        $props{loginout} = 'logout';
1122    }
1123    BarnOwl::queue_message(BarnOwl::Message->new(%props));
1124}
1125
1126sub process_presence_subscribe {
1127    my ( $sid, $p ) = @_;
1128    my $from = $p->GetFrom();
1129    my $to = $p->GetTo();
1130    my %props = (
1131        to => $to,
1132        from => $from,
1133        xml => $p->GetXML(),
1134        type => 'admin',
1135        adminheader => 'Jabber presence: subscribe',
1136        direction => 'in');
1137
1138    $props{body} = "Allow user ($from) to subscribe to your ($to) presence?\n" .
1139                   "(Answer with the `yes' or `no' commands)";
1140    $props{yescommand} = BarnOwl::quote('jroster', 'auth', $from, '-a', $to);
1141    $props{nocommand} = BarnOwl::quote('jroster', 'deauth', $from, '-a', $to);
1142    $props{question} = "true";
1143    BarnOwl::queue_message(BarnOwl::Message->new(%props));
1144}
1145
1146sub process_presence_unsubscribe {
1147    my ( $sid, $p ) = @_;
1148    my $from = $p->GetFrom();
1149    my $to = $p->GetTo();
1150    my %props = (
1151        to => $to,
1152        from => $from,
1153        xml => $p->GetXML(),
1154        type => 'admin',
1155        adminheader => 'Jabber presence: unsubscribe',
1156        direction => 'in');
1157
1158    $props{body} = "The user ($from) has been unsubscribed from your ($to) presence.\n";
1159    BarnOwl::queue_message(BarnOwl::Message->new(%props));
1160
1161    # Find a connection to reply with.
1162    foreach my $jid ($conn->getJIDs()) {
1163        my $cJID = new Net::Jabber::JID;
1164        $cJID->SetJID($jid);
1165        if ($to eq $cJID->GetJID('base') ||
1166            $to eq $cJID->GetJID('full')) {
1167            my $reply = $p->Reply(type=>"unsubscribed");
1168            $conn->getConnectionFromJID($jid)->Send($reply);
1169            return;
1170        }
1171    }
1172}
1173
1174sub process_presence_subscribed {
1175    my ( $sid, $p ) = @_;
1176    queue_admin_msg("ignoring:".$p->GetXML()) if BarnOwl::getvar('jabber:spew') eq 'on';
1177    # RFC 3921 says we should respond to this with a "subscribe"
1178    # but this causes a flood of sub/sub'd presence packets with
1179    # some servers, so we won't. We may want to detect this condition
1180    # later, and have per-server settings.
1181    return;
1182}
1183
1184sub process_presence_unsubscribed {
1185    my ( $sid, $p ) = @_;
1186    queue_admin_msg("ignoring:".$p->GetXML()) if BarnOwl::getvar('jabber:spew') eq 'on';
1187    # RFC 3921 says we should respond to this with a "subscribe"
1188    # but this causes a flood of unsub/unsub'd presence packets with
1189    # some servers, so we won't. We may want to detect this condition
1190    # later, and have per-server settings.
1191    return;
1192}
1193
1194sub process_presence_error {
1195    my ( $sid, $p ) = @_;
1196    my $code = $p->GetErrorCode();
1197    my $error = $p->GetError();
1198    BarnOwl::error("Jabber: $code $error");
1199}
1200
1201
1202### Helper functions
1203
1204sub j2hash {
1205    my $j   = shift;
1206    my %props = (type => 'jabber',
1207                 dir  => 'none',
1208                 %{$_[0]});
1209
1210    my $dir = $props{direction};
1211
1212    my $jtype = $props{jtype} = $j->GetType();
1213    my $from = $j->GetFrom('jid');
1214    my $to   = $j->GetTo('jid');
1215
1216    $props{from} = $from->GetJID('full');
1217    $props{to}   = $to->GetJID('full');
1218
1219    $props{recipient}  = $to->GetJID('base');
1220    $props{sender}     = $from->GetJID('base');
1221    $props{subject}    = $j->GetSubject() if ( $j->DefinedSubject() );
1222    $props{thread}     = $j->GetThread() if ( $j->DefinedThread() );
1223    if ( $j->DefinedBody() ) {
1224        $props{body}   = $j->GetBody();
1225        $props{body}  =~ s/\xEF\xBB\xBF//g; # Strip stray Byte-Order-Marks.
1226    }
1227    $props{error}      = $j->GetError() if ( $j->DefinedError() );
1228    $props{error_code} = $j->GetErrorCode() if ( $j->DefinedErrorCode() );
1229    $props{xml}        = $j->GetXML();
1230
1231    if ( $jtype eq 'chat' ) {
1232        $props{private} = 1;
1233
1234        my $connection;
1235        if ($dir eq 'in') {
1236            $connection = $conn->getConnectionFromSid($props{sid});
1237        }
1238        else {
1239            $connection = $conn->getConnectionFromJID($props{from});
1240        }
1241
1242        # Check to see if we're doing personals with someone in a muc.
1243        # If we are, show the full jid because the base jid is the room.
1244        if ($connection) {
1245            $props{sender} = $props{from}
1246              if ($connection->FindMUC(jid => $from));
1247            $props{recipient} = $props{to}
1248              if ($connection->FindMUC(jid => $to));
1249        }
1250
1251        # Populate completion.
1252        if ($dir eq 'in') {
1253            $completion_jids{ $props{sender} }= 1;
1254        }
1255        else {
1256            $completion_jids{ $props{recipient} } = 1;
1257        }
1258    }
1259    elsif ( $jtype eq 'groupchat' ) {
1260        my $nick = $props{nick} = $from->GetResource();
1261        my $room = $props{room} = $from->GetJID('base');
1262        $completion_jids{$room} = 1;
1263
1264        $props{sender} = $nick || $room;
1265        $props{recipient} = $room;
1266
1267        if ( $props{subject} && !$props{body} ) {
1268            $props{body} =
1269              '[' . $nick . " has set the topic to: " . $props{subject} . "]";
1270        }
1271    }
1272    elsif ( $jtype eq 'headline' ) {
1273    }
1274    elsif ( $jtype eq 'error' ) {
1275        $props{body}     = "Error "
1276          . $props{error_code}
1277          . " sending to "
1278          . $props{from} . "\n"
1279          . $props{error};
1280    }
1281    else { # normal (default)
1282        $props{private} = 1;
1283    }
1284
1285    return %props;
1286}
1287
1288sub j2o {
1289    return BarnOwl::Message->new( j2hash(@_) );
1290}
1291
1292sub queue_admin_msg {
1293    my $err = shift;
1294    BarnOwl::admin_message("Jabber", $err);
1295}
1296
1297sub getServerFromJID {
1298    my $jid = shift;
1299    my $res = new Net::DNS::Resolver;
1300    my $packet =
1301      $res->search( '_xmpp-client._tcp.' . $jid->GetServer(), 'srv' );
1302
1303    if ($packet)    # Got srv record.
1304    {
1305        my @answer = $packet->answer;
1306        return $answer[0]{target}, $answer[0]{port};
1307    }
1308
1309    return $jid->GetServer(), 5222;
1310}
1311
1312sub defaultJID {
1313    return ( $conn->getJIDs() )[0] if ( $conn->connected() == 1 );
1314    return;
1315}
1316
1317sub baseJID {
1318    my $givenJIDStr = shift;
1319    my $givenJID    = new Net::Jabber::JID;
1320    $givenJID->SetJID($givenJIDStr);
1321    return $givenJID->GetJID('base');
1322}
1323
1324sub resolveConnectedJID {
1325    my $givenJIDStr = shift;
1326    my $loose = shift || 0;
1327    my $givenJID    = new Net::Jabber::JID;
1328    $givenJID->SetJID($givenJIDStr);
1329
1330    # Account fully specified.
1331    if ( $givenJID->GetResource() ) {
1332        # Specified account exists
1333        return $givenJIDStr if ($conn->jidExists($givenJIDStr) );
1334        return resolveConnectedJID($givenJID->GetJID('base')) if $loose;
1335        die("Invalid account: $givenJIDStr");
1336    }
1337
1338    # Disambiguate.
1339    else {
1340        my $JIDMatchingJID = "";
1341        my $strMatchingJID = "";
1342        my $JIDMatches = "";
1343        my $strMatches = "";
1344        my $JIDAmbiguous = 0;
1345        my $strAmbiguous = 0;
1346
1347        foreach my $jid ( $conn->getJIDs() ) {
1348            my $cJID = new Net::Jabber::JID;
1349            $cJID->SetJID($jid);
1350            if ( $givenJIDStr eq $cJID->GetJID('base') ) {
1351                $JIDAmbiguous = 1 if ( $JIDMatchingJID ne "" );
1352                $JIDMatchingJID = $jid;
1353                $JIDMatches .= "\t$jid\n";
1354            }
1355            if ( $cJID->GetJID('base') =~ /$givenJIDStr/ ) {
1356                $strAmbiguous = 1 if ( $strMatchingJID ne "" );
1357                $strMatchingJID = $jid;
1358                $strMatches .= "\t$jid\n";
1359            }
1360        }
1361
1362        # Need further disambiguation.
1363        if ($JIDAmbiguous) {
1364            my $errStr =
1365                "Ambiguous account reference. Please specify a resource.\n";
1366            die($errStr.$JIDMatches);
1367        }
1368
1369        # It's this one.
1370        elsif ($JIDMatchingJID ne "") {
1371            return $JIDMatchingJID;
1372        }
1373
1374        # Further resolution by substring.
1375        elsif ($strAmbiguous) {
1376            my $errStr =
1377                "Ambiguous account reference. Please be more specific.\n";
1378            die($errStr.$strMatches);
1379        }
1380
1381        # It's this one, by substring.
1382        elsif ($strMatchingJID ne "") {
1383            return $strMatchingJID;
1384        }
1385
1386        # Not one of ours.
1387        else {
1388            die("Invalid account: $givenJIDStr");
1389        }
1390
1391    }
1392    return "";
1393}
1394
1395sub resolveDestJID {
1396    my ($to, $from) = @_;
1397    my $jid = Net::Jabber::JID->new($to);
1398
1399    my $roster = $conn->getRosterFromJID($from);
1400    my @jids = $roster->jids('all');
1401    for my $j (@jids) {
1402        if(($roster->query($j, 'name') || $j->GetUserID()) eq $to) {
1403            return $j->GetJID('full');
1404        } elsif($j->GetJID('base') eq baseJID($to)) {
1405            return $jid->GetJID('full');
1406        }
1407    }
1408
1409    # If we found nothing being clever, check to see if our input was
1410    # sane enough to look like a jid with a UserID.
1411    return $jid->GetJID('full') if $jid->GetUserID();
1412    return undef;
1413}
1414
1415sub resolveType {
1416    my $to = shift;
1417    my $from = shift;
1418    return unless $from;
1419    my @mucs = $conn->getConnectionFromJID($from)->MUCs;
1420    if(grep {$_->BaseJID eq $to } @mucs) {
1421        return 'groupchat';
1422    } else {
1423        return 'chat';
1424    }
1425}
1426
1427sub guess_jwrite {
1428    # Heuristically guess what jids a jwrite was meant to be going to/from
1429    my ($from, $to) = (@_);
1430    my ($from_jid, $to_jid);
1431    my @matches;
1432    if($from) {
1433        $from_jid = resolveConnectedJID($from, 1);
1434        die("Unable to resolve account $from") unless $from_jid;
1435        $to_jid = resolveDestJID($to, $from_jid);
1436        push @matches, [$from_jid, $to_jid] if $to_jid;
1437    } else {
1438        for my $f ($conn->getJIDs) {
1439            $to_jid = resolveDestJID($to, $f);
1440            if(defined($to_jid)) {
1441                push @matches, [$f, $to_jid];
1442            }
1443        }
1444        if($to =~ /@/) {
1445            push @matches, [$_, $to]
1446               for ($conn->getJIDs);
1447        }
1448    }
1449
1450    for my $m (@matches) {
1451        my $type = resolveType($m->[1], $m->[0]);
1452        push @$m, $type;
1453    }
1454
1455    return @matches;
1456}
1457
1458################################################################################
1459### Completion
1460
1461sub complete_user_or_muc { return keys %completion_jids; }
1462sub complete_account { return $conn->getJIDs(); }
1463
1464sub complete_jwrite {
1465    my $ctx = shift;
1466    return complete_flags($ctx,
1467                          [qw(-t -i -s)],
1468                          {
1469                              "-a" => \&complete_account,
1470                          },
1471                          \&complete_user_or_muc
1472        );
1473}
1474
1475BarnOwl::Completion::register_completer(jwrite => sub { BarnOwl::Module::Jabber::complete_jwrite(@_) });
1476
14771;
Note: See TracBrowser for help on using the repository browser.