Skip Menu |
 

This queue is for tickets about the Net-XMPP CPAN distribution.

Report information
The Basics
Id: 61144
Status: patched
Priority: 2/
Queue: Net-XMPP

People
Owner: dapatrick [...] cpan.org
Requestors: bellaire [...] at.ufl.edu
sup2000 [...] hotmail.com
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 1.02
Fixed in: (no value)



Subject: Calls to $jid->isa without package or reference
Date: Tue, 2 Oct 2007 16:48:51 -0400
To: <bug-Net-XMPP [...] rt.cpan.org>
From: "Bellaire,Adam P" <bellaire [...] at.ufl.edu>
Download (untitled) / with headers
text/plain 1.4k
In Net::XMPP::Roster, there are a large number of calls of the form $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); In other words, we want $jid to be a scalar representation of the JID, so we check whether it is really a Net::XMPP::JID Object, and if it is, we call GetJID(). Presumably, this is meant to leave the scalar alone if it is already a non-object scalar JID, but that doesn't work. In fact, if JID is already a scalar (such as "myid@jabber.org"), the if statement dies because isa is being called without a package or object reference. If we could be sure that $jid was always an object, this wouldn't be a problem, but other code in Roster disagrees: sub handleRoster { my $self = shift; my $roster = shift; foreach my $jid (keys(%{$roster})) { $self->remove($jid); if ($roster->{$jid}->{subscription} ne "remove") { $self->add($jid, %{$roster->{$jid}}); } } } Here we extract the keys from a hash and pass them as $jid to remove() and add(), two of the subs that use the code style above. This breaks egregiously, a hash key can never be a properly blessed reference (though it could be a class name, in this context that doesn't make sense). I'd recommend replacing the call with something like: $jid = $jid->GetJID() if (ref $jid && $jid->isa("Net::XMPP::JID")); or $jid = $jid->GetJID() if UNIVERSAL::isa("Net::XMPP::JID");
Subject: Fatal Error on connect when Roster includes a JID that starts with a number
Download (untitled) / with headers
text/plain 3.1k
When a Jabber server has a user with a JID that starts with a number, everything falls apart when Net::XMPP::Protocol::RosterDBExists is called. This is because Perl behaves inconsistently when the isa method is called against a scalar. Steps to reproduce: Sure, you can't call ->isa against a scalar at all, Perl's just more forgiving with a scalar starting with a letter, rather than ones starting with a number. For example, a scalar starting with a letter: [root@epbxhou jabber]# ./test1.pl [root@epbxhou jabber]# cat test1.pl #!/usr/bin/perl use strict; print 'somestring'->isa('Not here'); [root@epbxhou jabber]# But, when the same code is ran with a scalar starting with a number, a fatal error is generated: [root@epbxhou jabber]# ./test2.pl Can't call method "isa" without a package or object reference at ./test2.pl line 3. [root@epbxhou jabber]# cat test2.pl #!/usr/bin/perl use strict; print '2somestring'->isa('Not here'); [root@epbxhou jabber]# RosterDBExists requires the scalars to conform to the first example. Here's the code in question: 2461 ############################################################################## 2462 # 2463 # RosterDBExists - allows you to query if the JID exists in the Roster DB. 2464 # 2465 ############################################################################## 2466 sub RosterDBExists 2467 { 2468 my $self = shift; 2469 my ($jid) = @_; 2470 2471 if ($jid->isa("Net::XMPP::JID")) 2472 { 2473 $jid = $jid->GetJID(); 2474 } 2475 2476 return unless exists($self->{ROSTERDB}); 2477 return unless exists($self->{ROSTERDB}->{JIDS}); 2478 return unless exists($self->{ROSTERDB}->{JIDS}->{$jid}); 2479 return 1; 2480 } This problem was hinted to in bug #29725 (https://rt.cpan.org/Public/Bug/Display.html?id=29725) but, I suspect it never really has been an issue because Jabber IDs rarely start with a number. There are several parts in the code where ->isa is used, without first making sure that the provided object is actually an object. I've prepared a patch that ensures the JID is a ref before calling ->isa. Version Info: Net::XMPP 1.02 Perl 5.8.8 CentOS 5.3 (Linux 2.6.18 'sh) Also, in order to narrow the problem down, I threw a print Dumper(@_) type thing into Net/XMPP/Protocol.pm. That's how I narrowed this down. Here's a chunk of its output: Dump: $VAR1 = 'cpgary@somejabberservername'; Argv dump: $VAR1 = [ 'cpgary@somejabberservername' ]; Ref: '' Dump: $VAR1 = '1984@somejabberservername'; Argv dump: $VAR1 = [ '1984@somejabberservername' ]; Ref: '' Can't call method "isa" without a package or object reference at /usr/lib/perl5/site_perl/5.8.8/Net/XMPP/Protocol.pm line 2479. And this is the modified code used to generate it (in the same region as the original code provided above from Protocol.pm): use Data::Dumper; print "Dump: ".Data::Dumper::Dumper($jid)."\n"; print "Argv dump: ".Data::Dumper::Dumper(\@_)."\n"; print "Ref: '".ref($jid)."'\n"; if ($jid->isa("Net::XMPP::JID")) { $jid = $jid->GetJID(); }
Subject: patch.diff
Download patch.diff
text/x-diff 5.6k
Only in Net-XMPP-1.02.modified: Build Only in Net-XMPP-1.02.modified: Makefile Only in Net-XMPP-1.02.modified: _build diff -ru Net-XMPP-1.02/lib/Net/XMPP/Protocol.pm Net-XMPP-1.02.modified/lib/Net/XMPP/Protocol.pm --- Net-XMPP-1.02/lib/Net/XMPP/Protocol.pm 2007-03-29 07:24:35.000000000 -0500 +++ Net-XMPP-1.02.modified/lib/Net/XMPP/Protocol.pm 2010-09-07 15:41:26.000000000 -0500 @@ -1648,7 +1648,7 @@ my ($jid) = @_; my $indexJID = $jid; - $indexJID = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $indexJID = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return if !exists($self->{PRESENCEDB}->{$indexJID}); delete($self->{PRESENCEDB}->{$indexJID}); @@ -1687,7 +1687,7 @@ my ($jid) = @_; my $indexJID = $jid; - $indexJID = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $indexJID = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return if !exists($self->{PRESENCEDB}->{$indexJID}); return if (scalar(keys(%{$self->{PRESENCEDB}->{$indexJID}->{priorities}})) == 0); @@ -1711,7 +1711,7 @@ my ($jid) = @_; my $indexJID = $jid; - $indexJID = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $indexJID = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); my @resources; @@ -2468,7 +2468,7 @@ my $self = shift; my ($jid) = @_; - if ($jid->isa("Net::XMPP::JID")) + if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")) { $jid = $jid->GetJID(); } @@ -2636,7 +2636,7 @@ my $jid = shift; my $key = shift; - if ($jid->isa("Net::XMPP::JID")) + if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")) { $jid = $jid->GetJID(); } diff -ru Net-XMPP-1.02/lib/Net/XMPP/Roster.pm Net-XMPP-1.02.modified/lib/Net/XMPP/Roster.pm --- Net-XMPP-1.02/lib/Net/XMPP/Roster.pm 2007-03-29 07:24:52.000000000 -0500 +++ Net-XMPP-1.02.modified/lib/Net/XMPP/Roster.pm 2010-09-07 16:08:09.000000000 -0500 @@ -268,7 +268,7 @@ my $self = shift; my ($jid,%item) = @_; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); $self->{JIDS}->{$jid} = \%item; @@ -295,7 +295,7 @@ my $resource = shift; my (%item) = @_; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); my $priority = $item{priority}; $priority = 0 unless defined($priority); @@ -349,7 +349,7 @@ my $self = shift; my ($jid) = @_; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless exists($self->{JIDS}); return unless exists($self->{JIDS}->{$jid}); @@ -561,7 +561,7 @@ my $self = shift; my $jid = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless $self->exists($jid); @@ -583,7 +583,7 @@ my $jid = shift; my $resource = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); if (defined($resource)) { @@ -609,7 +609,7 @@ my $jid = shift; my $key = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless $self->exists($jid); if (defined($key)) @@ -631,7 +631,7 @@ my $self = shift; my $jid = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); if ($self->exists($jid)) { @@ -666,7 +666,7 @@ my $jid = shift; my $resource = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); if ($self->resourceExists($jid,$resource)) { @@ -707,7 +707,7 @@ my $self = shift; my $jid = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless $self->exists($jid); @@ -730,7 +730,7 @@ my $jid = shift; my $resource = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless $self->exists($jid); return unless exists($self->{JIDS}->{$jid}->{resources}); @@ -751,7 +751,7 @@ my $resource = shift; my $key = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless $self->resourceExists($jid,$resource); if (defined($key)) @@ -773,7 +773,7 @@ my $self = shift; my $jid = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return () unless $self->exists($jid); @@ -806,7 +806,7 @@ my $key = shift; my $value = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless defined($key); return unless defined($value); @@ -830,7 +830,7 @@ my $key = shift; my $value = shift; - $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID"); + $jid = $jid->GetJID() if ((ref($jid) ne "") && $jid->isa("Net::XMPP::JID")); return unless defined($key); return unless defined($value);
Download (untitled) / with headers
text/plain 233b
Adam, Thanks for this report. I'm merging this ticket into bug #61144 which contains additional explanation and a patch. I'd like to keep your information and the other reporter's information together in one ticket. Thanks, Darian
Download (untitled) / with headers
text/plain 175b
This bug has been patched and committed. The source tree is available at http://github.com/dap/Net-XMPP. A developer release should be published to CPAN by 2010-09-26. Darian


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.