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