Skip Menu |
 

This queue is for tickets about the IO-Async CPAN distribution.

Report information
The Basics
Id: 125858
Status: new
Priority: 0/
Queue: IO-Async

People
Owner: Nobody in particular
Requestors: tobias.nieschulze [...] gmail.com
Cc:
AdminCc:

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



Subject: IO Async Bug on changed time
Date: Mon, 16 Jul 2018 16:25:13 +0200
To: bug-IO-Async [...] rt.cpan.org
From: Tobias Nieschulze <tobias.nieschulze [...] gmail.com>
Download (untitled) / with headers
text/plain 3.2k
There is a bug in IO::Async in the timer periodic module and also in the tcp server. I think it could be, that the bug in the server is caused by the timer issue: If the time is changed backwards, then the server does not receive any message. After the time is back over the original time, everything works normal again. Here is a test script, that creates a server and a client and after 5 messages the time will be set back for 10 s. What you will see is that the server hangs for 10 seconds and after that everything works normal again. The connection is not closed, no reconnect is needed. If you change the direction of the time change (line 104) ($t-=10 -> $t+=10) everything works like expected, there are continous messages without a break. Any help (also a workaround) would be appreciated! Code is only for a linux system and changes the time back by a date command. #!/usr/local/bin/perl use strict; use warnings; use IO::Async::Timer::Periodic; use IO::Async::Loop; use IO::Async::Listener; my $loop = IO::Async::Loop->new; my $listener = IO::Async::Listener->new( on_stream => sub { my ( $self, $stream ) = @_; $stream->configure( autoflush => 'true', # Receiving data from Client! on_read => sub { my ( $self, $buffref, $eof ) = @_; while ( $$buffref =~ s/^(.*\n)// ) { my $msg = $1; $msg =~ s/\n//g; print "SERVER <- $msg\n"; } }, on_closed => sub { $stream->close_when_empty; }, ); $loop->add( $stream ); } ); $loop->add( $listener ); $listener->listen( service => 3000, socktype => 'stream', )->on_done( sub { my ( $listener ) = @_; my $socket = $listener->read_handle; print "Server listening on port 3000\n"; } )->get; my $cnt=0; $loop->connect( host => "127.0.0.1", service => 3000, socktype => 'stream', on_stream => sub { my ($stream) = @_; my $socket = $stream->read_handle; my $id = $socket->peerhost . ':' . $socket->peerport; $stream->configure( on_read => sub { my ( $self, $buffref, $eof ) = @_; while ( $$buffref =~ s/^(.*\n)// ) { my $msg = $1; $msg =~ s/\n//g; } return 0; }, on_closed => sub { die "CLIENT DISCONNECTED\n"; } ); $stream->write("Hi\n"); $loop->add($stream); watch_time_socket($stream); }, on_resolve_error => sub { die "CLIENT DISCONNECTED\n"; }, on_connect_error => sub { die "CLIENT DISCONNECTED\n"; }, ); $loop->run; sub watch_time_socket { my ($stream) = @_; $stream->write("Watch socket timer\n"); $loop->watch_time( after => 1, code => sub { watch_time_socket($stream); $cnt++; if ($cnt >= 5) { $cnt=0; print "CURRENT ".`date`; my $t = `date "+%s"`; $t-= 10; `date -s \@$t`; print "NEW ". `date`; } } ); }


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.