source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm @ 06f5ef8

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