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();
}
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);
