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