Solved

Perl Proxy

Posted on 2003-11-11
22
1,217 Views
Last Modified: 2007-12-19
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
Comment
Question by:mattaustin
  • 12
  • 5
  • 2
  • +2
22 Comments
 
LVL 2

Author Comment

by:mattaustin
ID: 9720851
btw need to let all other ports work as normal
0
 
LVL 5

Expert Comment

by:Sapa
ID: 9722285
#!/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
 
LVL 2

Author Comment

by:mattaustin
ID: 9723054
thnaks for the quick reply, but for some reason the page just sets there and never loads, any ideas?
0
 
LVL 5

Expert Comment

by:Sapa
ID: 9723790
Did you configure proxy settings in your browser to address/port of running "proxy"?
0
 
LVL 2

Author Comment

by:mattaustin
ID: 9724071
yes...thats y the page the page just sets there and never loads...other wise the problem would be everything loads normal.
0
 
LVL 2

Author Comment

by:mattaustin
ID: 9724151
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
 
LVL 2

Author Comment

by:mattaustin
ID: 9724190
accually htta code may not work because t dosn't all other ports to pass...?
0
 
LVL 2

Author Comment

by:mattaustin
ID: 9724201
but if anyone could help edit it to work with the replace i think i can solve the rest
0
 
LVL 5

Accepted Solution

by:
Sapa earned 350 total points
ID: 9724202
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
 
LVL 2

Author Comment

by:mattaustin
ID: 9724215
One last thing it needs to support https....
0
 
LVL 2

Author Comment

by:mattaustin
ID: 9724250
I would like to use mshttps to support the https (sorry for so many posts);
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 5

Expert Comment

by:Sapa
ID: 9724263
> 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
 
LVL 2

Author Comment

by:mattaustin
ID: 9724402
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
 
LVL 2

Author Comment

by:mattaustin
ID: 9724539
can i use HTTP::Proxy to do this?
0
 
LVL 5

Expert Comment

by:Sapa
ID: 9724545
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
 
LVL 2

Author Comment

by:mattaustin
ID: 9724604
Yes i am setting the port but still not working neather is the " failsafe solution"
0
 
LVL 22

Assisted Solution

by:pjedmond
pjedmond earned 150 total points
ID: 9727666
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
 
LVL 22

Expert Comment

by:pjedmond
ID: 9727683
Another possible option that supports both http and https is this cgi proxy:

http://www.jmarshall.com/tools/cgiproxy/
0
 
LVL 20

Expert Comment

by:jmcg
ID: 10089873
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
 
LVL 2

Author Comment

by:mattaustin
ID: 10098259
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
 
LVL 20

Expert Comment

by:jmcg
ID: 10101693
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
 
LVL 2

Expert Comment

by:happispider
ID: 10348431
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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
perl script help 5 230
hard perl script 16 146
Perl script to parse xml file 2 96
Using Perl DBI to query oracle 3 30
Email validation in proper way is  very important validation required in any web pages. This code is self explainable except that Regular Expression which I used for pattern matching. I originally published as a thread on my website : http://www…
A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
This video discusses moving either the default database or any database to a new volume.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now