File Coverage

blib/lib/Net/SIP/Dropper/ByIPPort.pm
Criterion Covered Total %
statement 78 86 90.7
branch 18 36 50.0
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 112 138 81.1


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Net::SIP::Dropper::ByIPPort - drops SIP messages based on senders IP and port
5              
6             =head1 SYNOPSIS
7              
8             use Net::SIP::Dropper::ByIPPort;
9             my $drop_by_ipport = Net::SIP::Dropper::ByIPPort->new(
10             database => '/path/to/database.drop',
11             methods => [ 'REGISTER', '...', '' ],
12             attempts => 10,
13             interval => 60,
14             );
15              
16             my $dropper = Net::SIP::Dropper->new( cb => $drop_by_ipport );
17             my $chain = Net::SIP::ReceiveChain->new([ $dropper, ... ]);
18              
19             =head1 DESCRIPTION
20              
21             With C one can drop packets, if too much packets
22             are received from the same IP and port within a specific interval. This is to
23             stop bad behaving clients.
24              
25             =cut
26              
27              
28 3     3   1096 use strict;
  3         4  
  3         91  
29 3     3   14 use warnings;
  3         7  
  3         87  
30              
31             package Net::SIP::Dropper::ByIPPort;
32 3     3   26 use Net::SIP::Debug;
  3         10  
  3         17  
33 3     3   19 use Net::SIP::Util 'invoke_callback';
  3         6  
  3         152  
34 3     3   17 use fields qw(interval attempts methods dbcb data);
  3         17  
  3         17  
