Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

http wrapper

by dree (Monsignor)
on Apr 21, 2002 at 21:02 UTC ( #160927=sourcecode: print w/replies, xml ) Need Help??
Category: CGI Programming
Author/Contact Info dree <>
Description: This script is a wrapper (or a proxy) for HTTP. Briefly it allows to redirect to the browser the content of a site target, masking the true address of the target.
-------------------------- | site with HTTP wrapper | -------------------------- / \ / \ --------------- ------------------ | site target | | user's browser | --------------- ------------------

As an example, if the site target is www.mysite.suffix and the HTTP wrapper is installed on (<- notice the final slash) by calling this address, you are browsing the site target. If the site target has links and images indicated with *relative* addresses, the user will not be able to notice that the site target is masked by the wrapper. Of course, ALL will pass for the wrapper, that actually it browses the target page, returning the same page and the objects contained in this, to the user's browser. All that is obviously EXPENSIVE (in computational terms) for the site that executes the wrapper. Always, in presence of relative addresses, it works also with upload, form mail, etc :)))

# v0.9.0 by dree <>
# Copyleft: Nordest Perl Mongers (
# License: GPL (

use strict;
use CGI;
use LWP::UserAgent;
use HTTP::Request::Common;

my $q=new CGI;
my $ua = LWP::UserAgent->new;


my $target_base_address=q[http://www.mysite.suffix]; # site target


my $method;
my $content;
my $submit;
my $content_type;
my $target_remaining_address=$q->path_info();

# method acknowledgment


} elsif ($ENV{REQUEST_METHOD} eq 'GET') {


} elsif (index($target_remaining_address,'GET',0) > -1) {


} elsif (index($target_remaining_address,'POST',0) > -1) {


} else {


# management of images & other (if presents) on a *POST* request
if ($method eq 'POST') {

        my $other_remaining_on_POST=uc substr($target_remaining_addres

        if ($other_remaining_on_POST eq '.JS') {


        } else {

            $other_remaining_on_POST=uc substr($target_remaining_addre

            if (($other_remaining_on_POST eq '.GIF')
                or ($other_remaining_on_POST eq '.JPG')
                or ($other_remaining_on_POST eq '.PNG')
                or ($other_remaining_on_POST eq '.CSS')) {


            } else {

                $other_remaining_on_POST=uc substr($target_remaining_a

                if ($other_remaining_on_POST eq '.JPEG') {


my $target_full_address=$target_base_address.$target_remaining_address



if ($method eq 'POST') {

    foreach my $key ($q->param) {

        my $val=$q->param("$key");
                my $name_attach;
                my $tmpfilename;

        if (eval {$tmpfilename = $q->tmpFileName($val);}) {


            my $type = $q->uploadInfo($val)->{'Content-Type'};

            if (!$type) {


            $content.=qq{$key => ["$tmpfilename",'$name_attach',Conten

        } else {

            $content.=qq{$key => '$val',};

if ($method eq 'GET') {

    $submit=qq{GET '$target_full_address'};

} else {

    $submit=qq{POST '$target_full_address'};

    if ($method eq 'POST') {


    } elsif ($method eq 'POST-ATTACH') {


    if ($content) {


            Content_Type => '$content_type',
            Content => [$content]

my $ua_out=eval "\$ua->request($submit)";
my $result=${$ua_out}{'_content'};

if (${$ua_out}{'_rc'} eq '302') {

    my $location=${$ua_out}{'_headers'}{'location'};
        # eventually $location=~s#.+/(.+)#$1#;
    print "Location: $location\n\n";

no strict 'refs';

if (${$ua_out}{'_headers'}{'content-type'}[0]) {


} else {


print "Content-Type: $content_type\n\n";
print $result;


Replies are listed 'Best First'.
Re: http wrapper
by TheHobbit (Pilgrim) on Apr 21, 2002 at 21:21 UTC

    Good work.. However, you should add code to handle authentification requests. It should not be too hard to do and would raly be a good thing©.

    Leo TheHobbit
    -----BEGIN PERL GEEK CODE BLOCK----- Version: 0.01
    C*D >++S++X WP MO PP++n+CO-->+PO-oG
    ------END PERL GEEK CODE BLOCK------
Re: http wrapper
by yodabjorn (Monk) on May 04, 2002 at 10:16 UTC
    Nice piece of work.
    I would just like to point out that if you are using apache. Mod_Rewrite can do this verry easily. ( mod_rewrite is awsome if you don't know about it, and you run apache you should check it out!)

    As well SQUID is a proxy and can be setup as a reverse proxy easily.

    I know these aren't all ontopic about perl, but I feel both these projects should get mentioned if someone may hapen upon this in a search.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://160927]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2016-10-23 08:32 GMT
Find Nodes?
    Voting Booth?
    How many different varieties (color, size, etc) of socks do you have in your sock drawer?

    Results (300 votes). Check out past polls.