source: perl/modules/jabber.pl @ 1d8503b

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