35              
36             =head1 CONSTRUCTOR
37              
38             =over 4
39              
40             =item new ( ARGS )
41              
42             ARGS is a hash with the following keys:
43              
44             =over 8
45              
46             =item database
47              
48             Optional file name of database or callback for storing/retrieving the data.
49              
50             If it is a callback it will be called with C<< $callback->(\%data) >> to
51             retrieve the data (C<%data> will be updated) and C<< $callback->(\%data,true) >>
52             to save the data. No return value will be expected from the callback.
53              
54             %data contains the number of attempts from a specific IP, port at a specific
55             time in the following format:
56             C<< $data{ip}{port}{time} = count >>
57              
58             =item attempts
59              
60             After how many attempts within the specific interval the packet will be dropped.
61             Argument is required.
62              
63             =item interval
64              
65             The interval for attempts. Argument is required.
66              
67             =item methods
68              
69             Optional argument to restrict dropping to specific methods.
70              
71             Is array reference of method names, if one of the names is empty also responses
72             will be considered. If not given all packets will be checked.
73              
74             =back
75              
76             =back
77              
78             =cut
79              
80             sub new {
81 1     1 1 107 my ($class,%args) = @_;
82 1 50       5 my $interval = delete $args{interval} or croak('interval should be defined');
83 1 50       3 my $attempts = delete $args{attempts} or croak('attempts should be defined');
84 1         1 my $methods = delete $args{methods}; # optional
85              
86 1         2 my %ips_ports;
87             my $dbcb;
88 1 50       3 if ( my $db = delete $args{database} ) {
89 1 50       4 if ( ! ref $db ) {
90             # file name
91 1         31 require Storable;
92 1 50       36 if ( ! -e $db ) {
93             # initialize DB
94 1 50       22 Storable::store(\%ips_ports, $db) or
95             croak("cannot create $db: $!");
96             }
97             $dbcb = [
98             sub {
99 3     3   7 my ($file,$data,$save) = @_;
100 3 100       7 if ( $save ) {
101 2         8 Storable::store($data,$file);
102             } else {
103 1         1 %$data = %{ Storable::retrieve($file) }
  1         13  
104             }
105             },
106 1         271 $db
107             ];
108             } else {
109 0         0 $dbcb = $db
110             }
111              
112             # load contents of database
113 1         6 invoke_callback($dbcb,\%ips_ports);
114              
115 1         85 DEBUG_DUMP(100, \%ips_ports);
116             }
117              
118              
119             # initialize object
120 1         3 my Net::SIP::Dropper::ByIPPort $self = fields::new($class);
121 1         94 $self->{data} = \%ips_ports;
122 1         2 $self->{interval} = $interval;
123 1         2 $self->{attempts} = $attempts;
124 1         1 $self->{methods} = $methods;
125 1         2 $self->{dbcb} = $dbcb;
126              
127 1         3 return $self
128             }
129              
130             =head1 METHODS
131              
132             =over 4
133              
134             =item run ( PACKET, LEG, FROM )
135              
136             This method is called as a callback from the L object.
137             It returns true if the packet should be dropped, e.g. if there are too much
138             packets from the same ip,port within the given interval.
139              
140             =cut
141              
142             sub run {
143 2     2 1 5 my Net::SIP::Dropper::ByIPPort $self = shift;
144 2         4 my ($packet,$leg,$from) = @_;
145              
146             # expire current contents
147 2         7 $self->expire;
148              
149             # check if the packet type/method fits
150 2 50       5 if (my $m = $self->{methods}) {
151 2 50       6 if ($packet->is_response) {
152 0 0       0 return if ! grep { !$_ } @$m
  0         0  
153             } else {
154 2         7 my $met = $packet->method;
155 2 50       10 return if ! grep { $_ eq $met } @$m
  2         8  
156             }
157             };
158              
159             # enter ip,port into db
160 2         6 my ($ip,$port) = ($from->{addr},$from->{port});
161 2         8 $self->{data}{$ip}{$port}{ time() }++;
162 2         11 $self->savedb();
163              
164             # count attempts in interval
165             # because everything outside of interval is expired we can
166             # just look at all entries for ip,port
167 2         2462 my $count = 0;
168 2         6 for (values %{$self->{data}{$ip}{$port}} ) {
  2         10  
169 3         6 $count += $_;
170             }
171             # by using port = 0 one can block the whole IP
172 2 50       4 for (values %{$self->{data}{$ip}{0} || {}} ) {
  2         23  
173 0         0 $count += $_;
174             }
175              
176             # drop if too much attempts
177 2 50       9 if ( $count >= $self->{attempts} ) {
178 0         0 DEBUG(1,"message dropped because $ip:$port was in database with $count attempts");
179 0         0 return 1;
180             }
181 2         9 return;
182             }
183              
184             =item expire
185              
186             This method is called from within C but can also be called by hand.
187             It will expire all entries which are outside of the interval.
188              
189             =cut
190              
191             sub expire {
192 2     2 1 4 my Net::SIP::Dropper::ByIPPort $self = shift;
193 2         3 my $interval = $self->{interval};
194 2         4 my $data = $self->{data};
195              
196 2         4 my $maxtime = time() - $interval;
197 2         3 my $changed;
198 2         11 for my $ip ( keys %$data ) {
199 1         3 my $ipp = $data->{$ip};
200 1         3 for my $port (keys %$ipp) {
201 1         2 my $ippt = $ipp->{$port};
202 1         3 for my $time (keys %$ippt) {
203 1 50       5 if ($time<=$maxtime) {
204 0         0 delete $ippt->{$time};
205 0         0 $changed = 1;
206             }
207             }
208 1 50       3 delete $ipp->{$port} if ! %$ippt;
209             }
210 1 50       4 delete $data->{$ip} if ! %$ipp;
211             }
212 2 50       7 $self->savedb if $changed;
213             }
214              
215             =item savedb
216              
217             This method is called from C and C for saving to the database after
218             changes, but can be called by hand to, useful if you made manual changes using
219             the C method.
220              
221             =cut
222              
223             sub savedb {
224 2     2 1 5 my Net::SIP::Dropper::ByIPPort $self = shift;
225 2 50       6 my $dbcb = $self->{dbcb} or return;
226 2         7 invoke_callback($dbcb,$self->{data},'save')
227             }
228              
229             =item data
230              
231             This method gives access to the internal hash which stores the attempts.
232             An attempt from a specific IP and port and a specific time (as int, like time()
233             gives) will be added to
234             C<< $self->data->{ip}{port}{time} >>.
235              
236             By manually manipulating the hash one can restrict a specific IP,port forever
237             (just set time to a large value and add a high number of attempts) or even
238             restrict access for the whole IP (all ports) until time by using a port number
239             of 0.
240              
241             After changes to the data it is advised to call C.
242              
243             =cut
244              
245             sub data {
246 1     1 1 114 my Net::SIP::Dropper::ByIPPort $self = shift;
247             return $self->{data}
248 1         7 }
249              
250             =pod
251              
252             =back
253              
254             =cut
255              
256             1;