mattaustin
asked on
Perl Proxy
I want to create a program that runs kind of as a proxy and lets everything through, unless it is a specific url if it matches that url it redirrects it to a diffrent one.
http://url1.com redirrects to http://url2.com
Anyone have a really good exapmle ill raise porints to 500
http://url1.com redirrects to http://url2.com
Anyone have a really good exapmle ill raise porints to 500
#!/usr/bin/perl -w
use strict;
use HTTP::Daemon;
use HTTP::Headers;
use LWP::UserAgent;
use URI;
use URI::Escape;
use POSIX ":sys_wait_h";
use Errno qw(EINTR EAGAIN);
my $serv = HTTP::Daemon->new( LocalPort => 3128 ) or
die "Can't start server: $@";
$| = 1;
sub REAPER {
1 while waitpid(-1, WNOHANG) > 0;
$SIG{CHLD} = \&REAPER;
}
$SIG{CHLD} = \&REAPER;
my $ua = LWP::UserAgent->new;
while (1) {
my $conn = $serv->accept;
unless ($conn) {
next if $!{EINTR} || $!{EAGAIN} || $!{ECHILD};
die "Can't accept: $!";
}
$conn->close, next if fork();
$SIG{PIPE} = 'IGNORE';
alarm(60);
while (my $request = $conn->get_request) {
alarm(3600);
$ua->agent($request->heade
'Mozilla 4.61 [en] (i586, Linux)');
my $pcon = $request->header('Proxy-Co
$request->remove_header('P
if ($request->uri()->as_strin
$request->uri('http://url2.com' . ($1 || ''));
}
my $resp = $ua->simple_request($reque
$resp->header('Proxy-Conne
($pcon =~ /keep-alive/ ? $pcon : 'Closed'));
$conn->send_response($resp
alarm(60);
last unless $pcon =~ /keep-alive/i;
}
$conn->close;
exit;
}
use strict;
use HTTP::Daemon;
use HTTP::Headers;
use LWP::UserAgent;
use URI;
use URI::Escape;
use POSIX ":sys_wait_h";
use Errno qw(EINTR EAGAIN);
my $serv = HTTP::Daemon->new( LocalPort => 3128 ) or
die "Can't start server: $@";
$| = 1;
sub REAPER {
1 while waitpid(-1, WNOHANG) > 0;
$SIG{CHLD} = \&REAPER;
}
$SIG{CHLD} = \&REAPER;
my $ua = LWP::UserAgent->new;
while (1) {
my $conn = $serv->accept;
unless ($conn) {
next if $!{EINTR} || $!{EAGAIN} || $!{ECHILD};
die "Can't accept: $!";
}
$conn->close, next if fork();
$SIG{PIPE} = 'IGNORE';
alarm(60);
while (my $request = $conn->get_request) {
alarm(3600);
$ua->agent($request->heade
'Mozilla 4.61 [en] (i586, Linux)');
my $pcon = $request->header('Proxy-Co
$request->remove_header('P
if ($request->uri()->as_strin
$request->uri('http://url2.com' . ($1 || ''));
}
my $resp = $ua->simple_request($reque
$resp->header('Proxy-Conne
($pcon =~ /keep-alive/ ? $pcon : 'Closed'));
$conn->send_response($resp
alarm(60);
last unless $pcon =~ /keep-alive/i;
}
$conn->close;
exit;
}
ASKER
thnaks for the quick reply, but for some reason the page just sets there and never loads, any ideas?
Did you configure proxy settings in your browser to address/port of running "proxy"?
ASKER
yes...thats y the page the page just sets there and never loads...other wise the problem would be everything loads normal.
ASKER
found code that works if someone could edit it to do the relpace:
#!/usr/usc/perl/5.004/bin/
#-------------------------
#-- proxy.pl - A simple http proxy server. --
#-- --
#-- To run, type proxy.pl [port-number] at the shell prompt. --
#-- Default port number is 5364. --
#-- --
#-------------------------
use Socket;
srand (time||$$);
#--- Define a friendly exit handler
$SIG{'KILL'} = $SIG{QUIT} = $SIG{INT} = 'exit_handler';
sub exit_handler {
print "\n\n --- Proxy server is dying ...\n\n";
close(SOCKET);
exit;
}
#--- Setup socket
$| = 1;
$proxy_port = shift(@ARGV);
$proxy_port = 5364 unless $proxy_port =~ /\d+/;
$socket_format = 'S n a4 x8';
&listen_to_port(SOCKET, $proxy_port);
$local_host = `hostname`;
chop($local_host);
$local_host_ip = (gethostbyname($local_host
print " --- Proxy server running on $local_host port: $proxy_port \n\n";
#--- Loop forever taking requests as they come
while (1) {
#--- Wait for request
print " --- Waiting to be of service ...\n";
($addr = accept(CHILD,SOCKET)) || die "accept $!";
($port,$inetaddr) = (unpack($socket_format,$ad
@inetaddr = unpack('C4',$inetaddr);
print "Connection from ", join(".", @inetaddr), " port: $port \n";
#--- Fork a subprocess to handle request.
#--- Parent proces continues listening.
if (fork) {
wait; # For now we wait for the child to finish
next; # We wait so that printouts don't mix
}
#--- Read first line of request and analyze it.
#--- Return and edited version of the first line and the request method.
($first,$method) = &analyze_request;
#--- Send request to remote host
print URL $first;
print $first;
while (<CHILD>) {
print $_;
next if (/Proxy-Connection:/);
print URL $_;
last if ($_ =~ /^[\s\x00]*$/);
}
if ($method eq "POST") {
$data = <CHILD>;
print $data;
print URL $data;
}
print URL "\n";
#--- Wait for response and transfer it to requestor.
print " --- Done sending. Response: \n\n";
$header = 1;
$text = 0;
while (<URL>) {
print CHILD $_;
if ($header || $text) { # Only print header & text lines to STDOUT
print $_;
if ($header && $_ =~ /^[\s\x00]*$/) {
$header = 0;
}
# if ($header && $_ =~ /^Content-type: text/) {
# $text = 1;
# }
}
}
close(URL);
close(CHILD);
exit; # Exit from child process
}
#-------------------------
#-- analyze_request --
#-- --
#-- Analyze a new request. First read in first line of request. --
#-- Read URL from it, process URL and open connection. --
#-- Return an edited version of the first line and the request --
#-- method. --
#-------------------------
sub analyze_request {
#--- Read first line of HTTP request
$first = <CHILD>;
$url = ($first =~ m|(http://\S+)|)[0];
print "Request for URL: $url \n";
#--- Check if first line is of the form GET http://host-name ...
($method, $remote_host, $remote_port) =
($first =~ m!(GET|POST|HEAD) http://([^/:]+):?(\d*)! );
#--- If not, bad request.
if (!$remote_host) {
print $first;
while (<CHILD>) {
print $_;
last if ($_ =~ /^[\s\x00]*$/);
}
print "Invalid HTTP request from ", join(".", @inetaddr), "\n";
# print CHILD "Content-type: text/plain","\n\n";
print CHILD "I don't understand your request.\n";
close(CHILD);
exit;
}
#--- If requested URL is the proxy server then ignore request
$remote_ip = (gethostbyname($remote_hos
if (($remote_ip eq $local_host_ip) && ($remote_port eq $proxy_port)) {
print $first;
while (<CHILD>) {
print $_;
last if ($_ =~ /^[\s\x00]*$/);
}
print " --- Connection to proxy server ignored.\n";
# print CHILD "Content-type: text/plain","\n\n";
print CHILD "It's not nice to make me loop on myself!.\n";
close(CHILD);
exit;
}
#--- Setup connection to target host and send request
$remote_port = "http" unless ($remote_port);
&open_connection(URL, $remote_host, $remote_port);
#--- Remove remote hostname from URL
$first =~ s/http:\/\/[^\/]+//;
($first, $method);
}
#-------------------------
#-- listen_to_port(SOCKET, $port) --
#-- --
#-- Create a socket that listens to a specific port --
#-------------------------
sub listen_to_port {
local ($port) = $_[1];
local ($socket_format, $proto, $packed_port, $cur, $max_requests);
$max_requests = 3; # Max number of outstanding requests
$socket_format = 'S n a4 x8';
$proto = (getprotobyname('tcp'))[2]
$packed_port = pack($socket_format, &AF_INET, $port, "\0\0\0\0");
socket($_[0], &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind($_[0], $packed_port) || die "bind: $!";
listen($_[0], $max_requests) || die "listen: $!";
$cur = select($_[0]);
$| = 1; # Disable buffering on socket.
select($cur);
}
#-------------------------
#-- open_connection(SOCKET, $remote_hostname, $port) --
#-- --
#-- Create a socket that connects to a certain host --
#-- $local_host_ip is assumed to be local hostname IP address --
#-------------------------
sub open_connection {
local ($remote_hostname, $port) = @_[1,2];
local ($socket_format, $proto, $packed_port, $cur);
local ($remote_addr, @remote_ip, $remote_ip);
local ($local_port, $remote_port);
if ($port !~ /^\d+$/) {
$port = (getservbyname($port, "tcp"))[2];
$port = 80 unless ($port);
}
$proto = (getprotobyname('tcp'))[2]
$remote_addr = (gethostbyname($remote_hos
if (!$remote_addr) {
die "Unknown host: $remote_hostname";
}
@remote_ip = unpack("C4", $remote_addr);
$remote_ip = join(".", @remote_ip);
print "Connecting to $remote_ip port $port.\n\n";
$socket_format = 'S n a4 x8';
$local_port = pack($socket_format, &AF_INET, 0, $local_host_ip);
$remote_port = pack($socket_format, &AF_INET, $port, $remote_addr);
socket($_[0], &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind($_[0], $local_port) || die "bind: $!";
connect($_[0], $remote_port) || die "socket: $!";
$cur = select($_[0]);
$| = 1; # Disable buffering on socket.
select($cur);
}
#!/usr/usc/perl/5.004/bin/
#-------------------------
#-- proxy.pl - A simple http proxy server. --
#-- --
#-- To run, type proxy.pl [port-number] at the shell prompt. --
#-- Default port number is 5364. --
#-- --
#-------------------------
use Socket;
srand (time||$$);
#--- Define a friendly exit handler
$SIG{'KILL'} = $SIG{QUIT} = $SIG{INT} = 'exit_handler';
sub exit_handler {
print "\n\n --- Proxy server is dying ...\n\n";
close(SOCKET);
exit;
}
#--- Setup socket
$| = 1;
$proxy_port = shift(@ARGV);
$proxy_port = 5364 unless $proxy_port =~ /\d+/;
$socket_format = 'S n a4 x8';
&listen_to_port(SOCKET, $proxy_port);
$local_host = `hostname`;
chop($local_host);
$local_host_ip = (gethostbyname($local_host
print " --- Proxy server running on $local_host port: $proxy_port \n\n";
#--- Loop forever taking requests as they come
while (1) {
#--- Wait for request
print " --- Waiting to be of service ...\n";
($addr = accept(CHILD,SOCKET)) || die "accept $!";
($port,$inetaddr) = (unpack($socket_format,$ad
@inetaddr = unpack('C4',$inetaddr);
print "Connection from ", join(".", @inetaddr), " port: $port \n";
#--- Fork a subprocess to handle request.
#--- Parent proces continues listening.
if (fork) {
wait; # For now we wait for the child to finish
next; # We wait so that printouts don't mix
}
#--- Read first line of request and analyze it.
#--- Return and edited version of the first line and the request method.
($first,$method) = &analyze_request;
#--- Send request to remote host
print URL $first;
print $first;
while (<CHILD>) {
print $_;
next if (/Proxy-Connection:/);
print URL $_;
last if ($_ =~ /^[\s\x00]*$/);
}
if ($method eq "POST") {
$data = <CHILD>;
print $data;
print URL $data;
}
print URL "\n";
#--- Wait for response and transfer it to requestor.
print " --- Done sending. Response: \n\n";
$header = 1;
$text = 0;
while (<URL>) {
print CHILD $_;
if ($header || $text) { # Only print header & text lines to STDOUT
print $_;
if ($header && $_ =~ /^[\s\x00]*$/) {
$header = 0;
}
# if ($header && $_ =~ /^Content-type: text/) {
# $text = 1;
# }
}
}
close(URL);
close(CHILD);
exit; # Exit from child process
}
#-------------------------
#-- analyze_request --
#-- --
#-- Analyze a new request. First read in first line of request. --
#-- Read URL from it, process URL and open connection. --
#-- Return an edited version of the first line and the request --
#-- method. --
#-------------------------
sub analyze_request {
#--- Read first line of HTTP request
$first = <CHILD>;
$url = ($first =~ m|(http://\S+)|)[0];
print "Request for URL: $url \n";
#--- Check if first line is of the form GET http://host-name ...
($method, $remote_host, $remote_port) =
($first =~ m!(GET|POST|HEAD) http://([^/:]+):?(\d*)! );
#--- If not, bad request.
if (!$remote_host) {
print $first;
while (<CHILD>) {
print $_;
last if ($_ =~ /^[\s\x00]*$/);
}
print "Invalid HTTP request from ", join(".", @inetaddr), "\n";
# print CHILD "Content-type: text/plain","\n\n";
print CHILD "I don't understand your request.\n";
close(CHILD);
exit;
}
#--- If requested URL is the proxy server then ignore request
$remote_ip = (gethostbyname($remote_hos
if (($remote_ip eq $local_host_ip) && ($remote_port eq $proxy_port)) {
print $first;
while (<CHILD>) {
print $_;
last if ($_ =~ /^[\s\x00]*$/);
}
print " --- Connection to proxy server ignored.\n";
# print CHILD "Content-type: text/plain","\n\n";
print CHILD "It's not nice to make me loop on myself!.\n";
close(CHILD);
exit;
}
#--- Setup connection to target host and send request
$remote_port = "http" unless ($remote_port);
&open_connection(URL, $remote_host, $remote_port);
#--- Remove remote hostname from URL
$first =~ s/http:\/\/[^\/]+//;
($first, $method);
}
#-------------------------
#-- listen_to_port(SOCKET, $port) --
#-- --
#-- Create a socket that listens to a specific port --
#-------------------------
sub listen_to_port {
local ($port) = $_[1];
local ($socket_format, $proto, $packed_port, $cur, $max_requests);
$max_requests = 3; # Max number of outstanding requests
$socket_format = 'S n a4 x8';
$proto = (getprotobyname('tcp'))[2]
$packed_port = pack($socket_format, &AF_INET, $port, "\0\0\0\0");
socket($_[0], &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind($_[0], $packed_port) || die "bind: $!";
listen($_[0], $max_requests) || die "listen: $!";
$cur = select($_[0]);
$| = 1; # Disable buffering on socket.
select($cur);
}
#-------------------------
#-- open_connection(SOCKET, $remote_hostname, $port) --
#-- --
#-- Create a socket that connects to a certain host --
#-- $local_host_ip is assumed to be local hostname IP address --
#-------------------------
sub open_connection {
local ($remote_hostname, $port) = @_[1,2];
local ($socket_format, $proto, $packed_port, $cur);
local ($remote_addr, @remote_ip, $remote_ip);
local ($local_port, $remote_port);
if ($port !~ /^\d+$/) {
$port = (getservbyname($port, "tcp"))[2];
$port = 80 unless ($port);
}
$proto = (getprotobyname('tcp'))[2]
$remote_addr = (gethostbyname($remote_hos
if (!$remote_addr) {
die "Unknown host: $remote_hostname";
}
@remote_ip = unpack("C4", $remote_addr);
$remote_ip = join(".", @remote_ip);
print "Connecting to $remote_ip port $port.\n\n";
$socket_format = 'S n a4 x8';
$local_port = pack($socket_format, &AF_INET, 0, $local_host_ip);
$remote_port = pack($socket_format, &AF_INET, $port, $remote_addr);
socket($_[0], &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind($_[0], $local_port) || die "bind: $!";
connect($_[0], $remote_port) || die "socket: $!";
$cur = select($_[0]);
$| = 1; # Disable buffering on socket.
select($cur);
}
ASKER
accually htta code may not work because t dosn't all other ports to pass...?
ASKER
but if anyone could help edit it to work with the replace i think i can solve the rest
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
One last thing it needs to support https....
ASKER
I would like to use mshttps to support the https (sorry for so many posts);
> found code that works if someone could edit it to do the relpace
not me. I wouldn't like to rummage in such scrap.
not me. I wouldn't like to rummage in such scrap.
ASKER
Sapa i want to use your code, but i dont know why its not working for me... any help?
I run it, set it up in IE to use proxy, set the port but after that no pages load they wait for a long time then time out...:(
I run it, set it up in IE to use proxy, set the port but after that no pages load they wait for a long time then time out...:(
ASKER
can i use HTTP::Proxy to do this?
There is hardcoded port number 3128. You have set it, right?
Also you can try to change line:
my $pcon = $request->header('Proxy-Co
to
my $pcon = "Close";
as failsafe solution.
Also you can try to change line:
my $pcon = $request->header('Proxy-Co
to
my $pcon = "Close";
as failsafe solution.
ASKER
Yes i am setting the port but still not working neather is the " failsafe solution"
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Another possible option that supports both http and https is this cgi proxy:
http://www.jmarshall.com/tools/cgiproxy/
http://www.jmarshall.com/tools/cgiproxy/
Nothing has happened on this question in more than 8 weeks. It's time for cleanup!
My recommendation, which I will post in the Cleanup topic area, is to
split points [grade B] between Sapa [350 pts] and pjedmond [150 pts] (abandoned, asker hasn't received needed handholding).
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
jmcg
EE Cleanup Volunteer
My recommendation, which I will post in the Cleanup topic area, is to
split points [grade B] between Sapa [350 pts] and pjedmond [150 pts] (abandoned, asker hasn't received needed handholding).
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
jmcg
EE Cleanup Volunteer
ASKER
No response has served me enough for 500 points or a split of the points (maby there is a lack of experts for sufficent handholding)
Matt,
If you're not satisfied with the answers you're getting, you have to respond and engage the experts. Challenge them to come up with a solution that actually works for you. It does no good at all to leave the question sitting here. We cleanup volunteers examine these abandoned questions and make our best judgement about whether the offered solution really should be considered a solution...but you, as the asker, are in a much better position than we are to know if your problem has been solved.
What you can do at this point is post a 0-point question in Community Support asking that this question be closed. It would probably be best to PAQ it rather than delete it. Your points will be refunded. You can then ask it again, or rather ask a new question that outlines what you need in a way that will avoid what happened on this question.
If you're not satisfied with the answers you're getting, you have to respond and engage the experts. Challenge them to come up with a solution that actually works for you. It does no good at all to leave the question sitting here. We cleanup volunteers examine these abandoned questions and make our best judgement about whether the offered solution really should be considered a solution...but you, as the asker, are in a much better position than we are to know if your problem has been solved.
What you can do at this point is post a 0-point question in Community Support asking that this question be closed. It would probably be best to PAQ it rather than delete it. Your points will be refunded. You can then ask it again, or rather ask a new question that outlines what you need in a way that will avoid what happened on this question.
Yay! I tried to create a PERL proxy too, but I could never get past the problem of multiple connections so I switched to VB instead...
http://www.scn.org/~bq479/proxy.pl
There's one version of my program... I haven't checked on it in about 1 month and can't remember which version it is. It doesn't use any modules except for Socket and works (or worked) on a webserver a little bit, but was slow and didn't handle multiple connections. This version may be the one that uses "fork()"... I read in one book (PERL Networking or something) about various ways to handle multiple connections. One of the simplest uses fork to open child processes but that's not healthy for memory. The book had a few other solutions to multiple connection problems so I'd recommend it.
http://www.scn.org/~bq479/proxy.pl
There's one version of my program... I haven't checked on it in about 1 month and can't remember which version it is. It doesn't use any modules except for Socket and works (or worked) on a webserver a little bit, but was slow and didn't handle multiple connections. This version may be the one that uses "fork()"... I read in one book (PERL Networking or something) about various ways to handle multiple connections. One of the simplest uses fork to open child processes but that's not healthy for memory. The book had a few other solutions to multiple connection problems so I'd recommend it.
ASKER