# -*- perl -*-

use Socket;
use Test::More tests => 14;
use strict;

# This script assumes that `localhost' will resolve to a local IP
# address that may be bound to,

my $PORT = 40000 + int(rand(10000));


use HTTP::Server::Simple;

package SlowServer;
# This test class just waits a while before it starts
# accepting connections. This makes sure that CPAN #28122 is fixed:
# background() shouldn't return prematurely.

use base qw(HTTP::Server::Simple::CGI);
sub setup_listener {
    my $self = shift;
    $self->SUPER::setup_listener();
    sleep 2;
}
1;
package main;

my $DEBUG = 1 if @ARGV;

my @pids    = ();
my @classes = (qw(HTTP::Server::Simple SlowServer));
for my $class (@classes) {
    run_server_tests($class);
    $PORT++; # don't reuse the port incase your bogus os doesn't release in time
}



{
    my $s=HTTP::Server::Simple::CGI->new($PORT);
    $s->host("localhost");
    my $pid=$s->background();
    diag("started server PID='$pid'") if ($ENV{'TEST_VERBOSE'});
    like($pid, '/^-?\d+$/', 'pid is numeric');
    select(undef,undef,undef,0.2); # wait a sec
    my $content=fetch("GET / HTTP/1.1", "");
    like($content, '/Congratulations/', "Returns a page");

    eval {
	like(fetch("GET a bogus request"), 
	     '/bad request/i',
	     "knows what a request isn't");
    };
    fail("got exception in client: $@") if $@;

    like(fetch("GET / HTTP/1.1", ""), '/Congratulations/',
	 "HTTP/1.1 request");

    like(fetch("GET /"), '/Congratulations/',
	 "HTTP/0.9 request");

    is(kill(9,$pid),1,'Signaled 1 process successfully');
}

is( kill( 9, $_ ), 1, "Killed PID: $_" ) for @pids;

# this function may look excessive, but hopefully will be very useful
# in identifying common problems
sub fetch {
    my $hostname = "localhost";
    my $port = $PORT;
    my $message = join "", map { "$_\015\012" } @_;
    my $timeout = 5;    
    my $response;        
    
    eval {
        local $SIG{ALRM} = sub { die "early exit - SIGALRM caught" };
        alarm $timeout*2; #twice longer than timeout used later by select()  
 
        my $iaddr = inet_aton($hostname) || die "inet_aton: $!";
        my $paddr = sockaddr_in($port, $iaddr) || die "sockaddr_in: $!";
        my $proto = getprotobyname('tcp') || die "getprotobyname: $!";
        socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
        connect(SOCK, $paddr) || die "connect: $!";
        (send SOCK, $message, 0) || die "send: $!";
        
        my $rvec = '';
        vec($rvec, fileno(SOCK), 1) = 1;
        die "vec(): $!" unless $rvec; 

        $response = '';
        for (;;) {        
            my $r = select($rvec, undef, undef, $timeout);
            die "select: timeout - no data to read from server" unless ($r > 0);
            my $l = sysread(SOCK, $response, 1024, length($response));
            die "sysread: $!" unless defined($l);
            last if ($l == 0);
        }
        $response =~ s/\015\012/\n/g; 
        (close SOCK) || die "close(): $!";
        alarm 0;
    }; 
    if ($@) {
      	return "[ERROR] $@";
    }
    else {
        return $response;
    }    
}

sub run_server_tests {
    my $class = shift;
    my $s = $class->new($PORT);
    is($s->port(),$PORT,"Constructor set port correctly");

    my $pid=$s->background();
    select(undef,undef,undef,0.2); # wait a sec

    like($pid, '/^-?\d+$/', 'pid is numeric');

    my $content=fetch("GET / HTTP/1.1", "");

    like($content, '/Congratulations/', "Returns a page");
    push @pids, $pid;
}
