1#!/usr/bin/perl -w
2use strict;
3use HTTP::Proxy;
4use HTTP::Proxy::HeaderFilter::simple;
5use HTTP::Proxy::BodyFilter::simple;
6use CGI::Util qw( unescape );
7
8# get the command-line parameters
9my %args = (
10   peek    => [],
11   header  => [],
12   mime    => 'text/*',
13);
14{
15    my $args = '(' . join( '|', keys %args ) . ')';
16    for ( my $i = 0 ; $i < @ARGV ; $i += 2 ) {
17        if ( $ARGV[$i] =~ /$args/o ) {
18            if ( ref $args{$1} ) {
19                push @{ $args{$1} }, $ARGV[ $i + 1 ];
20            }
21            else {
22                $args{$1} = $ARGV[ $i + 1 ];
23            }
24            splice( @ARGV, $i, 2 );
25            redo if $i < @ARGV;
26        }
27    }
28}
29
30# the headers we want to see
31my @srv_hdr = (
32    qw( Content-Type Set-Cookie Set-Cookie2 WWW-Authenticate Location ),
33    @{ $args{header} }
34);
35my @clt_hdr =
36  ( qw( Cookie Cookie2 Referer Referrer Authorization ), @{ $args{header} } );
37
38# NOTE: Body request filters always receive the request body in one pass
39my $post_filter = HTTP::Proxy::BodyFilter::simple->new(
40    begin  => sub { $_[0]->{binary} = 0; },
41    filter => sub {
42        my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
43        print STDOUT "\n", $message->method, " ", $message->uri, "\n";
44        print_headers( $message, @clt_hdr );
45
46        if ( $self->{binary} || $$dataref =~ /\0/ ) {
47            $self->{binary} = 1;
48            print STDOUT "    (not printing binary data)\n";
49            return;
50        }
51
52        # this is from CGI.pm, method parse_params()
53        my (@pairs) = split( /[&;]/, $$dataref );
54        for (@pairs) {
55            my ( $param, $value ) = split( '=', $_, 2 );
56            $param = unescape($param);
57            $value = unescape($value);
58            printf STDOUT "    %-20s => %s\n", $param, $value;
59        }
60    }
61);
62
63my $get_filter = HTTP::Proxy::HeaderFilter::simple->new(
64    sub {
65        my ( $self, $headers, $message ) = @_;
66        my $req = $message->request;
67        if ( $req->method ne 'POST' ) {
68            print STDOUT "\n", $req->method, " ", $req->uri, "\n";
69            print_headers( $req, @clt_hdr );
70        }
71        print STDOUT $message->status_line, "\n";
72        print_headers( $message, @srv_hdr );
73    }
74);
75
76sub print_headers {
77    my $message = shift;
78    for my $h (@_) {
79        if ( $message->header($h) ) {
80            print STDOUT "    $h: $_\n" for ( $message->header($h) );
81        }
82    }
83}
84
85# create and start the proxy
86my $proxy = HTTP::Proxy->new(@ARGV);
87
88# if we want to look at SOME sites
89if (@{$args{peek}}) {
90    for (@{$args{peek}}) {
91        $proxy->push_filter(
92            host    => $_,
93            method  => 'POST',
94            request => $post_filter
95        );
96        $proxy->push_filter(
97            host     => $_,
98            response => $get_filter,
99            mime     => $args{mime},
100        );
101    }
102}
103# otherwise, peek at all sites
104else {
105    $proxy->push_filter(
106        method  => 'POST',
107        request => $post_filter
108    );
109    $proxy->push_filter( response => $get_filter, mime => $args{mime} );
110}
111
112$proxy->start;
113
114