File Coverage

blib/lib/Plack/Middleware/IPMatch.pm
Criterion Covered Total %
statement 43 47 91.4
branch 4 8 50.0
condition 3 7 42.8
subroutine 9 9 100.0
pod 2 2 100.0
total 61 73 83.5


line stmt bran cond sub pod time code
1             package Plack::Middleware::IPMatch;
2 2     2   16623 use strict;
  2         4  
  2         60  
3 2     2   7 use warnings;
  2         2  
  2         47  
4 2     2   423 use parent qw/Plack::Middleware/;
  2         228  
  2         10  
5 2     2   13504 use Net::IP::XS;
  2         80317  
  2         175  
6 2     2   974 use Net::IP::Match::Trie;
  2         346  
  2         11  
7             our $VERSION = 0.03;
8              
9 2     2   2445 use Plack::Util::Accessor qw( IPFile );
  2         2  
  2         16  
10              
11             sub _build_real_ip {
12 7     7   7     my ($env) = @_;
13              
14                 my @possible_forwarded_ips
15 0         0         = grep {
16 0         0         $_->iptype
17                         !~ /^(?:LOOPBACK|LINK\-LOCAL|PRIVATE|UNIQUE\-LOCAL\-UNICAST|LINK\-LOCAL\-UNICAST|RESERVED)$/xo
18                     }
19 0         0         grep {defined}
20 35         33         map { Net::IP::XS->new($_) }
21 7   50     44         grep {defined} (
22                     $env->{'HTTP_CLIENT_IP'},
23                     split( /,\s*/xo, $env->{'HTTP_X_FORWARDED_FOR'} // '' ),
24                     $env->{'HTTP_X_FORWARDED'},
25                     $env->{'HTTP_X_CLUSTER_CLIENT_IP'},
26                     $env->{'HTTP_FORWARDED_FOR'},
27                     $env->{'HTTP_FORWARDED'},
28                     );
29              
30 7   50     237     return $possible_forwarded_ips[0]
      33        
31                     // Net::IP::XS->new( $env->{'REMOTE_ADDR'} // '' );
32             }
33              
34              
35             sub prepare_app {
36 7     7 1 3441     my $self = shift;
37              
38 7 50       15     if (my $ipfiles = $self->IPFile) {
39 7 50       113         my @ipfiles = ref $ipfiles ? @{ $ipfiles } : ($ipfiles);
  0         0  
40 7         9         for my $ipfile (@ipfiles) {
41 7         27             my $match = Net::IP::Match::Trie->new();
42              
43 7 50       256             open my $fh, "<", $ipfile or die "$!";
44 7         89             while (<$fh>) {
45 77         902                 chomp;
46 77         272                 my ($CIDRS, $lable) = split(/[,|\s]/, $_);
47 77         166                 $match->add( $lable , [$CIDRS] );
48                         }
49 7         85             push @{ $self->{IPMatcher} }, $match;
  7         91  
50                     }
51                 }
52             }
53              
54             sub call {
55 7     7 1 19606     my $self = shift;
56 7         8     my $env = shift;
57              
58 7         13     my $ip = _build_real_ip($env)->ip;
59 7         57     $env->{MATCH_IP} = $ip;
60              
61 7         8     foreach my $matcher (@{ $self->{IPMatcher} }) {
  7         15  
62 7         22         my $label = $matcher->match_ip($ip);
63 7 50       19         $env->{IPMATCH_LABEL} = $label and last;
64                 }
65              
66 7         22     return $self->app->($env);
67             }
68              
69             1;
70             __END__
71            
72             =pod
73            
74             =encoding utf8
75            
76             =head1 NAME
77            
78             Plack::Middleware::IPMatch - 查找指定 IP (CIDR) 所对应的标签 LABEL
79            
80             =head1 SYNOPSIS
81            
82             enable 'Plack::Middleware::IPMatch',
83             IPFile => [ '/path/to/CT.txt', '/path/to/CNC.txt' ];
84            
85             =head1 DESCRIPTION
86            
87             Plack::Middleware::IPMatch 这个是使用, Net::IP::Match::Trie 来实现的超级快的进行 CIDR 转换成指定的 LABEL 的模块.
88             因为是使用的前缀树实现, 所以有着超级快的查询速度.
89            
90             =head1 CONFIGURATION
91            
92            
93             =head2 IPFile
94            
95             IPFile => '/path/to/CT-IP.dat';
96             IPFile => [ '/path/to/CT-IP.dat', '/path/to/CNC-IP.dat' ];
97            
98             这个需要本身有自己整理过的 IP 数据库, 然后给整个数据库存成文本格式
99            
100             =head2 IPFile 格式
101            
102             格式需要自己来收集 IP 数据, 存成如下格式的文本
103            
104             112.122.128.0/21,CNC-AH-AH
105             112.122.136.0/23,CNC-AH-AH
106             112.122.138.0/25,CNC-AH-AH
107             112.122.138.128/29,CNC-AH-AH
108             112.122.138.144/28,CNC-AH-AH
109             112.122.138.160/27,CNC-AH-AH
110             112.122.138.192/26,CNC-AH-AH
111            
112             =head1 Header
113            
114             =head2 IPMATCH_LABEL
115            
116             默认会在 $env 的哈希中增加 C<IPMATCH_LABEL> 的字段的 Header, 这就是查询的结果
117            
118             可以使用如下的方式来访问
119            
120             $env->{IPMATCH_LABEL}
121            
122             =head2 MATCH_IP
123            
124             进行 ip 转换时候所使用的 IP 地址, 默认会存到这个 header 中传给应用
125            
126            
127             =head1 AUTHOR
128            
129             扶凯 E<lt>iakuf@163.comE<gt>
130            
131             =head1 LICENSE
132            
133             This library is free software; you can redistribute it and/or modify
134             it under the same terms as Perl itself.
135            
136             =head1 SEE ALSO
137            
138             L<Net::IP::Match::Trie|https://metacpan.org/pod/Net::IP::Match::Trie>
139            
140             L<Plack::Middleware::GeoIP|https://metacpan.org/pod/Plack::Middleware::GeoIP>
141            
142             =cut
143