Модераторы: ginnie, korob2001
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> проблемы при разработке сетевых приложений, все хорошо, но... 
:(
    Опции темы
johny_s
Дата 14.12.2007, 00:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 3
Регистрация: 14.12.2007

Репутация: нет
Всего: нет



Всем здравствуйте!

Решил на днях написать свой небольшой многопоточный прокс. все вроде бы хорошо, прокс работает, иногда даже шустренько, но по непонятным мне причинам иногда завершает свою работу сам. я уже не знаю в чем дело... smile 
если кому не лень подскажите где ошибка, буду очень благодарен!
З.Ы. прокс тестировался на Виндовой платформе. 


#! c:\perl\bin\perl

use IO::Socket;
use POSIX ":sys_wait_h";
use URI;
use bytes;
use Getopt::Std;


getopts("ldh");


(my $localport = $ARGV[0]) if($ARGV[0]);
 my $quit = 1;
if(defined($opt_h))
{
print "Start like this: perl socks3.pl [options] port\n";
print "default port 1080";
print "-l enable logs\n";
print "-d enable logs in terminal\n";
print "-h this help";
exit;
}

$SIG{CHLD}=\&childkill;
$SIG{INT}=\&stop;
$SIG{PIPE} = 'IGNORE';
sub stop {undef $quit; }
sub childkill {
 while ((my $id = waitpid(-1,WHOHANG)) > 0) { } }


unless(fork()){
 my $server = IO::Socket::INET->new(LocalPort => $localport || 1080 ,
   Type      => SOCK_STREAM,
   Reuse     => 1,
   Listen    => 10) or die "Can`t listen port! $!";
   binmode $server;
   $server->autoflush();
   while($quit)
    {
      while($client=$server->accept())
       {
       my $method =   "";
          unless(fork())
          {
          $server->close();
          tunnel($client);
          exit;
          }}}}

sub tunnel {
 local $client = shift @_;
 $cli_ip = getip($client);
 my $request_size = 0;
 my $response_size = 0;
 my $method ="";
 binmode $client;





  while (my $data = $client->getline) {
    unless ($method) {
      ($method, $hostAddr, $httpVer) = gethost($data);
        my $uri = URI->new($hostAddr);

      $host = IO::Socket::INET->new (
        PeerAddr=> $uri->host,
        PeerPort=> $uri->port) or warn "couldn't open $hostAddr $!" unless(defined($host));
         if ($host) {
         binmode $host;
         print $host "$method ".$uri->path_query." $httpVer\n";}
         next;
    }
       my $current_request = bytes::length($data);
       $request_size += $current_request;
       my $debug1 = "To remote: current request: $hostAddr  $current_request bytes send";
       logging($debug1) if (defined($opt_l));
       if ($host) { syswrite($host,$data,1024);}
       last if $data =~ /^\s*$/ and $method ne 'POST';
       }
    if(defined($host)){
    while (my $host_line=$host->getline) {

    syswrite($client,$host_line,1024);
     my $current_response = bytes::length($host_line);
     $response_size+=$current_response;
     my $debug2 = "To client: $current_response bytes send to client $cli_ip";
     logging($debug2) if (defined($opt_l)) ;
  }     }
  my $split = "------------------------------------\n";
  logging($split) if (defined($opt_l));
  my $overwall1 = "total send to remote:$request_size\n";
  logging($overwall1) if (defined($opt_l));
  my $overwall2 = "total send to client:$response_size\n";
  logging($overwall2) if (defined($opt_l));
  logging($split);
  $client-> close if $client;
  $host-> close if $host;

  }

sub gethost {
my $browser = shift @_;
my ($method, $hostAddr, $httpVer) = $browser =~ /^(\w+) +(\S+) +(\S+)/;
my @request =($method,$hostAddr,$httpVer);
return @request;
}

sub getip{
my $remote = shift @_;
 my($prip)=getpeername($remote);
($port,$ipaddr)=unpack_sockaddr_in($prip);
$ipaddr= inet_ntoa($ipaddr);
return $ipaddr;
}

sub logging {
my $logs = shift @_;
if ($opt_d) {print "$logs\n";}
open(LOG,'>>c:\socks3.log') or die "$!";
print LOG "$logs\n";
close(LOG) or die "$!";
}
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl: Системное программирование"
korob2001
sharq
  • В этом разделе обсуждаются вопросы относящиеся только к системному программированию на Perl
  • Если ваш вопрос не относится к системному или CGI программированию, задавайте его в общем разделе
  • Если ваш вопрос относится к CGI программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", можно скачать здесь


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: Системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.0735 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.