in reply to Socket read timeout on Windows
There are other ways where it is possible to check if data is available on the pipe before attempting to read so that you don't hang. I have another project competing for my time right now. So can't provide an example of that right away.
#!/usr/bin/perl # Simple client for testing # https://www.perlmonks.org/?node_id=11151665 use strict; use warnings; $!=1; use IO::Socket; my $socket = IO::Socket::INET -> new (PeerAddr => 'localhost', PeerPort => 8081, Proto => 'tcp', Type => SOCK_STREAM) or die "Cannot open socket!"; print "$socket"; my $cmd = <<'END_MESSAGE'; GET /DATA_String/{300 continuous characters of sensor data}HTTP/1.1 Some host line Some Connection line Some user-agent line, next line is blank END_MESSAGE $SIG{PIPE} = 'handler'; $SIG{INT} = 'handler'; $SIG{QUIT} = 'handler'; $SIG{ALRM} = 'handler'; server_request($cmd); #single request close $socket; #hang up exit(); sub server_request { my $cmd = shift; print "sending CMD to server\n"; alarm(2); print $socket "$cmd"; $socket->flush(); alarm(0); print "client debug: back from server: \n"; while (alarm(2),my $sResponse = <$socket>) { alarm(0); print "from Server: $sResponse"; } alarm(0); } sub handler { my ($signo) = shift; if ($signo eq "INT" or $signo eq "QUIT") { print $socket "QUIT\n"; close ($socket); exit (1); } elsif ($signo eq "ALRM") { print "server too slow - request timed out!\n"; exit (2); } else #SIGPIPE (probably!) { print "Server died with signal $signo\n"; exit (3); } }
#!/usr/bin/perl # Perl SOPW # https://www.perlmonks.org/?node_id=11151665 use strict; use warnings; $|=1; #Turn stdio buffering off use IO::Socket; use POSIX qw(sys_wait_h); use constant LISTEN_PORT => 8081; my $socket = IO::Socket::INET->new ( LocalPort => 8081, Proto => 'tcp', Type => SOCK_STREAM, Reuse => 1, Listen => 10, ) or die "Could not open port 8081!"; my $client; while (1) { $client = $socket->accept() || next; #accept() is not re-entrant #loop if error my $pid = fork(); die "Bad Fork!" unless defined $pid; if ($pid == 0 ) # child { close ($socket); # children don't listen for new connections my $line; my @buff; while (defined ($line=<$client>) and $line !~ /^\s*$/) { push @buff, $line; } my $time = time(); print "INCOMING from a Client Connection at $time\n"; do_command(\@buff); exit(0); } else # parent { close ($client); #wait for next client request } } sub do_command { my $buff = shift; print $client "START\n"; print $client "$_" for @$buff; #just loopback lines to client print $client "END\n"; $client->flush(); }
|
---|
Replies are listed 'Best First'. | |
---|---|
Re^2: Socket read timeout on Windows
by cavac (Prior) on Feb 17, 2025 at 15:14 UTC | |
Re^2: Socket read timeout on Windows
by bonzi (Acolyte) on Feb 15, 2025 at 09:24 UTC | |
by Marshall (Canon) on Feb 15, 2025 at 20:58 UTC |