#!/usr/bin/perl

use strict;
use warnings;
use IO::Socket;
use File::Temp;
use Time::HiRes qw(usleep);
use POSIX ":sys_wait_h";

# A really dumb web server that should break requests into two segments
sub httpd($) {
    my $sock_path = shift;

    unlink($sock_path); # may fail
    my $server = IO::Socket::UNIX->new(Type   => SOCK_STREAM,
                                       Local  => $sock_path,
                                       Listen => 5)
        or die $!;

    while(my $client = $server->accept()) {
        my $pid = fork();
        next if $pid;
        die "fork: $!" unless defined $pid;
        while (my $line = $client->getline()) {
            # print "CLIENT: $line";
            last if $line =~ /^GET/;
        }

        print $client "HTTP/1.0 200 OK\r\n";
        print $client "Content-Type: text/plain\r\n";
        print $client "Content-Length: " . (28192 + 1 + 28192 + 1 + 5) . "\r\n";
        print $client "\r\n";
        print $client 'X' x 28192 . "\n";
        $client->flush();
        usleep(200);
        print $client 'x' x 28192 . "\n";
        print $client "DONE\n";
        $client->flush();


        close($client);
        exit;
    } continue {
        # close child sockets
        close($client);
    }
    die "accept(): $!";
}

sub stunnel_config($$$$) {
    my ($fh, $socket_path, $pem_file, $domain) = @_;
    my $pid_file = File::Temp::tmpnam() . ".pid";

    print $fh <<END
sslVersion = all
options = NO_SSLv2
options = CIPHER_SERVER_PREFERENCE
pid = $pid_file
foreground = yes
debug=debug
protocol=proxy
;reset=no

socket = l:TCP_NODELAY=1
socket = r:TCP_NODELAY=1

[127.0.0.1]
    cert=$pem_file
    accept=127.0.0.1:4443
    connect=$socket_path
    TIMEOUTclose=0
    TIMEOUTidle=50
END
}

sub main {
    my $socket_path = File::Temp::tmpnam() . ".sock";
    my @children = ();
    my @temp_files = ();

    my $pid = fork();
    unless (defined $pid) {
        die "fork: $!";
    } elsif ($pid == 0) {
        httpd($socket_path);
        exit(0);
    }
    push @children, $pid;
    push @temp_files, $socket_path;

    # Build an stunnel config;
    my ($fh, $stunnel_config) = File::Temp::tempfile("/tmp/stunnel.conf-XXXXXX");
    push @temp_files, $stunnel_config;
    stunnel_config($fh,
                   $socket_path,
                   '/home/dustin/src/stunnel_test/snakeoil.pem',
                   'localhost');
    close($fh);

    # Start stunnel
    $pid = fork();
    unless (defined $pid) {
        die "fork: $!";
    } elsif ($pid == 0) {
        exec(
#            'strace',
#            '-o', 'stunnel.trace',
            '/home/dustin/src/stunnel_test/stunnel',
            $stunnel_config);
        exit(0);
    }
    push @children, $pid;

    # Wait for stunnel to start
    sleep 1;

    system('curl -k -s -o /dev/null https://127.0.0.1:4443/');
    print "curl exited with $?\n" if $?;

    sleep 1;

    print STDERR "Cleaning up ...\n";
    # Cleaning up children
    while (@children) {
        my @stragglers = grep(kill(0, $_) == 1, @children);

        foreach (@stragglers) {
            kill(15, $_);
            waitpid($_, WNOHANG);
        }
        @children = @stragglers;
    }

    unlink(@temp_files);
}

main();