File Coverage

blib/lib/CGI/remote_addr.pm
Criterion Covered Total %
statement 26 26 100.0
branch 6 6 100.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 40 40 100.0


line stmt bran cond sub pod time code
1             package CGI::remote_addr;
2              
3 1     1   132400 use strict;
  1         24  
  1         40  
4 1     1   7 use warnings;
  1         2  
  1         46  
5 1     1   574 use Regexp::Common qw(net);
  1         5389  
  1         6  
6 1     1   4557 use List::MoreUtils qw(uniq);
  1         15601  
  1         8  
7 1     1   1958 use namespace::clean;
  1         17935  
  1         8  
8              
9             our $VERSION = '0.03';
10              
11             sub remote_addr {
12 7     7 1 21664 my @ips;
13              
14             # gather all available IP addresses
15 7 100       31 if ($ENV{'HTTP_X_FORWARDED_FOR'}) {
16 5         35 push( @ips, split(/\s*,\s*/, $ENV{'HTTP_X_FORWARDED_FOR'}) );
17             }
18 7 100       83 if ($ENV{'REMOTE_ADDR'}) {
19 5         16 push( @ips, $ENV{'REMOTE_ADDR'} );
20             }
21              
22             # trim list to a unique list of valid IPs
23 7         37 @ips = uniq grep { /^$RE{net}{IPv4}$/ } @ips;
  12         887  
24              
25             # return IP back to caller
26 7 100       901 return wantarray ? @ips : $ips[0];
27             }
28              
29             # redefine CGI::remote_addr() so that it uses our version instead of the one
30             # that comes with CGI.pm
31             {
32 1     1   423 no warnings;
  1         2  
  1         89  
33             *CGI::remote_addr = \&remote_addr;
34             }
35              
36             1;
37              
38             =head1 NAME
39              
40             CGI::remote_addr - Enhanced version of CGI.pm's "remote_addr()"
41              
42             =head1 SYNOPSIS
43              
44             use CGI;
45             use CGI::remote_addr;
46              
47             my $cgi = CGI->new();
48             my $addr = $cgi->remote_addr();
49              
50             =head1 DESCRIPTION
51              
52             C implements an enhanced version of the C
53             method provided by C, which attempts to return the original IP address
54             that the connection originated from (which is not necessarily the IP address
55             that we received the connection from).
56              
57             Simply loading C causes it to over-ride the existing
58             C method. Do note, though, that this is a global over-ride; if
59             you're running under mod_perl you've just over-ridden it for B of your
60             applications.
61              
62             =head2 Differences from CGI.pm
63              
64             =over
65              
66             =item *
67              
68             We check not only C<$ENV{REMOTE_ADDR}> to find the IP address, but also look in
69             C<$ENV{HTTP_X_FORWARDED_FOR}> to find the IP address. If
70             C<$ENV{HTTP_X_FORWARDED_FOR}> is defined, we try that first.
71              
72             =item *
73              
74             Only valid IP addresses are returned, regardless of whatever exists in
75             C<$ENV{REMOTE_ADDR}> or C<$ENV{HTTP_X_FORWARDED_FOR}>. I've seen lots of cases
76             where the values for C<$ENV{HTTP_X_FORWARDED_FOR}> were stuffed with garbage,
77             and we make sure that you only get a real IP back.
78              
79             =item *
80              
81             We return IPs in both a scalar and a list context. In scalar context you get
82             the first (originating) IP address. In list context you get a unique list of
83             all of the IPs that the connection was received through.
84              
85             =item *
86              
87             In the event that we cannot find a valid IP address, this method returns
88             C, B 127.0.0.1 (like C does).
89              
90             =back
91              
92             =head1 METHODS
93              
94             =over
95              
96             =item remote_addr()
97              
98             Returns the IP address(es) of the remote host.
99              
100             =back
101              
102             =head1 AUTHOR
103              
104             Graham TerMarsch (cpan@howlingfrog.com)
105              
106             =head1 COPYRIGHT
107              
108             Copyright (C) 2008 Graham TerMarsch. All Rights Reserved.
109              
110             This library is free software; you can redistribute it and/or modify it under
111             the same terms as Perl itself.
112              
113             =head1 SEE ALSO
114              
115             =over
116              
117             =item L
118              
119             =back
120              
121             =cut