1#!/usr/bin/perl -w 2use HTTP::Proxy; 3use HTTP::Proxy::HeaderFilter::simple; 4use HTTP::Proxy::BodyFilter::htmlparser; 5use HTTP::Proxy::BodyFilter::htmltext; 6use HTML::Parser; 7use strict; 8 9# where to find URI in tag attributes 10# (it actually a little more complicated, since some tags can have 11# several attributes that require an URI) 12my %links = ( 13 a => 'href', 14 area => 'href', 15 base => 'href', 16 link => 'href', 17 frame => 'src', 18 iframe => 'src', 19 img => 'src', 20 input => 'src', 21 script => 'src', 22 form => 'action', 23 body => 'background', 24); 25my $re_tags = join '|', sort keys %links; 26 27my $hrefparser = HTML::Parser->new( api_version => 3 ); 28 29# turn all https:// links to http://this_is_ssl links 30$hrefparser->handler( 31 start => sub { 32 my ( $self, $tag, $attr, $attrseq, $text ) = @_; 33 if ( $tag =~ /^($re_tags)$/o 34 && exists $attr->{$links{$1}} 35 && substr( $attr->{$links{$1}}, 0, 8 ) eq "https://" ) 36 { 37 $attr->{$links{$1}} =~ s!^https://!http://this_is_ssl.!; 38 $text = "<$tag " 39 . join( ' ', map { qq($_="$attr->{$_}") } @$attrseq ) . ">"; 40 } 41 $self->{output} .= $text; 42 }, 43 "self,tagname,attr,attrseq,text" 44); 45 46# by default copy everything 47$hrefparser->handler( 48 default => sub { 49 my ( $self, $text ) = @_; 50 $self->{output} .= $text; 51 }, 52 "self,text" 53); 54 55# the proxy itself 56my $proxy = HTTP::Proxy->new(@ARGV); 57 58$proxy->push_filter( 59 mime => 'text/html', 60 response => 61 HTTP::Proxy::BodyFilter::htmlparser->new( $hrefparser, rw => 1 ), 62); 63 64# detect https requests 65$proxy->push_filter( 66 request => HTTP::Proxy::HeaderFilter::simple->new( 67 sub { 68 my ( $self, $headers, $message ) = @_; 69 70 # find out the actual https site 71 my $uri = $message->uri; 72 if ( $uri =~ m!^http://this_is_ssl\.! ) { 73 $uri->scheme("https"); 74 my $host = $uri->host; 75 $host =~ s!^this_is_ssl\.!!; 76 $uri->host($host); 77 } 78 } 79 ), 80 response => HTTP::Proxy::HeaderFilter::simple->new( 81 sub { 82 my ( $self, $headers, $message ) = @_; 83 84 # modify Location: headers in the response 85 my $location = $headers->header( 'Location' ); 86 if( $location =~ m!^https://! ) { 87 $location =~ s!^https://!http://this_is_ssl.!; 88 $headers->header( Location => $location ); 89 } 90 } 91 ), 92); 93 94$proxy->start; 95