use strict;
use Test::More tests => 4;
use FileHandle;
use IO::Socket;
use POSIX qw(SIGHUP SIGTERM WNOHANG);

# This test is quite involved because we are going to actually
# run a separate FTP server process, listening on some high-numbered
# local port (which we hope won't conflict). We're going to send
# it a SIGHUP, to force it to reload the configuration file, and
# then we'll query it to see if it really has done that.

# Choose a free ephemeral port to avoid possible
# conflicts with other local services.
"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
my $port = IO::Socket::INET->new(Listen => 8)->sockport;

# Where am I?  I need to unchdir "/" later.
my $here = `pwd`;
chomp $here;

my $config  = ".400sighup.t.$$.conf";
my $invoker = ".400sighup.t.$$.pl";

# Where is this perl?
my $perl = $^X;
if ($perl !~ m%^/%) {
  foreach my $path (split /:/, ($ENV{PATH} || "/usr/local/bin:/usr/bin:/bin")) {
    if (-x "$path/$^X") {
      $perl = "$path/$^X";
      last;
    }
  }
}

# Need to preserve @INC for invoker script
my $lib_pass = join(" ",@INC);

# Write $invoker script which loads $config
open CF, ">$invoker" or die "$invoker: $!";
print CF <<EOT;
#!$perl
use lib qw($lib_pass);
use Net::FTPServer::InMem::Server;
alarm(60); # Runaway servers are bad
*Net::FTPServer::InMem::Server::post_bind_hook = sub {
  chdir "$here";   # Go back to where I was
  kill "USR1", $$; # Tell daddy I'm ready
};
run Net::FTPServer::InMem::Server [qw(--test -s -C $config)];
exit;
EOT
close CF;
chmod(0755,$invoker);

# Write a configuration file. We're going to modify this later.
open CF, ">$config" or die "$config: $!";
print CF <<EOT;
port: $port
greeting type: full
<Perl>
\$self->{version_string} = "key string no. 1";
</Perl>
EOT
close CF;

my $listening = 0;

$SIG{USR1} = sub {
  $listening = 1;
};

# Start the external invoker script.
my $pid = fork ();
die unless defined $pid;
unless ($pid) {            # Child process (the server).
  exec("./$invoker") or die "exec: $!";
}

# We know the server is ready when $listening == 1
while (!$listening and kill 0, $pid) {
  # Server still starting up.
  sleep 1; #  *YAWN*  (Patience until it's ready.)
  waitpid($pid,WNOHANG);
}

my $sock;

"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
$sock = new IO::Socket::INET->new (PeerAddr => "localhost",
                                   PeerPort => $port,
                                   Proto => "tcp",
                                   Type => SOCK_STREAM,
                                   Reuse => 1)
  or die "connect: $!";

# Check the server greeting contains "key string no. 1" from the initial
# configuration file.
my $greeting = $sock->getline;

ok ($greeting =~ /key string no\. 1/);

undef $sock;

# Modify the configuration file.
open CF, ">$config" or die "$config: $!";
print CF <<EOT;
port: $port
greeting type: full
<Perl>
\$self->{version_string} = "the second key string";
</Perl>
EOT
close CF;

$listening = 0;

# Send SIGHUP to the server.
ok (kill SIGHUP, $pid);

# We know the server is ready when $listening == 1
while (!$listening and kill 0, $pid) {
  # Server still starting up.
  sleep 1; #  *YAWN*  (Patience until it's ready.)
  waitpid($pid,WNOHANG);
}

"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
$sock = new IO::Socket::INET->new (PeerAddr => "localhost",
                                   PeerPort => $port,
                                   Proto => "tcp",
                                   Type => SOCK_STREAM,
                                   Reuse => 1)
  or die "connect: $!";

# Check the server greeting contains "the second key string" from
# the new configuration file.
$greeting = $sock->getline;

ok ($greeting =~ /the second key string/);

undef $sock;

# Tell the server to shutdown gracefully.
ok (kill SIGTERM, $pid);

END {
  # Remove the temporary files.
  unlink $config, $invoker;
}

__END__