Hi guys! How are you doing? I'm pretty new to perl, so i really need some help/direction here. I'm working in a TCP Proxy to handle MSSQL packets with some filtering, like, i don't want people droping, updating or inserting into tables even if they has SQL permissions to do. So i grab some parts of Peteris Krumins TCP Proxy and added my blocking needs. Simply put, it's working perfectly! But in some tests I realized that if more than ~ 30 clients connect simultaneously, something goes wrong! I need a drive to know what to do .. the server will receive more than 100 simultaneous connections, so how can optimize this code for this?
#!/usr/bin/perl package PerlSvc; use warnings; use strict; #nome do servico e display name #$PerlSvc::Name = 'Proxy'; #$PerlSvc::DisplayName = 'SQL Proxy'; use IO::Socket::INET; use IO::Select; use File::Slurp; #sub PerlSvc::Startup(){ #while (ContinueRun()) { our @allowed_ips = ('all', '127.0.0.1'); our @hostwhitelist = read_file("C:\\proxy\\HostsWhitelist.txt", chomp => 1); our @payloadblacklist = read_file("C:\\proxy\\PayloadBlacklist.txt", chomp => 1); our @payloadwhitelist = read_file("C:\\proxy\\PayloadWhitelist.txt", chomp => 1); #sub Pause { } #sub Continue { } #sub Interactive { } #sub Help { } #sub Stop { } our $ioset = IO::Select->new; our %socket_map; my $debug = 1; local $| = 1; sub new_conn { #my ($host, $port) = @_; my $host = "127.0.0.1"; my $port = "1434"; return IO::Socket::INET->new( PeerAddr => $host, PeerPort => $port ) || die "Unable to connect to $host:$port: $!"; } sub new_server { #my ($host, $port) = @_; my $host = ""; my $port = "1433"; my $server = IO::Socket::INET->new( LocalAddr => $host, LocalPort => $port, ReuseAddr => 1, Listen => 9999 ) || die "Unable to listen on $host:$port: $!"; } sub new_connection { my $server = shift; my $remote_host = shift; my $remote_port = shift; my $client = $server->accept; my $client_ip = client_ip($client); my $peerip = $server->peerhost(); my $ip_peer = $client->peerhost; unless (client_allowed($ip_peer)) { #print "Connection from $ip_peer denied.\n" if $debug; $client->close; return; } #print "Connection from $ip_peer accepted.\n" if $debug; my $remote = new_conn($remote_host, $remote_port); $ioset->add($client); $ioset->add($remote); $socket_map{$client} = $remote; $socket_map{$remote} = $client; } sub close_connection { my $client = shift; my $client_ip = client_ip($client); my $remote = $socket_map{$client}; $ioset->remove($client); $ioset->remove($remote); delete $socket_map{$client}; delete $socket_map{$remote}; $client->close; $remote->close; #print "Connection from $client_ip closed.\n" if $debug; } sub client_ip { my $client = shift; return inet_ntoa($client->sockaddr); } sub liberado { my $client_ip = shift; return grep { $_ eq $client_ip } @hostwhitelist; } sub client_allowed { my $client_ip = shift; return grep { $_ eq $client_ip || $_ eq 'all' } @allowed_ips; } #die "Usage: $0 <local port> <remote_host:remote_port>" unless @ARGV == 2; my $local_port = "1433"; #my ($remote_host, $remote_port) = split ':', shift(); my $remote_host = "127.0.0.1"; my $remote_port = "1434"; print "Starting proxy at localhost:$local_port\n"; my $server = new_server('0.0.0.0', $local_port); $ioset->add($server); #while (ContinueRun(1)) { while (1) { for my $socket ($ioset->can_read) { if ($socket == $server) { new_connection($server, $remote_host, $remote_port); } else { next unless exists $socket_map{$socket}; my $remote = $socket_map{$socket}; my $buffer; my $read = $socket->sysread($buffer, 10*1024); my $ip_client = $remote->peerhost; my $port_client = $remote->peerport; my $buffer_tmp = $buffer; my $ip_dests = $socket->peerhost; #my $ip_dests = $socket->sockhost; #print "-------------------------------------------------- +----------------\n"; #print "Log: IP_Client: $ip_client Remote_Host: $ip_dests +Port_client: $port_client: $buffer\n"; if (!liberado($ip_dests) && ($remote_port eq $port_client) + && ($ip_client eq $remote_host)) { #print "Buffer recebido de $ip_client na porta $por +t_client. Analisando...\n"; #print "O comando IP $ip_client deve ser filtrado.. +.\n"; foreach (@payloadblacklist) { #print "Blocking ($_)\n"; $buffer =~ s/$_/BLOCKED/gi; } } else { #print "Buffer recebido de $ip_client é liberado... +\n"; } #print "-------------------------------------------------- +----------------\n"; if ($read) { #print "Read...\n"; $remote->syswrite($buffer); } else { close_connection($socket); } } } } #} #} #close (log_file);
I really appreciate any help. Cheers!

In reply to Multithread/fork TCP Proxy? by epicvinny

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.