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

Report information
The Basics
Id:
125858
Status:
new
Priority:
Low/Low
Queue:

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

BugTracker
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>
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 runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

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