S3.Blog

Socks-сервер - для его создания нам понадобятся две библиотеки из cpan: IO::Select и IO::Socket::Socks. Первая для обмена информацией между соединяемым хостом, вторая, собственно, для создания socks-сервера и socks-клиента. Для создания Socks-клиента достаточно прочитать документацию на cpan и посмотреть пример - там все более-менее расписано, а вот описание socks-сервера обделено вниманием. К счастью, в каталоге автора IO::Socket::Socks есть пример создания ( subs.pm ), его то мы и возьмем за основу, слегка допилив напильником и обеспечив многозадачностью (многоклиентовостью, если хотите :) )

Socks-сервер

Далее только сухой код и ничего более, но думаю что эти несчастные 100 строк кода будут понятны всем :)
PS: сервер у нас с авторизацией, логин 'foo', пароль 'bar'

#!/usr/bin/perl -w
use strict;
use threads;
use IO::Select;
use IO::Socket::Socks;

#-------------------------------------------------------------------------------
#-- тут указываем IP и PORT нашего сервера
#-------------------------------------------------------------------------------
my $server_ip = '__my.server.ip__';
my $server_port = '__my.server.port__';

#-------------------------------------------------------------------------------
#-- создаем сервер
#-------------------------------------------------------------------------------
my $server = set_server($server_ip, $server_port);
my $selector = IO::Select->new($server);

#-------------------------------------------------------------------------------
#-- ожидаем подключения к серверу пользователя
#-------------------------------------------------------------------------------
while (my $cc = $selector->can_read) {
	check_threads();
	threads->new(\&set_client, $server);
}
exit 0;


#-------------------------------------------------------------------------------
sub set_server {
	my $server_ip = shift;
	my $server_port = shift;

	my $server = new IO::Socket::Socks(
		ProxyAddr	=> $server_ip,
		ProxyPort	=> $server_port,
		Listen		=> 1,
		UserAuth	=> \&server_auth,
		RequireAuth	=> 1,
		Timeout		=> 10,
	);

	unless ($server) {
		warn 'ERROR: Can not bind to ' . $server_ip . ':' . $server_port;
		exit(0);
	}

	return $server;
}
#-------------------------------------------------------------------------------
sub server_auth {
	my $user = shift;
	my $pass = shift;

	return 1 if (($user eq "foo") && ($pass eq "bar"));
	return 0;
}
#-------------------------------------------------------------------------------
sub check_threads {
	my @threads_list = threads->list();
	foreach my $t (@threads_list) {
		unless ($t->is_running()) {
			$t->join();
			undef($t);
		}
	}
	return 1;
}
#-------------------------------------------------------------------------------
sub set_client {
	my $server = shift;

	my $client = $server->accept;
	return unless $client;

	#---------------------------------------------------------------------------
	my ($command, $host, $port) = @{$client->command()};
	#---------------------------------------------------------------------------
	if ($command && ($command == 1)) {
		my $socks = IO::Socket::INET->new(PeerHost => $host, PeerPort =>$port , Timeout => 10);
		unless ($socks) {
			$client->close();
			return 1;
		}

		warn 'client_IP=' . $client->peerhost() . '; host=' . $host . '; port: ' . $port;
		#-----------------------------------------------------------------------
		$client->command_reply(0, $socks->sockhost, $socks->sockport);
		my $selector = IO::Select->new($socks, $client);
		my $ok = 1;

		#-----------------------------------------------------------------------
		while($ok) {
			my @ready = $selector->can_read();
			foreach my $s (@ready) {
				my $data;
				$s->recv($data, 4096);

				#---------------------------------------------------------------
				unless($data) {
					$selector->remove($socks);
					$socks->close();
					$ok = 0;
					last;
				}

				#---------------------------------------------------------------
				if($s == $socks) {
					$client->send($data);
				} else {
					$socks->send($data);
				}
			}
		}

		#-----------------------------------------------------------------------
		$selector->remove($client);
	}

	#---------------------------------------------------------------------------
	$client->close();
	return 1;
}
#-------------------------------------------------------------------------------

Копируем выше приведенный код, сохраняем в файл, запускаем, радуемся нашему сокс-серверу.

Socks-прокси

А теперь не хитрым движением пальцев рук делаем фокус:

убираем эту строку:

my $socks = IO::Socket::INET->new(PeerHost => $host, PeerPort =>$port , Timeout => 10);

и вместо нее вставляем эту:

my $socks = new IO::Socket::Socks(ProxyAddr => '__socks_ip__', ProxyPort => '__socks_port__', ConnectAddr => $host, ConnectPort => $port, Timeout => 10);

где вместо __socks_ip__ и __socks_port__ вписываем адрес и порт реального сокс-сервера, с которого будем получать данные

Вот и вся премудрость, спасибо всем, кому это хоть чуть-чуть пригодилось :)

---
PS: для работы с соксами на windows рекомендую простую утилиту, которую можно взять тут: http://www.proxifier.com/