File: perlmonks.pl

package info (click to toggle)
libhttp-proxy-perl 0.304-5
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 720 kB
  • sloc: perl: 2,576; makefile: 4
file content (34 lines) | stat: -rwxr-xr-x 997 bytes parent folder | download | duplicates (9)
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
#!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::HeaderFilter::simple;
use strict;

# a very simple proxy
my $proxy = HTTP::Proxy->new(@ARGV);

# this filter redirects all requests to perlmonks.org
my $filter = HTTP::Proxy::HeaderFilter::simple->new(
    sub {
        my ( $self, $headers, $message ) = @_;

        # modify the host part of the request
        $self->proxy()->log( ERROR, "FOO", $message->uri() );
        $message->uri()->host('perlmonks.org');

        # create a new redirect response
        my $res = HTTP::Response->new(
            301,
            'Moved to perlmonks.org',
            [ Location => $message->uri() ]
        );

        # and make the proxy send it back to the client
        $self->proxy()->response($res);
    }
);

# put this filter on perlmonks.com and www.perlmonks.org
$proxy->push_filter( host => 'perlmonks.com',     request => $filter );
$proxy->push_filter( host => 'www.perlmonks.org', request => $filter );

$proxy->start();