Skip Menu |
 

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

Report information
The Basics
Id: 44629
Status: resolved
Priority: 0/
Queue: Net-Stomp

People
Owner: Nobody in particular
Requestors: mock [...] sketchfactory.com
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in: 0.34
Fixed in: (no value)



Subject: buffered I/O combined with select causes receive_frame to hang
Download (untitled) / with headers
text/plain 3.4k
On some of my machines the attached code (brokenapachemq.t) will hang forever when doing a receive_frame. Upon examination of the problem one of my co-workers noted that he had encountered the same issue, and that it was due to getline and read being used with select in Frame.pm. He provided a fix which solved the problem, which I have cleaned up, and I'm attaching as a patch for Frame.pm. The machines that have the issue are running: Ubuntu with kernel 2.6.24-19-server #1 SMP Wed Jun 18 14:44:47 UTC 2008 x86_64 GNU/Linux $ perl -V Summary of my perl5 (revision 5 version 8 subversion 8) configuration: Platform: osname=linux, osvers=2.6.15.7, archname=x86_64-linux-gnu-thread-multi uname='linux yellow 2.6.15.7 #1 smp sun sep 23 13:51:52 utc 2007 x86_64 gnulinux ' config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.8 -Dsitearch=/usr/local/lib/perl/5.8.8 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.8 -Dd_dosuid -des' hint=recommended, useposix=true, d_sigaction=define usethreads=define use5005threads=undef useithreads=define usemultiplicity=define useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=define use64bitall=define uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include' ccversion='', gccversion='4.2.3 20071123 (prerelease) (Ubuntu 4.2.2-3ubuntu4)', gccosandvers='' intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16 ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt perllibs=-ldl -lm -lpthread -lc -lcrypt libc=/lib/libc-2.6.1.so, so=so, useshrplib=true, libperl=libperl.so.5.8.8 gnulibc_version='2.6.1' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib' Characteristics of this binary (from libperl): Compile-time options: MULTIPLICITY PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP THREADS_HAVE_PIDS USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES USE_PERLIO USE_REENTRANT_API Built under linux Compiled at Nov 27 2007 10:56:40 @INC: /etc/perl /usr/local/lib/perl/5.8.8 /usr/local/share/perl/5.8.8 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8 /usr/local/lib/site_perl . Class::Accessor::Fast 0.31 IO::Socket::INET 1.31 IO::Select 1.17
Subject: brokenapachemq.t
Download brokenapachemq.t
text/x-perl 1.5k
#!/usr/bin/perl use lib '/web/apps/lib'; use Net::Stomp; my $stomp_host = '192.168.20.76'; my $stomp_port = '61613'; my $stomp; $stomp = Net::Stomp->new({ hostname => $stomp_host, port => $stomp_port, }); $stomp->connect({ login => 'foo', passcode => 'bar', }); $stomp->subscribe({ destination => '/queue/testbrokenapachemq', ack => 'client', 'activemq.dispatchAsync' => 0, 'activemq.prefetchSize' => 1, }); my $body = "z"; my $frame = Net::Stomp::Frame->new({ command => 'SEND', body => $body, headers => { destination => '/queue/testbrokenapachemq', name => 'foobarbaz', JSMXGroupID => 'XXX', }, }); $stomp->send_frame($frame); print "frame $body sent\n"; $body = "x"; $frame = Net::Stomp::Frame->new({ command => 'SEND', body => $body, headers => { destination => '/queue/testbrokenapachemq', name => 'foobarbaz', JSMXGroupID => 'XXX', }, }); $stomp->send_frame($frame); print "frame $body sent\n"; $body = "y"; $frame = Net::Stomp::Frame->new({ command => 'SEND', body => $body, headers => { destination => '/queue/testbrokenapachemq', name => 'foobarbaz', JSMXGroupID => 'XXX', }, }); $stomp->send_frame($frame); print "frame $body sent\n"; print "Broken if this hangs forever\n"; my $count = 0; while (1) { if (eval {$frame = $stomp->receive_frame}) { print "GOT FRAME ".$frame->body."\n"; $stomp->ack({frame => $frame}); $count++; last if $count == 3; } } print "Success\n";
Subject: frame.patch
Download frame.patch
text/x-diff 2.2k
--- lib/Net/Stomp/Frame.pm 2008-06-27 01:31:46.000000000 -0700 +++ ../Net-Stomp-0.34.patch/lib/Net/Stomp/Frame.pm 2009-03-27 14:09:54.000000000 -0700 @@ -27,6 +27,23 @@ $frame .= "\000"; } +# NBK - $sock->getline does buffered IO which screws up select. Use +# sysread one char at a time to avoid reading part of the next line. +sub readline { + my($self, $socket, $terminator, $msg) = @_; + + $terminator = "\n" unless defined($terminator); + $msg ||= ""; + + my $s = ""; + while( 1 ) { + $socket->sysread($s, 1, length($s)) or die("Error reading $msg: $!"); + last if substr($s, -1) eq $terminator; + } + + return $s; +} + sub parse { my ( $package, $socket ) = @_; local $/ = "\n"; @@ -34,7 +51,7 @@ # read the command my $command; while (1) { - $command = $socket->getline || die "Error reading command: $!"; + $command = $package->readline($socket, "\n", "command"); chop $command; last if $command; } @@ -42,31 +59,29 @@ # read headers my $headers; while (1) { - my $line = $socket->getline || die "Error reading header: $!"; + my $line = $package->readline($socket, "\n", "header"); chop $line; last if $line eq ""; - my ( $key, $value ) = split /: ?/, $line, 2; + my ( $key, $value ) = split(/: ?/, $line, 2); $headers->{$key} = $value; } # read the body my $body; + my $c; if ( $headers->{"content-length"} ) { - $socket->read( $body, $headers->{"content-length"} ) + $socket->sysread( $body, $headers->{"content-length"} + 1 ) || die "Error reading body: $!"; - $socket->getc; # eat the trailing null $headers->{bytes_message} = 1; } else { - while (1) { - my $byte = $socket->getc; - die "Error reading body: $!" unless defined $byte; - last if $byte eq "\000"; - $body .= $byte; - } + $body = $package->readline($socket, "\000", "body"); } - + # strip trailing null + $body =~ s/\000$//; + my $frame = Net::Stomp::Frame->new( { command => $command, headers => $headers, body => $body } ); + return $frame; }
Download (untitled) / with headers
text/plain 293b
(I've just recently taken over maintenance of Net::Stomp) Looking at this patch and it seems to cause problems with the (new?) timeout functionality in can_read - it ends up looping forever instead of timing out. Is the root cause still there? Is there an easy way to test this problem/fix?
Download (untitled) / with headers
text/plain 146b
Paulo Castro had this same problem and reported that your patch works fine. Released as 0.38 just now to CPAN - coming to a mirror near you soon.


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.