aplonis has asked for the wisdom of the Perl Monks concerning the following question:

I am having trouble with closing a socket on Win32. It's an XML-RPC server running on port 8080. I have one routine in which the server is to launch a restart-script and then die. It works fine on UNIX. It seems to work fine on Win32...except that the port stays unavailable...so that the restart dies for lack of a port.

In the server, to restart, I have this...

my $prefork_pid = $$; 

if ( defined( my $kid = fork ) ) {

  unless ($kid) { 
    # Launch the external update/restart script.
    exec( 
      "perl", "$script_path", "$local_port", 
    );
  }

  print "This always prints...\n";

  # Try dying gracefully first, then less so.
  kill 15, $prefork_pid; sleep 5;
  kill 2,  $prefork_pid; sleep 5;
  kill 9,  $prefork_pid;

  print "This never prints... So it died, alright.\n";
}

[download]

And in the restart script, I have this...

my ($local_port) = @ARGV;

# When on Win32, nap until OS clears its port.
my $i = 50;
while ($i && ($^O =~ /Win32/i)) {
    my @netstat = split "\n", `netstat.exe -a -p tcp`;

    print "Waiting up to $i passes...\n";

    foreach (@netstat) {
        next unless $_ =~ $local_port;
        print "$i: \t$_\n";
        sleep 60 if $_ =~ /(ESTABLISHED|LISTENING|WAIT)/;
    }
    --$i;
}

[download]

The wait-loop is an experiment...to see how long the port stays unavailable. It stays that way a long, long time...maybe forever.

Not shown beyond the wait-loop is the restart code, which launches an updated version of the server on the same port. This works in UNIX, but is futile on Win32...because the port never clears.

Now I read about something called Win32::Process which I should use instead of fork. So my question is: With what would I supplant the above for Win32 using Win32::Process? What is the best way?

Thanks,

Replies are listed 'Best First'.
Re: Socket left open on Win32 after fork-and-die...
by aplonis (Pilgrim) on Sep 05, 2005 at 22:17 UTC

    I figured it out all by myself ;-)

    #!/usr/pkg/bin/perl -w
# Copyright 2005 by Gan Uesli Starling
# XML-RPC server update script written in Perl.
# For use with this XML-RPC Client/Server pair:
# 1. gus_xml-rpc_server.pl
# 2. gus_xml-rpc_client_tk.pl

# HOW IT WORKS:
# On command, the running server updates itself as follows:
# 1. Receives new version of own script from XML-RPC client.
# 2. Over-writes own script with new version.
# 3. Launches this script in manner similar to below.
# 4. Dies when this script kills it.
# 5. Is reborn when new version launched by this script.

# Args sent by the to-be-restarted, still-running server.
my ( $script_path, $script_list, $local_port, 
     $crypt_key, $plain_pw, $prefork_pid ) = @ARGV;
            
# Lay running server to rest.
kill 15, $prefork_pid; sleep 5; # Gently persuade at first.
kill  2, $prefork_pid; sleep 5; # If ignored, insist harder.
kill  9, $prefork_pid; sleep 5; # If still ignored, use hammer.

# Launch-string for use with 'Process::Create' on Win32.
my $win32_cmd = "perl $script_path/gus_xml-rpc_server.pl "
    . "--script_list $script_list "
    . "--local_port $local_port "
    . "--crypt_key $crypt_key "
    . "--password $plain_pw "
    . "--gui 0 ";

# Launch-array for use with 'fork' on Unix.
my @unix_cmd = (
    "perl", "$script_path/gus_xml-rpc_server.pl", 
    "--script_list", "$script_list",
    "--local_port", "$local_port",
    "--crypt_key", "$crypt_key",
    "--password", "$plain_pw",
    "--gui", "0"
);

# Launch new process the UNIX way.
sub unix_fork_process {
    if ( defined( my $kid = fork ) ) {
        unless ($kid) { 
            exec(@_) or die "Oops! Cannot exec.";
        }
    }
}

# Launch new process the Win32 way.

sub win32_create_process {
    my $win32_cmd = shift;
    require Win32::Process;
    require Win32;
    no strict;
    my $obj;

    sub ErrorReport{
        print Win32::FormatMessage( Win32::GetLastError() );
    }
    $win32_cmd =~ s/\//\\/g; # Backslashes for Win32.

    Win32::Process::Create(
        $obj, "C:\\Perl\\bin\\wperl.exe",
        "$win32_cmd", 0, NORMAL_PRIORITY_CLASS, "."
    ) || die ErrorReport();
}

# Launch new process any way whichever...
if ($^O =~ /Win32/i) { win32_create_process($win32_cmd) }
else { unix_fork_process(@unix_cmd) }

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom