1#!/usr/bin/perl -w
2use strict;
3use HTTP::Proxy qw( :log );
4use HTTP::Proxy::HeaderFilter::simple;
5use CGI::Util qw( unescape );
6
7my $proxy = HTTP::Proxy->new(@ARGV);
8
9$proxy->push_filter(
10    host     => 'groups.yahoo.com',
11    response => HTTP::Proxy::HeaderFilter::simple->new(
12        sub {
13            my ( $self, $headers, $message ) = @_;
14            my $location;
15
16            # ads start by redirecting to 'interrupt'
17            return
18              unless ( $location = $headers->header('Location') )
19              && $location =~ m!/interrupt\?!;
20
21            # fetch the ad page (we need the cookie)
22            # use a new request to avoid modifying the original one
23            $self->proxy->log( FILTERS, "YAHOOGROUPS",
24                "Ad interrupt detected: fetching $location" );
25            my $r = $self->proxy->agent->simple_request(
26                HTTP::Request->new(
27                    GET => $location,
28                    $message->request->headers    # headers are cloned
29                )
30            );
31
32            # redirect to our original destination
33            # which was stored in the 'done' parameter
34            # and pass the cookie along
35            $location = unescape($location);
36            $location =~ s|^(http://[^/]*).*done=([^&]*).*$|$1$2|;
37            $headers->header( Location   => $location );
38            $headers->header( Set_Cookie => $r->header('Set_Cookie') );
39            $self->proxy->log( FILTERS, "YAHOOGROUPS",
40                "Set-Cookie: " . $r->header('Set_Cookie') );
41        }
42    )
43);
44
45$proxy->start;
46
47