Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1230
  • Last Modified:

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
0
mattaustin
Asked:
mattaustin
  • 12
  • 5
  • 2
  • +2
2 Solutions
 
mattaustinAuthor Commented:
btw need to let all other ports work as normal
0
 
SapaCommented:
#!/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->header('User-Agent') ||
                'Mozilla 4.61 [en] (i586, Linux)');

        my $pcon = $request->header('Proxy-Connection') || 'Close';
        $request->remove_header('Proxy-Connection');

        if ($request->uri()->as_string =~ m|^http://url1\.com([:/?].*)?$|i) {
            $request->uri('http://url2.com' . ($1 || ''));
        }

        my $resp = $ua->simple_request($request);

        $resp->header('Proxy-Connection' =>
                ($pcon =~ /keep-alive/ ? $pcon : 'Closed'));
        $conn->send_response($resp);

        alarm(60);
        last unless $pcon =~ /keep-alive/i;
    }
    $conn->close;
    exit;
}

0
 
mattaustinAuthor Commented:
thnaks for the quick reply, but for some reason the page just sets there and never loads, any ideas?
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
SapaCommented:
Did you configure proxy settings in your browser to address/port of running "proxy"?
0
 
mattaustinAuthor Commented:
yes...thats y the page the page just sets there and never loads...other wise the problem would be everything loads normal.
0
 
mattaustinAuthor Commented:
found code that works if someone could edit it to do the relpace:
#!/usr/usc/perl/5.004/bin/perl
#-------------------------------------------------------------------------
#--        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))[4];
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,$addr))[1,2];
    @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_host))[4];
    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_hostname))[4];
    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);
}
0
 
mattaustinAuthor Commented:
accually htta code may not work because t dosn't all other ports to pass...?
0
 
mattaustinAuthor Commented:
but if anyone could help edit it to work with the replace i think i can solve the rest
0
 
SapaCommented:
Try to use external redirection:

-----------------------------------------------------------------------------------------
#!/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->header('User-Agent') ||
                'Mozilla 4.61 [en] (i586, Linux)');

        my $pcon = $request->header('Proxy-Connection') || 'Close';
        $request->remove_header('Proxy-Connection');

        my $resp;
        if ($request->uri()->as_string =~ m|^http://url1\.com([:/?].*)?$|i) {
            my $newurl = 'http://url2.com' . ($1 || '');
            $resp = HTTP::Response->new(302 => 'Found');
            $resp->header('Location' => $newurl);
        } else {
                $resp = $ua->simple_request($request);
        }

        $resp->header('Proxy-Connection' =>
                ($pcon =~ /keep-alive/ ? $pcon : 'Closed'));
        $conn->send_response($resp);

        alarm(60);
        last unless $pcon =~ /keep-alive/i;
    }
    $conn->close;
    exit;
}

0
 
mattaustinAuthor Commented:
One last thing it needs to support https....
0
 
mattaustinAuthor Commented:
I would like to use mshttps to support the https (sorry for so many posts);
0
 
SapaCommented:
> found code that works if someone could edit it to do the relpace
not me. I wouldn't like to rummage in such scrap.
0
 
mattaustinAuthor Commented:
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...:(
0
 
mattaustinAuthor Commented:
can i use HTTP::Proxy to do this?
0
 
SapaCommented:
There is hardcoded port number 3128. You have set it, right?

Also you can try to change line:

my $pcon = $request->header('Proxy-Connection') || 'Close';

to

my $pcon = "Close";

as failsafe solution.
0
 
mattaustinAuthor Commented:
Yes i am setting the port but still not working neather is the " failsafe solution"
0
 
pjedmondCommented:
Have a look here:

http://www.piersharding.com/blog/2002/09/

Has a link to a proxy that supports both http and https:

http://www.piersharding.com/download/proxy.pl
0
 
pjedmondCommented:
Another possible option that supports both http and https is this cgi proxy:

http://www.jmarshall.com/tools/cgiproxy/
0
 
jmcgOwnerCommented:
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
0
 
mattaustinAuthor Commented:
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)
0
 
jmcgOwnerCommented:
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.

0
 
happispiderCommented:
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.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 12
  • 5
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now