File Coverage

blib/lib/Apache2/checkReferer.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Apache2::checkReferer;
2              
3 1     1   23870 use warnings;
  1         3  
  1         32  
4 1     1   4 use strict;
  1         2  
  1         48  
5              
6             =head1 NAME
7              
8             Apache2::checkReferer - Prevent most "deep linking"
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18 1     1   413 use Apache2::RequestRec ();
  0            
  0            
19             use Apache2::RequestUtil ();
20             use Apache2::Connection ();
21             use Apache2::Log ();
22             use Apache2::Const -compile => qw(OK FORBIDDEN);
23              
24             =head1 SYNOPSIS
25              
26             In httpd.conf:
27              
28             =over 4
29              
30            
31              
32             PerlAccessHandler Apache2::checkReferer
33            
34             # option (default no) allow direct access
35             # only check referer if there is one.
36             PerlSetVar noRefererOK yes
37            
38            
39              
40             =back
41              
42             You can steal my pictures, put them on your own server.
43             Most browsers send a referer header, some (behind a proxy) do not.
44             Also some search bots do not send a referer header.
45              
46             =head1 FUNCTIONS
47              
48             =head2 handler
49              
50             A mod_perl2 handler. Checks wether or not your site's name is used in the referer header.
51              
52             =cut
53              
54             sub handler {
55             my $r = shift;
56              
57             $r->subprocess_env;
58            
59             unless (defined $ENV{'HTTP_REFERER'}) {
60             my $location = $r->location;
61             my $uri = $r->uri;
62             my $ip = $r->connection->remote_ip;
63             my $ok = lc($r->dir_config('noRefererOK')) || 'no';
64             if ($ok ne 'yes' && $ok ne 'no') {
65             $ok = 'no';
66             }
67             $r->log_error("checkReferer: $location, $uri, $ip noRefererOK=$ok");
68             return Apache2::Const::FORBIDDEN
69             if $ok eq 'no';
70             return Apache2::Const::OK;
71             }
72            
73             my $referer = $ENV{'HTTP_REFERER'};
74             my $host = $ENV{'HTTP_HOST'} || 'no host';
75            
76             my $prefered = qr{://\Q$host\E[:/]}i;
77             if ($referer !~ $prefered) {
78             my $location = $r->location;
79             my $uri = $r->uri;
80             $r->log_error("checkReferer: $location, $uri, $host, $referer .");
81             return Apache2::Const::FORBIDDEN;
82             }
83            
84             return Apache2::Const::OK;
85             }
86              
87             =head1 AUTHOR
88              
89             Henk van Oers, C<< >>
90              
91             =head1 BUGS
92              
93             Please report any bugs or feature requests to C, or through
94             the web interface at L. I will be notified, and then you'll
95             automatically be notified of progress on your bug as I make changes.
96              
97              
98              
99             =head1 SUPPORT
100              
101             You can find documentation for this module with the perldoc command.
102              
103             perldoc Apache2::checkReferer
104              
105              
106             You can also look for information at:
107              
108             =over 4
109              
110             =item * RT: CPAN's request tracker
111              
112             L
113              
114             =item * AnnoCPAN: Annotated CPAN documentation
115              
116             L
117              
118             =item * CPAN Ratings
119              
120             L
121              
122             =item * Search CPAN
123              
124             L
125              
126             =back
127              
128              
129             =head1 ACKNOWLEDGEMENTS
130              
131             Thanks to Mark Overmeer, Jan-Pieter Cornet and Juerd Waalboer
132             of the Amsterdam Perl Mongers (http://amsterdam.pm.org) for their
133             contributions and advise.
134              
135             =head1 COPYRIGHT & LICENSE
136              
137             Copyright 2008 Henk van Oers, all rights reserved.
138              
139             This program is free software; you can redistribute it and/or modify it
140             under the same terms as Perl itself.
141              
142              
143             =cut
144              
145             1; # End of Apache2::checkReferer