source: perl/modules/jabber.pl @ b6a253c

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since b6a253c was b6a253c, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 20 years ago
jabber.pl: * Roster added to buddy list. * Command jlist added to get roster. perlglue.xs: * Exposed owl_fuction_popless_text() as owl::popless_text() * Exposed owl_fuction_popless_ztext() as owl::popless_ztext()
  • Property mode set to 100644
File size: 12.3 KB
Line 
1package owl_jabber;
2use Authen::SASL qw(Perl);
3use Net::Jabber;
4################################################################################
5# owl perl jabber support
6#
7# XXX Todo:
8# Rosters for MUCs
9# More user feedback
10#  * joining MUC
11#  * parting MUC
12#  * presence (Roster and MUC)
13# Implementing formatting and logging callbacks for C
14# Appropriate callbacks for presence subscription messages.
15#  * Current behavior => auto-accept (default for Net::Jabber)
16#
17################################################################################
18
19our $client;
20our $jid;
21our $roster;
22
23sub onStart
24{
25    if(eval{\&owl::queue_message}) 
26    {
27        register_owl_commands();
28        push @::onMainLoop, sub { owl_jabber::onMainLoop(@_) };
29        push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) };
30    }
31    else
32    {
33        # Our owl doesn't support queue_message. Unfortunately, this
34        # means it probably *also* doesn't support owl::error. So just
35        # give up silently.
36    }
37}
38push @::onStartSubs, sub { owl_jabber::onStart(@_) };
39
40sub onMainLoop
41{
42    return if ($client == undef);
43   
44    my $status = $client->Process(0);
45    if ($status == 0     # No data received
46        || $status == 1) # Data received
47    {
48    }
49    else #Error
50    {
51        queue_admin_msg("Jabber disconnected.");
52        $roster = undef;
53        $client = undef;
54        return;
55    }
56   
57    if ($::shutdown)
58    {
59        $roster = undef;
60        $client->Disconnect();
61        $client = undef;
62        return;
63    }
64}
65
66sub blist_listBuddy
67{
68    my $buddy = shift;
69    my $blistStr .= "    ";
70    my %jq = $roster->query($buddy);
71    my $res = $roster->resource($buddy);
72
73    $blistStr .= $jq{name} ? $jq{name} : $buddy->GetJID();
74   
75    if ($res)
76    {
77        my %rq = $roster->resourceQuery($buddy, $res);
78        $blistStr .= " [".($rq{show} ? $rq{show} : 'online')."]";
79        $blistStr .= " ".$rq{status} if $rq{status};
80        $blistStr = boldify($blistStr);
81    }
82    else
83    {
84        $blistStr .= $jq{ask} ? " [pending]" : " [offline]";
85    }
86
87    return $blistStr."\n";
88}
89
90sub onGetBuddyList
91{
92    return "" if ($client == undef);
93    my $blist = "\n".boldify("Jabber Roster for ".$jid->GetJID('base'))."\n";
94
95    foreach my $group ($roster->groups())
96    {
97        $blist .= "  Group: $group\n";
98        foreach my $buddy ($roster->jids('group',$group))
99        {
100            $blist .= blist_listBuddy($buddy);
101        }
102    }
103   
104    my @unsorted = $roster->jids('nogroup');
105    if (@unsorted)
106    {
107        $blist .= "  [unsorted]\n";
108        foreach my $buddy (@unsorted)
109        {
110            $blist .= blist_listBuddy($buddy);
111        }
112    }
113
114    $blist .= "\n";
115}
116
117################################################################################
118### Owl Commands
119sub register_owl_commands()
120{
121    owl::new_command(
122        jabberlogin => \&cmd_login,
123        { summary => "Log into jabber", }
124    );
125    owl::new_command(
126        jabberlogout => \&cmd_logout,
127        { summary => "Log out of jabber" }
128    );
129    owl::new_command(
130        jwrite => \&cmd_jwrite,
131        {
132            summary     => "Send a Jabber Message",
133            usage       => "jwrite JID [-g] [-t thread] [-s subject]"
134        }
135    );
136    owl::new_command(
137        jlist => \&cmd_jlist,
138        {
139            summary     => "Show your Jabber roster.",
140            usage       => "jlist"
141        }
142    );
143    owl::new_command(
144        jmuc => \&cmd_jmuc,
145        {
146            summary     => "Jabber MUC related commands.",
147            description => "jmuc sends jabber commands related to muc.\n\n".
148                "The following commands are available\n\n".
149                "join {muc}  Join a muc.\n\n".
150                "part [muc]  Part a muc.".
151                "            The muc is taken from the current message if not supplied.\n\n".
152                "invite {jid} [muc]\n\n".
153                "            Invite {jid} to [muc].\n".
154                "            The muc is taken from the current message if not supplied.\n\n",
155            usage       => "jmuc {command} {args}"
156        }
157    );
158}
159
160sub cmd_login
161{
162    if ($client != undef)
163    {
164        queue_admin_msg("Already logged in.");
165        return;
166    }
167
168    %muc_roster = ();
169    $client = Net::Jabber::Client->new();
170    $roster = $client->Roster();
171
172    #XXX Todo: Add more callbacks.
173    # MUC presence handlers
174    $client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) },
175                                 error => sub { owl_jabber::process_incoming_error_message(@_) },
176                                 groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) },
177                                 headline => sub { owl_jabber::process_incoming_headline_message(@_) },
178                                 normal => sub { owl_jabber::process_incoming_normal_message(@_) });
179
180    #XXX Todo: Parameterize the arguments to Connect()
181    my $status = $client->Connect(hostname => 'jabber.mit.edu',
182                                  tls => 1,
183                                  port => 5222,
184                                  componentname => 'mit.edu');
185   
186    if (!$status)
187    {
188        owl::error("We failed to connect");
189        $client = undef;
190        return;
191    }
192
193
194    my @result = $client->AuthSend(username => $ENV{USER}, resource => 'owl', password => '');
195    if($result[0] ne 'ok') {
196        owl::error("Error in connect: " . join(" ", $result[1..$#result]));
197        $roster = undef;
198        $client->Disconnect();
199        $client = undef;
200        return;
201    }
202
203    $jid = new Net::Jabber::JID;
204    $jid->SetJID(userid => $ENV{USER},
205                 server => ($client->{SERVER}->{componentname} ||
206                            $client->{SERVER}->{hostname}),
207                 resource => 'owl');
208   
209    $roster->fetch();
210    $client->PresenceSend(priority => 1);
211    queue_admin_msg("Connected to jabber as ".$jid->GetJID('full'));
212
213    return "";
214}
215
216sub cmd_logout
217{
218    if ($client)
219    {
220        $roster = undef;
221        $client->Disconnect();
222        $client = undef;
223        queue_admin_msg("Jabber disconnected.");
224    }
225    return "";
226}
227
228sub cmd_jlist
229{
230    if (!$client)
231    {
232        owl::error("You are not logged in to Jabber.");
233        return;
234    }
235    owl::popless_ztext(onGetBuddyList());
236}
237
238our $jwrite_to;
239our $jwrite_thread;
240our $jwrite_subject;
241our $jwrite_type;
242sub cmd_jwrite
243{
244    if (!$client)
245    {
246        owl::error("You are not logged in to Jabber.");
247        return;
248    }
249
250    $jwrite_to = "";
251    $jwrite_thread = "";
252    $jwrite_subject = "";
253    $jwrite_type = "chat";
254    my @args = @_;
255    my $argsLen = @args;
256
257  JW_ARG: for (my $i = 1; $i < $argsLen; $i++)
258    {
259        $args[$i] =~ /^-t$/ && ($jwrite_thread = $args[++$i]  and next JW_ARG);
260        $args[$i] =~ /^-s$/ && ($jwrite_subject = $args[++$i] and next JW_ARG);
261        $args[$i] =~ /^-g$/ && ($jwrite_type = "groupchat" and next JW_ARG);
262
263        if ($jwrite_to ne '')
264        {
265            # Too many To's
266            $jwrite_to = '';
267            last;
268        }
269        if ($jwrite_to)
270        {
271            $jwrite_to == '';
272            last;
273        }
274        $jwrite_to = $args[$i];
275    }
276
277    if(!$jwrite_to)
278    {
279        owl::error("Usage: jwrite JID [-t thread] [-s 'subject']");
280        return;
281    }
282
283
284    owl::message("Type your message below.  End with a dot on a line by itself.  ^C will quit.");
285    owl::start_edit_win(join(' ', @args), \&process_owl_jwrite);
286}
287
288sub cmd_jmuc
289{
290    if (!$client)
291    {
292        owl::error("You are not logged in to Jabber.");
293        return;
294    }
295   
296    if (!$_[1])
297    {
298        #XXX TODO: Write general usage for jmuc command.
299        return;
300    }
301
302    my $cmd = $_[1];
303
304    if ($cmd eq 'join')
305    {
306        if (!$_[2])
307        {
308            owl::error('Usage: jmuc join {muc} [password]');
309            return;
310        }
311        my $muc = $_[2];
312        my $x = new XML::Stream::Node('x');
313        $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc');
314        $x->add_child('history')->put_attrib(maxchars => '0');
315       
316        if ($_[3]) #password
317        {
318            $x->add_child('password')->add_cdata($_[3]);
319        }
320
321        my $presence = new Net::Jabber::Presence;
322        $presence->SetPresence(to => $muc);
323        $presence->AddX($x);
324        $client->Send($presence);
325    }
326    elsif ($cmd eq 'part')
327    {
328        my $muc;
329        if (!$_[2])
330        {
331            my $m = owl::getcurmsg();
332            if ($m->is_jabber && $m->{jtype} eq 'groupchat')
333            {
334                $muc = $m->{muc};
335            }
336            else
337            {
338                owl::error('Usage: "jmuc part [muc]"');
339                return;
340            }
341        }
342        else
343        {
344            $muc = $_[2];
345        }
346        $client->PresenceSend(to => $muc, type => 'unavailable');
347    }
348    elsif ($cmd eq 'invite')
349    {
350        my $jid;
351        my $muc;
352
353        owl::error('Usage: jmuc invite {jid} [muc]') if (!$_[2]);
354       
355        if (!@_[3])
356        {       
357            my $m = owl::getcurmsg();
358            if ($m->is_jabber && $m->{jtype} eq 'groupchat')
359            {
360                $muc = $m->{muc};
361            }
362            else
363            {
364                owl::error('Usage: jmuc invite {jid} [muc]');
365                return;
366            }
367        }
368        else
369        {
370            $muc = $_[3];
371        }
372       
373        my $x = new XML::Stream::Node('x');
374        $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc#user');
375        $x->add_child('invite')->put_attrib(to => $_[2]);
376       
377        my $message = new Net::Jabber::Message;
378        $message->SetTo($muc);
379        $message->AddX($x);
380       
381        $client->Send($message);
382    }
383    else
384    {
385        owl::error('jmuc: unrecognized command.');
386    }
387    return "";
388}
389
390################################################################################
391### Owl Callbacks
392sub process_owl_jwrite
393{
394    my $body = shift;
395
396    my $j = new Net::XMPP::Message;
397    $body =~ s/\n\z//;
398    $j->SetMessage(to => $jwrite_to,
399                   from => $jid->GetJID('full'),
400                   type => $jwrite_type,
401                   body => $body
402                   );
403    $j->SetThread($jwrite_thread) if ($jwrite_thread);
404    $j->SetSubject($jwrite_subject) if ($jwrite_subject);
405
406    my $m = j2o($j, 'out');
407    if ($jwrite_type ne 'groupchat')
408    {
409        #XXX TODO: Check for displayoutgoing.
410        owl::queue_message($m);
411    }
412    $client->Send($j);
413}
414
415### XMPP Callbacks
416
417sub process_incoming_chat_message
418{
419    my ($session, $j) = @_;
420    owl::queue_message(j2o($j, 'in'));
421}
422
423sub process_incoming_error_message
424{
425    my ($session, $j) = @_;
426    my %jhash = j2hash($j, 'in');
427    $jhash{type} = 'admin';
428    owl::queue_message(owl::Message->new(%jhash));
429}
430
431sub process_incoming_groupchat_message
432{
433    my ($session, $j) = @_;
434    # HACK IN PROGRESS (ignoring delayed messages)
435    return if ($j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay'));
436    owl::queue_message(j2o($j, 'in'));
437}
438
439sub process_incoming_headline_message
440{
441    my ($session, $j) = @_;
442    owl::queue_message(j2o($j, 'in'));
443}
444
445sub process_incoming_normal_message
446{
447    my ($session, $j) = @_;
448    my %props = j2hash($j, 'in');
449
450    # XXX TODO: handle things such as MUC invites here.
451
452#    if ($j->HasX('http://jabber.org/protocol/muc#user'))
453#    {
454#       my $x = $j->GetX('http://jabber.org/protocol/muc#user');
455#       if ($x->HasChild('invite'))
456#       {
457#           $props         
458#       }
459#    }
460#   
461    owl::queue_message(owl::Message->new(%props));
462}
463
464sub process_muc_presence
465{
466    my ($session, $p) = @_;
467    return unless ($p->HasX('http://jabber.org/protocol/muc#user'));
468   
469}
470
471
472### Helper functions
473
474sub j2hash
475{
476    my $j = shift;
477    my $dir = shift;
478
479    my %props = (type => 'jabber',
480                 direction => $dir);
481
482    my $jtype = $props{jtype} = $j->GetType();
483    my $from  = $j->GetFrom('jid');
484    my $to    = $j->GetTo('jid');
485
486    $props{from} = $from->GetJID('full');
487    $props{to}   = $to->GetJID('full');
488
489    $props{recipient}  = $to->GetJID('base');
490    $props{sender}     = $from->GetJID('base');
491    $props{subject}    = $j->GetSubject() if ($j->DefinedSubject());
492    $props{thread}     = $j->GetThread() if ($j->DefinedThread());
493    $props{body}       = $j->GetBody() if ($j->DefinedBody());
494    $props{error}      = $j->GetError() if ($j->DefinedError());
495    $props{error_code} = $j->GetErrorCode() if ($j->DefinedErrorCode());
496    $props{xml}        = $j->GetXML();
497
498    if ($jtype eq 'chat')
499    {
500        $props{replycmd} = "jwrite ".(($dir eq 'in') ? $props{from} : $props{to});
501        $props{isprivate} = 1;
502    }
503    elsif ($jtype eq 'groupchat')
504    {
505        my $nick = $props{nick} = $from->GetResource();
506        my $room = $props{room} = $from->GetJID('base');
507        $props{replycmd} = "jwrite -g $room";
508       
509        $props{sender} = $nick;
510        $props{recipient} = $room;
511
512        if ($props{subject} && !$props{body})
513        {
514            $props{body} = '['.$nick." has set the topic to: ".$props{subject}."]"
515        }
516    }
517    elsif ($jtype eq 'normal')
518    {
519        $props{replycmd} = undef;
520        $props{isprivate} = 1;
521    }
522    elsif ($jtype eq 'headline')
523    {
524        $props{replycmd} = undef;
525    }
526    elsif ($jtype eq 'error')
527    {
528        $props{replycmd} = undef;
529        $props{body} = "Error ".$props{error_code}." sending to ".$props{from}."\n".$props{error};
530    }
531   
532    $props{replysendercmd} = $props{replycmd};
533    return %props;
534}
535
536sub j2o
537{
538    return owl::Message->new(j2hash(@_));
539}
540
541sub queue_admin_msg
542{
543    my $err = shift;
544    my $m = owl::Message->new(type => 'admin',
545                              direction => 'none',
546                              body => $err);
547    owl::queue_message($m);
548}
549
550sub boldify($)
551{
552    $str = shift;
553
554    return '@b('.$str.')' if ( $str !~ /\)/ );
555    return '@b<'.$str.'>' if ( $str !~ /\>/ );
556    return '@b{'.$str.'}' if ( $str !~ /\}/ );
557    return '@b['.$str.']' if ( $str !~ /\]/ );
558
559    my $txt = "\@b($str";
560    $txt =~ s/\)/\)\@b\[\)\]\@b\(/g;
561    return $txt.')';
562}
563
Note: See TracBrowser for help on using the repository browser.