#!/usr/bin/env perl

package IO::Socket::Socks::Slow;

use Socket;
use IO::Socket::Socks qw(:constants);
use base 'IO::Socket::Socks';
use strict;

our $DELAY = 0;

*_fail = \&IO::Socket::Socks::_fail;

sub _socks4_connect_command
{
	my $self = shift;
	my $command = shift;
	my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug};
	my ($reads, $sends, $debugs) = (0, 0, 0);
	my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $IO::Socket::Socks::SOCKS4_RESOLVE;
	
	my $dstaddr = $resolve ? inet_aton('0.0.0.1') : inet_aton(${*$self}->{SOCKS}->{CmdAddr});
	my $dstport = pack('n', ${*$self}->{SOCKS}->{CmdPort});
	my $userid  = ${*$self}->{SOCKS}->{Username} || '';
	my $dsthost = '';
	if($resolve)
	{ # socks4a
		$dsthost = ${*$self}->{SOCKS}->{CmdAddr} . pack('C', 0);
	}
	
	my $reply;
	my $request = pack('CC', SOCKS4_VER, $command) . $dstport . $dstaddr . $userid . pack('C', 0) . $dsthost;
	my $sent = 0;
	
	while ($request =~ /(..{0,3})/g) {
		$reply = $self->_socks_send($1, ++$sends)
			or return _fail($reply);
		
		$sent += length($1);
		last if $sent == length($request);
		
		sleep $DELAY;
	}
		
	if($debug && !$self->_debugged(++$debugs))
	{
		$debug->add(
			ver => SOCKS4_VER,
			cmd => $command,
			dstport => ${*$self}->{SOCKS}->{CmdPort},
			dstaddr => length($dstaddr) == 4 ? inet_ntoa($dstaddr) : undef,
			userid => $userid,
			null => 0
		);
		if($dsthost)
		{
			$debug->add(
				dsthost => ${*$self}->{SOCKS}->{CmdAddr},
				null => 0
			);
		}
		$debug->show('Client Send: ');
	}
	
	return 1;
}

package main;

use Test::More;
use IO::Socket::Socks;
use IO::Select;
use Time::HiRes;
use strict;
require 't/subs.pm';

use constant CONN_CNT => 3;

unless ($ENV{SOCKS_SLOW_TESTS} || $ENV{AUTOMATED_TESTING}) {
	plan skip_all => "SOCKS_SLOW_TESTS environment variable should has true value";
}

if( $^O eq 'MSWin32' ) {
	plan skip_all => 'Fork and Windows are incompatible';
}

my %childs;
my @pipes;
my %map = (
	1 => {host => 'google.com', port => 80, request => 'wtf', response => 'googlre response'},
	2 => {host => '2gis.ru', port => 22, request => 'defined', response => 'johny'},
	3 => {host => 'academ.info', port => 110, request => 'make', response => 'segmentation fault'},
);

for my $d (1..CONN_CNT) {
	pipe my $reader, my $writer;
	push @pipes, $writer;
	
	defined (my $child = fork())
		or die "fork(): $!";
	if ($child == 0) {
		close $writer;
		chomp(my $servinfo = <$reader>);
		my ($host, $port) = split /\|/, $servinfo;
		close $reader;
		
		$IO::Socket::Socks::Slow::DELAY = $d;
		my $cli = IO::Socket::Socks::Slow->new(ProxyAddr => $host, ProxyPort => $port, ConnectAddr => $map{$d}{host},
		                                       ConnectPort => $map{$d}{port}, SocksVersion => 4, SocksResolve => 1) or die $@;
		$cli->syswrite("$d:$map{$d}{request}")
			or die $!;
		$cli->sysread(my $buf, 1024)
			or die $!;
		$buf eq $map{$d}{response}
			or die "$buf != $map{$d}{response}";
		
		exit 0;
	}
	
	$childs{$child} = 1;
}

my $server = IO::Socket::Socks->new(Blocking => 0, Listen => 10, SocksVersion => 4, SocksResolve => 1)
	or die $@;

my $host = fix_addr($server->sockhost);
my $port = $server->sockport;

print $_ "$host|$port\n" for @pipes;
close $_ for @pipes;

my $sel_read  = IO::Select->new($server);
my $sel_write = IO::Select->new();

my $conn_cnt = 0;
while ($conn_cnt < CONN_CNT || $sel_read->count() > 1 || $sel_write->count() > 0) {
	my @ready;
	push @ready, $sel_read->can_read(0.3);
	push @ready, $sel_write->can_write(0.3);
	
	foreach my $socket (@ready) {
		my $start = Time::HiRes::time();
		if ($socket == $server) {
			my $client = $server->accept();
			ok($client, "New client connection") or diag $SOCKS_ERROR;
			$client->blocking(0);
			$socket = $client;
			$conn_cnt++;
		}
		
		if ($socket->ready) {
			$socket->command_reply(IO::Socket::Socks::REQUEST_GRANTED, '127.0.0.1', $socket->command->[2]);
			IO::Select->new($socket)->can_read;
			
			ok(defined $socket->sysread(my $request, 1024), "sysread() success") or diag $!;
			my ($d, $r) = $request =~ /(\d+):(.+)/;
			
			ok(defined $d, "Correct key") or diag $request;
			is($r, $map{$d}{request}, "Correct request");
			
			ok(defined $socket->syswrite($map{$d}{response}), "syswrite() success") or diag $!;
			$sel_read->remove($socket);
			$sel_write->remove($socket);
			$socket->close();
		}
		elsif ($SOCKS_ERROR == SOCKS_WANT_READ) {
			$sel_write->remove($socket);
			$sel_read->add($socket);
		}
		elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) {
			$sel_read->remove($socket);
			$sel_write->add($socket);
		}
		else {
			ok(0, '$SOCKS_ERROR is known') or diag $SOCKS_ERROR;
		}
		
		my $res = Time::HiRes::time() - $start;
		ok($res < 1, "ready() not blocked") or diag "$res sec spent";
	}
}

while (%childs) {
	my $child = wait();
	is($?, 0, "Client $child finished successfully");
	delete $childs{$child};
}

done_testing();