source: perl/modules/jabber.pl @ ea215ac

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since ea215ac was 84296f6, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 17 years ago
jabber.pl: * Refactoring of Buddy List code. * Refactoring of login code
  • Property mode set to 100644
File size: 20.7 KB
Line 
1# -*- mode: cperl; cperl-indent-level: 4; indent-tabs-mode: nil -*-
2package owl_jabber;
3use warnings;
4use strict;
5
6use Authen::SASL qw(Perl);
7use Net::Jabber;
8use Net::DNS;
9use Getopt::Long;
10
11no warnings 'redefine';
12
13################################################################################
14# owl perl jabber support
15#
16# XXX Todo:
17# Rosters for MUCs
18# More user feedback
19#  * joining MUC
20#  * parting MUC
21#  * presence (Roster and MUC)
22# Implementing formatting and logging callbacks for C
23# Appropriate callbacks for presence subscription messages.
24#  * Current behavior is auto-accept (default for Net::Jabber)
25#
26################################################################################
27
28our $connections;
29our %vars;
30
31sub onStart {
32    if ( eval { \&owl::queue_message } ) {
33        register_owl_commands();
34        push @::onMainLoop,     sub { owl_jabber::onMainLoop(@_) };
35        push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) };
36    }
37    else {
38        # Our owl doesn't support queue_message. Unfortunately, this
39        # means it probably *also* doesn't support owl::error. So just
40        # give up silently.
41    }
42}
43
44push @::onStartSubs, sub { owl_jabber::onStart(@_) };
45
46sub onMainLoop {
47    return if ( !connected() );
48
49    foreach my $jid ( keys %$connections ) {
50        my $client = \$connections->{$jid}->{client};
51
52        my $status = $$client->Process(0);
53        if ( !defined($status) ) {
54            owl::error("Jabber account $jid disconnected!");
55            do_logout($jid);
56        }
57        if ($::shutdown) {
58            do_logout($jid);
59            return;
60        }
61    }
62}
63
64sub blist_listBuddy {
65    my $roster = shift;
66    my $buddy  = shift;
67    my $blistStr .= "    ";
68    my %jq  = $$roster->query($buddy);
69    my $res = $$roster->resource($buddy);
70
71    $blistStr .= $jq{name} ? $jq{name} : $buddy->GetJID();
72
73    if ($res) {
74        my %rq = $$roster->resourceQuery( $buddy, $res );
75        $blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]";
76        $blistStr .= " " . $rq{status} if $rq{status};
77        $blistStr = boldify($blistStr);
78    }
79    else {
80        if ($jq{ask}) {
81            $blistStr .= " [pending]";
82        }
83        elsif ($jq{subscription} eq 'none' || $jq{subscription} eq 'from') {
84            $blistStr .= " [not subscribed]";
85        }
86        else {
87            $blistStr .= " [offline]";
88        }
89    }
90    return $blistStr . "\n";
91}
92
93sub getSingleBuddyList {
94    my $jid = shift;
95    $jid = resolveJID($jid);
96    return "" unless $jid;
97    my $blist = "";
98    my $roster = \$connections->{$jid}->{roster};
99    if ($$roster) {
100        $blist .= "\n" . boldify("Jabber Roster for $jid\n");
101
102        foreach my $group ( $$roster->groups() ) {
103            $blist .= "  Group: $group\n";
104            foreach my $buddy ( $$roster->jids( 'group', $group ) ) {
105                $blist .= blist_listBuddy( $roster, $buddy );
106            }
107        }
108
109        my @unsorted = $$roster->jids('nogroup');
110        if (@unsorted) {
111            $blist .= "  [unsorted]\n";
112            foreach my $buddy (@unsorted) {
113                $blist .= blist_listBuddy( $roster, $buddy );
114            }
115        }
116    }
117    return $blist;
118}
119
120sub onGetBuddyList {
121    my $blist = "";
122    foreach my $jid (keys %{$connections}) {
123        $blist .= getSingleBuddyList($jid);
124    }
125    return $blist;
126}
127
128################################################################################
129### Owl Commands
130sub register_owl_commands() {
131    owl::new_command(
132        jabberlogin => \&cmd_login,
133        { summary => "Log into jabber", }
134    );
135    owl::new_command(
136        jabberlogout => \&cmd_logout,
137        { summary => "Log out of jabber" }
138    );
139    owl::new_command(
140        jwrite => \&cmd_jwrite,
141        {
142            summary => "Send a Jabber Message",
143            usage   => "jwrite JID [-g] [-t thread] [-s subject]"
144        }
145    );
146    owl::new_command(
147        jlist => \&cmd_jlist,
148        {
149            summary => "Show your Jabber roster.",
150            usage   => "jlist"
151        }
152    );
153    owl::new_command(
154        jmuc => \&cmd_jmuc,
155        {
156            summary     => "Jabber MUC related commands.",
157            description => "jmuc sends jabber commands related to muc.\n\n"
158              . "The following commands are available\n\n"
159              . "join {muc}  Join a muc.\n\n"
160              . "part [muc]  Part a muc.\n"
161              . "            The muc is taken from the current message if not supplied.\n\n"
162              . "invite {jid} [muc]\n"
163              . "            Invite {jid} to [muc].\n"
164              . "            The muc is taken from the current message if not supplied.\n\n"
165              . "configure [muc]\n"
166              . "            Configure [muc].\n"
167              . "            Necessary to initalize a new MUC",
168            usage => "jmuc {command} {args}"
169        }
170    );
171}
172
173sub cmd_login {
174    my $cmd = shift;
175    my $jid = new Net::XMPP::JID;
176    $jid->SetJID(shift);
177
178    my $uid           = $jid->GetUserID();
179    my $componentname = $jid->GetServer();
180    my $resource      = $jid->GetResource() || 'owl';
181    $jid->SetResource($resource);
182    my $jidStr = $jid->GetJID('full');
183
184    if ( !$uid || !$componentname ) {
185        owl::error("usage: $cmd {jid}");
186        return;
187    }
188
189    if ( $connections->{$jidStr} ) {
190        owl::error("Already logged in as $jidStr.");
191        return;
192    }
193
194    my ( $server, $port ) = getServerFromJID($jid);
195
196    $vars{jlogin_jid} = $jidStr;
197    $vars{jlogin_havepass} = 0;
198    $vars{jlogin_connhash} = {
199        hostname      => $server,
200        tls           => 1,
201        port          => $port,
202        componentname => $componentname
203    };
204    $vars{jlogin_authhash} =
205      { username => $uid,
206        resource => $resource,
207    };
208
209    return do_login('');
210}
211
212sub do_login {
213    $vars{jlogin_password} = shift;
214    $vars{jlogin_authhash}->{password} = sub { return $vars{jlogin_password} || '' };
215    my $jidStr = $vars{jlogin_jid};
216    if ( !$jidStr && $vars{jlogin_havepass}) {
217        owl::error("Got password but have no jid!");
218    }
219    else
220    {
221        $connections->{$jidStr}->{client} = Net::Jabber::Client->new(
222            debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0,
223            debugfile => 'jabber.log'
224        );
225        my $client = \$connections->{$jidStr}->{client};
226        $connections->{$jidStr}->{roster} =
227          $connections->{$jidStr}->{client}->Roster();
228
229        #XXX Todo: Add more callbacks.
230        # * MUC presence handlers
231        $$client->SetMessageCallBacks(
232            chat      => sub { owl_jabber::process_incoming_chat_message(@_) },
233            error     => sub { owl_jabber::process_incoming_error_message(@_) },
234            groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) },
235            headline  => sub { owl_jabber::process_incoming_headline_message(@_) },
236            normal    => sub { owl_jabber::process_incoming_normal_message(@_) }
237        );
238        $$client->SetPresenceCallBacks(
239            subscribe   => sub { owl_jabber::process_presence_subscribe(@_) },
240            unsubscribe => sub { owl_jabber::process_presence_unsubscribe(@_) });
241
242        my $status = $$client->Connect( %{ $vars{jlogin_connhash} } );
243        if ( !$status ) {
244            delete $connections->{$jidStr};
245            owl::error("We failed to connect");
246        }
247        else {
248            my @result = $$client->AuthSend( %{ $vars{jlogin_authhash} } );
249
250            if ( $result[0] ne 'ok' ) {
251            if ( !$vars{jlogin_havepass} && $result[0] == 401 ) {
252                $vars{jlogin_havepass} = 1;
253                delete $connections->{$jidStr};
254                owl::start_password( "Password for $jidStr: ", \&do_login );
255                return "";
256            }
257            delete $connections->{$jidStr};
258            owl::error(
259                "Error in connect: " . join( " ", @result ) );
260        }
261            else {
262                $connections->{$jidStr}->{roster}->fetch();
263                $$client->PresenceSend( priority => 1 );
264                queue_admin_msg("Connected to jabber as $jidStr");
265            }
266        }
267    }
268    delete $vars{jlogin_jid};
269    $vars{jlogin_password} =~ tr/\0-\377/x/;
270    delete $vars{jlogin_password};
271    delete $vars{jlogin_havepass};
272    delete $vars{jlogin_connhash};
273    delete $vars{jlogin_authhash};
274    return "";
275}
276
277sub do_logout {
278    my $jid = shift;
279    $connections->{$jid}->{client}->Disconnect();
280    delete $connections->{$jid};
281    queue_admin_msg("Jabber disconnected ($jid).");
282}
283
284sub cmd_logout {
285    # Logged into multiple accounts
286    if ( connected() > 1 ) {
287        # Logged into multiple accounts, no accout specified.
288        if ( !$_[1] ) {
289            my $errStr =
290              "You are logged into multiple accounts. Please specify an account to log out of.\n";
291            foreach my $jid ( keys %$connections ) {
292                $errStr .= "\t$jid\n";
293            }
294            queue_admin_msg($errStr);
295        }
296        # Logged into multiple accounts, account specified.
297        else {
298            if ( $_[1] eq '-a' )    #All accounts.
299            {
300                foreach my $jid ( keys %$connections ) {
301                    do_logout($jid);
302                }
303            }
304            else                    #One account.
305            {
306                my $jid = resolveJID( $_[1] );
307                do_logout($jid) if ( $jid ne '' );
308            }
309        }
310    }
311    else                            # Only one account logged in.
312    {
313        do_logout( ( keys %$connections )[0] );
314    }
315    return "";
316}
317
318sub cmd_jlist {
319    if ( !( scalar keys %$connections ) ) {
320        owl::error("You are not logged in to Jabber.");
321        return;
322    }
323    owl::popless_ztext( onGetBuddyList() );
324}
325
326sub cmd_jwrite {
327    if ( !connected() ) {
328        owl::error("You are not logged in to Jabber.");
329        return;
330    }
331
332    my $jwrite_to      = "";
333    my $jwrite_from    = "";
334    my $jwrite_thread  = "";
335    my $jwrite_subject = "";
336    my $jwrite_type    = "chat";
337
338    my @args = @_;
339    shift;
340    local @ARGV = @_;
341    my $gc;
342    GetOptions(
343        'thread=s'  => \$jwrite_thread,
344        'subject=s' => \$jwrite_subject,
345        'account=s' => \$jwrite_from,
346        'groupchat' => \$gc
347    );
348    $jwrite_type = 'groupchat' if $gc;
349
350    if ( scalar @ARGV != 1 ) {
351        owl::error(
352            "Usage: jwrite JID [-g] [-t thread] [-s 'subject'] [-a account]");
353        return;
354    }
355    else {
356        $jwrite_to = shift @ARGV;
357    }
358
359    if ( !$jwrite_from ) {
360        if ( connected() == 1 ) {
361            $jwrite_from = ( keys %$connections )[0];
362        }
363        else {
364            owl::error("Please specify an account with -a {jid}");
365            return;
366        }
367    }
368    else {
369        $jwrite_from = resolveJID($jwrite_from);
370        return unless $jwrite_from;
371    }
372
373    $vars{jwrite} = {
374        to      => $jwrite_to,
375        from    => $jwrite_from,
376        subject => $jwrite_subject,
377        thread  => $jwrite_thread,
378        type    => $jwrite_type
379    };
380
381    owl::message(
382        "Type your message below.  End with a dot on a line by itself.  ^C will quit."
383       );
384    owl::start_edit_win( join( ' ', @args ), \&process_owl_jwrite );
385}
386
387sub cmd_jmuc {
388    die "You are not logged in to Jabber" unless connected();
389    my $ocmd = shift;
390    my $cmd  = shift;
391    if ( !$cmd ) {
392
393        #XXX TODO: Write general usage for jmuc command.
394        return;
395    }
396
397    my %jmuc_commands = (
398        join      => \&jmuc_join,
399        part      => \&jmuc_part,
400        invite    => \&jmuc_invite,
401        configure => \&jmuc_configure
402    );
403    my $func = $jmuc_commands{$cmd};
404    if ( !$func ) {
405        owl::error("jmuc: Unknown command: $cmd");
406        return;
407    }
408
409    {
410        local @ARGV = @_;
411        my $jid;
412        my $muc;
413        my $m = owl::getcurmsg();
414        if ( $m->is_jabber && $m->{jtype} eq 'groupchat' ) {
415            $muc = $m->{room};
416            $jid = $m->{to};
417        }
418
419        my $getopt = Getopt::Long::Parser->new;
420        $getopt->configure('pass_through');
421        $getopt->getoptions( 'account=s' => \$jid );
422        $jid ||= defaultJID();
423        if ($jid) {
424            $jid = resolveJID($jid);
425            return unless $jid;
426        }
427        else {
428            owl::error('You must specify an account with -a {jid}');
429        }
430        return $func->( $jid, $muc, @ARGV );
431    }
432}
433
434sub jmuc_join {
435    my ( $jid, $muc, @args ) = @_;
436    local @ARGV = @args;
437    my $password;
438    GetOptions( 'password=s' => \$password );
439
440    $muc = shift @ARGV
441      or die("Usage: jmuc join {muc} [-p password] [-a account]");
442
443    my $presence = new Net::Jabber::Presence;
444    $presence->SetPresence( to => $muc );
445    my $x = $presence->NewChild('http://jabber.org/protocol/muc');
446    $x->AddHistory()->SetMaxChars(0);
447    if ($password) {
448        $x->SetPassword($password);
449    }
450
451    $connections->{$jid}->{client}->Send($presence);
452}
453
454sub jmuc_part {
455    my ( $jid, $muc, @args ) = @_;
456
457    $muc = shift @args if scalar @args;
458    die("Usage: jmuc part {muc} [-a account]") unless $muc;
459
460    $connections->{$jid}->{client}
461      ->PresenceSend( to => $muc, type => 'unavailable' );
462    queue_admin_msg("$jid has left $muc.");
463}
464
465sub jmuc_invite {
466    my ( $jid, $muc, @args ) = @_;
467
468    my $invite_jid = shift @args;
469    $muc = shift @args if scalar @args;
470
471    die('Usage: jmuc invite {jid} [muc] [-a account]')
472      unless $muc && $invite_jid;
473
474    my $message = Net::Jabber::Message->new();
475    $message->SetTo($muc);
476    my $x = $message->NewChild('http://jabber.org/protocol/muc#user');
477    $x->AddInvite();
478    $x->GetInvite()->SetTo($invite_jid);
479    $connections->{$jid}->{client}->Send($message);
480    queue_admin_msg("$jid has invited $invite_jid to $muc.");
481}
482
483sub jmuc_configure {
484    my ( $jid, $muc, @args ) = @_;
485    $muc = shift @args if scalar @args;
486    die("Usage: jmuc configure [muc]") unless $muc;
487    my $iq = Net::Jabber::IQ->new();
488    $iq->SetTo($muc);
489    $iq->SetType('set');
490    my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner");
491    my $x     = $query->NewChild("jabber:x:data");
492    $x->SetType('submit');
493
494    $connections->{$jid}->{client}->Send($iq);
495    queue_admin_msg("Accepted default instant configuration for $muc");
496}
497
498################################################################################
499### Owl Callbacks
500sub process_owl_jwrite {
501    my $body = shift;
502
503    my $j = new Net::XMPP::Message;
504    $body =~ s/\n\z//;
505    $j->SetMessage(
506        to   => $vars{jwrite}{to},
507        from => $vars{jwrite}{from},
508        type => $vars{jwrite}{type},
509        body => $body
510    );
511    $j->SetThread( $vars{jwrite}{thread} )   if ( $vars{jwrite}{thread} );
512    $j->SetSubject( $vars{jwrite}{subject} ) if ( $vars{jwrite}{subject} );
513
514    my $m = j2o( $j, 'out' );
515    if ( $vars{jwrite}{type} ne 'groupchat' ) {
516
517        #XXX TODO: Check for displayoutgoing.
518        owl::queue_message($m);
519    }
520    $connections->{ $vars{jwrite}{from} }->{client}->Send($j);
521    delete $vars{jwrite};
522    owl::message("");   # Kludge to make the ``type your message...'' message go away
523}
524
525### XMPP Callbacks
526
527sub process_incoming_chat_message {
528    my ( $session, $j ) = @_;
529    owl::queue_message( j2o( $j, 'in' ) );
530}
531
532sub process_incoming_error_message {
533    my ( $session, $j ) = @_;
534    my %jhash = j2hash( $j, 'in' );
535    $jhash{type} = 'admin';
536    owl::queue_message( owl::Message->new(%jhash) );
537}
538
539sub process_incoming_groupchat_message {
540    my ( $session, $j ) = @_;
541
542    # HACK IN PROGRESS (ignoring delayed messages)
543    return if ( $j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay') );
544    owl::queue_message( j2o( $j, 'in' ) );
545}
546
547sub process_incoming_headline_message {
548    my ( $session, $j ) = @_;
549    owl::queue_message( j2o( $j, 'in' ) );
550}
551
552sub process_incoming_normal_message {
553    my ( $session, $j ) = @_;
554    my %props = j2hash( $j, 'in' );
555
556    # XXX TODO: handle things such as MUC invites here.
557
558    #    if ($j->HasX('http://jabber.org/protocol/muc#user'))
559    #    {
560    #   my $x = $j->GetX('http://jabber.org/protocol/muc#user');
561    #   if ($x->HasChild('invite'))
562    #   {
563    #       $props
564    #   }
565    #    }
566    #
567    owl::queue_message( owl::Message->new(%props) );
568}
569
570sub process_muc_presence {
571    my ( $session, $p ) = @_;
572    return unless ( $p->HasX('http://jabber.org/protocol/muc#user') );
573
574}
575
576### Helper functions
577
578sub j2hash {
579    my $j   = shift;
580    my $dir = shift;
581
582    my %props = (
583        type      => 'jabber',
584        direction => $dir
585    );
586
587    my $jtype = $props{jtype} = $j->GetType();
588    my $from = $j->GetFrom('jid');
589    my $to   = $j->GetTo('jid');
590
591    $props{from} = $from->GetJID('full');
592    $props{to}   = $to->GetJID('full');
593
594    my $account = ( $dir eq 'out' ) ? $props{from} : $props{to};
595
596    $props{recipient}  = $to->GetJID('base');
597    $props{sender}     = $from->GetJID('base');
598    $props{subject}    = $j->GetSubject() if ( $j->DefinedSubject() );
599    $props{thread}     = $j->GetThread() if ( $j->DefinedThread() );
600    $props{body}       = $j->GetBody() if ( $j->DefinedBody() );
601    $props{error}      = $j->GetError() if ( $j->DefinedError() );
602    $props{error_code} = $j->GetErrorCode() if ( $j->DefinedErrorCode() );
603    $props{xml}        = $j->GetXML();
604
605    if ( $jtype eq 'chat' ) {
606        $props{replycmd} =
607          "jwrite " . ( ( $dir eq 'in' ) ? $props{from} : $props{to} ) . " -a $account";
608        $props{isprivate} = 1;
609        $props{replysendercmd} = $props{replycmd};
610    }
611    elsif ( $jtype eq 'groupchat' ) {
612        my $nick = $props{nick} = $from->GetResource();
613        my $room = $props{room} = $from->GetJID('base');
614        $props{replycmd} = "jwrite -g $room -a $account";
615
616        $props{replysendercmd} = "jwrite " . $from->GetJID('full') . " -a $account";
617
618        $props{sender} = $nick || $room;
619        $props{recipient} = $room;
620
621        if ( $props{subject} && !$props{body} ) {
622            $props{body} =
623              '[' . $nick . " has set the topic to: " . $props{subject} . "]";
624        }
625    }
626    elsif ( $jtype eq 'normal' ) {
627        $props{replycmd}  = undef;
628        $props{isprivate} = 1;
629    }
630    elsif ( $jtype eq 'headline' ) {
631        $props{replycmd} = undef;
632    }
633    elsif ( $jtype eq 'error' ) {
634        $props{replycmd} = undef;
635        $props{body}     = "Error "
636          . $props{error_code}
637          . " sending to "
638          . $props{from} . "\n"
639          . $props{error};
640    }
641
642    return %props;
643}
644
645sub j2o {
646    return owl::Message->new( j2hash(@_) );
647}
648
649sub queue_admin_msg {
650    my $err = shift;
651    my $m   = owl::Message->new(
652        type      => 'admin',
653        direction => 'none',
654        body      => $err
655    );
656    owl::queue_message($m);
657}
658
659sub boldify($) {
660    my $str = shift;
661
662    return '@b(' . $str . ')' if ( $str !~ /\)/ );
663    return '@b<' . $str . '>' if ( $str !~ /\>/ );
664    return '@b{' . $str . '}' if ( $str !~ /\}/ );
665    return '@b[' . $str . ']' if ( $str !~ /\]/ );
666
667    my $txt = "\@b($str";
668    $txt =~ s/\)/\)\@b\[\)\]\@b\(/g;
669    return $txt . ')';
670}
671
672sub getServerFromJID {
673    my $jid = shift;
674    my $res = new Net::DNS::Resolver;
675    my $packet =
676      $res->search( '_xmpp-client._tcp.' . $jid->GetServer(), 'srv' );
677
678    if ($packet)    # Got srv record.
679    {
680        my @answer = $packet->answer;
681        return $answer[0]{target}, $answer[0]{port};
682    }
683
684    return $jid->GetServer(), 5222;
685}
686
687sub connected {
688    return scalar keys %$connections;
689}
690
691sub defaultJID {
692    return ( keys %$connections )[0] if ( connected() == 1 );
693    return;
694}
695
696sub baseJID {
697    my $givenJidStr = shift;
698    my $givenJid    = new Net::XMPP::JID;
699    $givenJid->SetJID($givenJidStr);
700    return $givenJid->GetJID('base');
701}
702
703sub resolveJID {
704    my $givenJidStr = shift;
705    my $givenJid    = new Net::XMPP::JID;
706    $givenJid->SetJID($givenJidStr);
707
708    # Account fully specified.
709    if ( $givenJid->GetResource() ) {
710
711        # Specified account exists
712        if ( defined $connections->{$givenJidStr} ) {
713            return $givenJidStr;
714        }
715        else    #Specified account doesn't exist
716        {
717            owl::error("Invalid account: $givenJidStr");
718        }
719    }
720
721    # Disambiguate.
722    else {
723        my $matchingJid = "";
724        my $errStr =
725          "Ambiguous account reference. Please specify a resource.\n";
726        my $ambiguous = 0;
727
728        foreach my $jid ( keys %$connections ) {
729            my $cJid = new Net::XMPP::JID;
730            $cJid->SetJID($jid);
731            if ( $givenJidStr eq $cJid->GetJID('base') ) {
732                $ambiguous = 1 if ( $matchingJid ne "" );
733                $matchingJid = $jid;
734                $errStr .= "\t$jid\n";
735            }
736        }
737
738        # Need further disambiguation.
739        if ($ambiguous) {
740            queue_admin_msg($errStr);
741        }
742
743        # Not one of ours.
744        elsif ( $matchingJid eq "" ) {
745            owl::error("Invalid account: $givenJidStr");
746        }
747
748        # It's this one.
749        else {
750            return $matchingJid;
751        }
752    }
753    return "";
754}
755
7561;
Note: See TracBrowser for help on using the repository browser.