💾 Archived View for thrig.me › blog › 2023 › 06 › 26 › connected.pl captured on 2023-07-10 at 14:36:42.

View Raw

More Information

-=-=-=-=-=-=-

#!/usr/bin/env perl
# SO_LINGER test - there are things to TWEAK
use strict;
use warnings;
use feature 'say';
use IO::Socket
  qw(AF_INET SOCK_STREAM SHUT_RD SHUT_RDWR SHUT_WR SOL_SOCKET SO_LINGER);

my $host = 'localhost';    # TWEAK

my $server = IO::Socket->new(
    Domain    => AF_INET,
    Listen    => 1,
    LocalHost => $host,
    LocalPort => 9999,             # get a random port
    Proto     => 'tcp',
    Reuse     => 1,
    Type      => SOCK_STREAM,
) or die "server failed $!\n";
my $port = $server->sockport;

# child sends a PING to the server, ignores response
my $pid = fork // die "fork failed: $!\n";
unless ($pid) {
    my $client = IO::Socket->new(
        Domain   => AF_INET,
        PeerHost => $host,
        PeerPort => $port,
        Type     => SOCK_STREAM,
        proto    => 'tcp',
    ) or die "client failed $!\n";
    $client->send("PING");
    # KLUGE TWEAK better would be to communicate via a pipe
    sleep 3;
    my $state = $client->connected ? 1 : 0;
    say "client connected? $state";
    $client->close;
    exit;
}

# server responds to client
my $client = $server->accept // die "server accept $!\n";

my $opt = $client->getsockopt( SOL_SOCKET, SO_LINGER );
printf "server linger %vx ($opt)\n", $opt;
# TWEAK uncomment this next line to enable SO_LINGER, no timeout
#$client->setsockopt( SOL_SOCKET, SO_LINGER, pack 'I*', 1, 0 );
$opt = $client->getsockopt( SOL_SOCKET, SO_LINGER );
printf "server linger %vx ($opt)\n", $opt;

my $state = $client->connected ? 1 : 0;
$client->read( my $data, 4 );
say "server <$data> connected? $state";
$client->send("PONG");
$client->shutdown(SHUT_WR); # try out other shutdowns!
$state = $client->connected ? 1 : 0;
say "server shut_wr connected? $state";
close $client;
sleep 5;

close $server;