Forking a subroutine that opens a socket pair

Question

I would like to fork a subroutine that opens a socket.

I have written the code to open a socket, receive the data, and print its received data. The GUI is written using Tk

Below is the code, it does basically what I want to do, with the exception of not forking the new_port subroutine. Every time I click the submit button the Tk window gets stuck. I am looking for help with adding a fork to the new_port subroutine so it spawns a new child process. I personally have trouble with execution of the fork without syntax errors or not pushing the socket into a child process.

The idea is that I can fill in a new port in the form and hit submit. The window closes, I then press new again put a new port in and now a second socket is open at the same time as the first. e.g. port 1234 and 5678 are being listened to at the same time.

#!/usr/bin/perl -w

use IO::Socket::INET;
use Tk;

$myip = `ifconfig | grep -i inet | head -1 | cut -d ":" -f2 | cut -d " " -f1`;

sub new_port {

    my $socket = new IO::Socket::INET(
        LocalHost => "$myip",
        LocalPort => "$myport",
        Proto     => 'tcp' Reuse => 1
   );

    die "Cannot create socket on local host" unless $socket;
    print "Server waiting for client connection on port $myport\n";

    while ( 1 ) {

        my $client_socket  = $socket->accept();
        my $client_address = $client_socket->peerhost();
        my $client_port    = $client_socket->peerport();
        my $input_data     = "";
        my $received_data  = "";

        do {
            $client_socket->recv($received_data, 65536);
            $input_data = $input_data . $received_data;
        } while ( $received_data ne "" );

        print "INPUT----------------------------------\n";
        print "Data from $client_address on port $client_port\n";
        print $input_data;
        shutdown($client_socket, 1);
    }
}

sub new_port_window {

    my $sw = MainWindow->new;

    $sw->geometry("200x100");
    $sw->title("port opener");
    $sw->Label(
        -text "Insert port #"
    )->place(
        -anchor => 'center',
        -relx => 0.5,
        -rely => 0.2
    );
    $sw->Entry(
        -bg => 'white',
        -fg => 'black',
        -textvariable => \$myport
    )->place(
        -anchor => 'center',
        -relx => 0.5,
        -rely => 0.4
    );
    $sw->Button(
        -text "submit",
        -command => sub {new_port}
    )->place(
        width   => 100,
        -anchor => "center",
        -relx   => 0.5,
        -rely   => 0.8
    );
}

my $mw = MainWindow->new;

$mw->geometry("150x100");
$mw->title("GUI TEST NEW FUNCTION");
$mw->Label(
    -text => "click new"
)->place(
    -anchor => "center",
    -relx => 0.5,
    -rely => 0.3
);
$mw->Button(
    -text => "NEW",
    -command => sub {new_port_window}
)->place(
    -width => 50,
    -anchor => "center",
    -relx => 0.5,
    -rely => 0.8
);

MainLoop;

Answer 1

It's been a long time since I first tried this, so I forget if this is the way it has to be done or if it's just one of many ways that work, but the gist is:

1. create a socket pair before the fork
2. perform the fork
3. use one socket in the parent and the other in the child
4. if you want the socket to be unidirectional (from parent to child or child to parent only), call shutdown on the appropriate socket in both the parent and the child

Since you want to send data from parent to child only, it looks like

($sock_child, $sock_par) = IO::Socket->socketpair(
    Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC);
$pid = fork;
if ($pid) {
    # parent
    shutdown($sock_par, 0); # no more reading from parent
    print $sock_par $data_to_pass_to_child;
    ...
 } else {
    # child
    shutdown($sock_child, 1);  # no more writing in child
    $data_from_parent = <$sock_child>;
    ...
 }