0 package Apache::AdBlocker;
1
2 use strict;
3 use vars qw(@ISA $VERSION);
4 use Apache::Constants qw(:common);
5 use GD ();
6 use Image::Size qw(imgsize);
7 use LWP::UserAgent ();
8
9 @ISA = qw(LWP::UserAgent);
10 $VERSION = '1.00';
11
12 my $UA = ->new;
13 $UA->agent(join "/", , $VERSION);
14 my $Ad = join "|", qw{ads? advertisements? banners? adv promotions?};
15
16 sub handler {
17   my($r) = @_;
18   return DECLINED unless $r->proxyreq;
19   $r->handler("perl-script"); # Okay, let&’s do it
20   $r->push_handlers(PerlHandler => \&proxy_handler);
21   return OK;
22 }
23
24 sub proxy_handler {
25   my ($r) = @_;
26
27   my $request = HTTP::Request->new($r->method => $r->uri);
28   my %headers_in = $r->headers_in;
29
30   while (my($key,$val) = each %headers_in) {
31     $request->header($key,$val);
32   }
33
34   if($r->method eq 'POST') {
35     my $len = $r->header_in('Content-length');
36     my $buf;
37     $r->read($buf, $len);
38     $request->content($buf);
39   }
40
41   my $response = $UA->request($request);
42   $r->content_type($response->header('Content-type'));
43
44   # Feed response back into our request
45   $r->status($response->code);
46   $r->status_line(join " ", $response->code, $response->message);
47   $response->scan(sub {
48     $r->header_out(@_);
49   });
50
51   $r->send_http_header();
52   my $content = \$response->content;
53
54   if ($r->content_type =~ /^image/ && $r->uri =~ /\b($Ad)\b/i) {
55     $r->content_type("image/gif");
56     block_ad($content);
57   }
58
59   $r->print($$content);
60
61   return OK;
62 }
63
64 sub block_ad {
65   my $data = shift;
66   my($x, $y) = imgsize($data);
67
68   my $im = GD::Image->new($x,$y);
69
70   my $white = $im->colorAllocate(255, 255, 255);
71   my $black = $im->colorAllocate(0, 0, 0 );
72   my $red = $im->colorAllocate(255, 0, 0 );
73
74   $im->transparent($white);
75   $im->string(GD::gdLargeFont(), 5, 5, "Blocked Ad", $red);
76   $im->rectangle(0, 0, $x-1, $y-1, $black);
77
78   $$data = $im->gif;
79 }
80
81 1;
82
83