Home: Need a Custom or Prewritten Perl Program?: I need a program that...:
debug webserver



itpp
New User

Oct 1, 2012, 7:10 AM


Views: 6315
debug webserver

Hello, I am trying to make a webserver(proxy) for debugging purposes, but nothing is getting dumped to disk.

What I want is a perl web server that passes everything back and forth between client and another webserver(proxy like) but also dumps all data to disk as well, while trying to modify some code the debug file is created but is not getting filled with data, anyone who can point out the obvious problem ?


Code
#!/usr/bin/perl 
#
# Peteris Krumins (peter@catonmat.net)
# http://www.catonmat.net -- good coders code, great reuse
#
#
# Written for the article "A TCP Proxy in Perl":
#
# http://catonmat.net/blog/perl-tcp-proxy
#

use warnings;
use strict;

use IO::Socket::INET;
use IO::Select;

my @allowed_ips = ('all', '10.10.10.5');
my $ioset = IO::Select->new;
my %socket_map;

my $debug = 1;

sub new_conn {
my ($host, $port) = @_;
return IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => $port
) || die "Unable to connect to $host:$port: $!";
}

sub new_server {
my ($host, $port) = @_;
my $server = IO::Socket::INET->new(
LocalAddr => $host,
LocalPort => $port,
ReuseAddr => 1,
Listen => 100
) || 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);

unless (client_allowed($client)) {
print "Connection from $client_ip denied.\n" if $debug;
$client->close;
return;
}
print "Connection from $client_ip 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 client_allowed {
my $client = shift;
my $client_ip = client_ip($client);
return grep { $_ eq $client_ip || $_ eq 'all' } @allowed_ips;
}

die "Usage: $0 <local port> <remote_host:remote_port>" unless @ARGV == 2;

my $local_port = shift;
my ($remote_host, $remote_port) = split ':', shift();


print "Starting a server on 0.0.0.0:$local_port\n";
my $server = new_server('0.0.0.0', $local_port);
$ioset->add($server);

open ( UPLOADFILE, ">>debug" ) or die "$!";
binmode UPLOADFILE;

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, 4096);
if ($read) {
print UPLOADFILE ($read);
$remote->syswrite($buffer);
}
else {
close_connection($socket);
}
}
}
}

close UPLOADFILE;



itpp
New User

Oct 1, 2012, 12:55 PM


Views: 6310
Re: [itpp] debug webserver

Found it, all open/write/close needs to be inside the "if ($read) {" sequence, if a open is done outside somehow the write handle gets nuked. So now I got debug info I need to figure out whats going on...