1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
#!/usr/bin/perl
#
# prox.pl - copyright rfp 2001,2002
#
# This is a general proxy used to troubleshoot protocol problems. Really
# designed to handle HTTP and other ASCII single-connection protocols.
use IO::Socket;
use IO::Select;
$|++;
my $insocket = IO::Socket::INET->new(LocalPort => 81, Listen => 20,
Proto => 'tcp', Reuse => 1);
die $! unless $insocket;
my $readers = IO::Select->new() or die $!;
while(1){
my $incoming = $insocket->accept();
my $outgoing = IO::Socket::INET->new("localhost:80") or die $!;
$incoming->autoflush(1);
$outgoing->autoflush(1);
$readers->add($incoming);
$readers->add($outgoing);
$check=1;
while($check){
my @ready = $readers->can_read;
for my $handle (@ready){
my $data;
my $c = sysread($handle,$data,2048);
if($c > 0){
if($handle eq $incoming){
syswrite($outgoing,$data);
$dir = '>';
} else {
syswrite($incoming,$data);
$dir = '<';
}
$data=~s/\r/\[r\]/g;
$data=~s/\n/\[n\]\n/g;
print STDOUT $dir x 75, "\n", $data, "\n";
} else {
$incoming->close;
$outgoing->close;
print '<> closed ','<>'x32,"\n";
$check=0;
break;
}
}
}
$readers->remove($incoming);
$readers->remove($outgoing);
}
|
