File Coverage

blib/lib/Mail/POP3/Security/Connection.pm
Criterion Covered Total %
statement 21 56 37.5
branch 2 28 7.1
condition 1 21 4.7
subroutine 4 4 100.0
pod 2 2 100.0
total 30 111 27.0


line stmt bran cond sub pod time code
1             package Mail::POP3::Security::Connection;
2              
3 4     4   28 use strict;
  4         9  
  4         156  
4 4     4   22 use IO::Socket;
  4         8  
  4         35  
5              
6             =head2 new
7              
8             Params: Config hash-ref with keys:
9              
10             =over
11              
12             =item trusted_networks
13              
14             Filename.
15              
16             =item allow_non_fqdn
17              
18             Boolean.
19              
20             =item hosts_allow_deny
21              
22             Filename.
23              
24             =back
25              
26             =cut
27              
28             sub new {
29 1     1 1 8 my ($class, $config) = @_;
30 1         21 my $self = {};
31 1         15 bless $self, $class;
32 1         38 $self->{CONFIG} = $config;
33 1         18 $self;
34             }
35              
36             =head2 check
37              
38             Params: C<$client_ip>, C<$fqdn>.
39              
40             =cut
41              
42             # return ($was_ok, \@log_entry)
43             sub check {
44 1     1 1 20 my ($self, $client_ip, $fqdn) = @_;
45             # Get the client's IP and FQDN. We don't have tcpwrapper
46             # protection in daemon mode and therefore need to do a reverse
47             # lookup. $self->{CONFIG}->{allow_non_fqdn} can be set to 1 to
48             # effectively disable reverse lookups.
49             # Make an exception for trusted networks
50 1         21 my $secure = 0;
51 1 50       125 if (-f $self->{CONFIG}->{trusted_networks}) {
52 0         0 local *SECURENETS;
53 0         0 open SECURENETS, $self->{CONFIG}->{trusted_networks};
54 0         0 while () {
55 0 0       0 next if /^\#/;
56 0 0       0 next if /^\s+$/;
57 0         0 chomp;
58 0         0 s/\s+|\*//g;
59 0 0 0     0 if ($client_ip =~ /^$_/ || $fqdn =~ /^$_$/) {
60 0         0 $secure = 1;
61 0         0 last;
62             }
63             }
64 0         0 close SECURENETS;
65             }
66 1         180 my @addr = gethostbyname($fqdn);
67             # See if any of the domain names returned matches the IP
68             # and return false if none does.
69 1         19 my $lookup_ok = grep { $client_ip eq inet_ntoa($_) } @addr[4..$#addr];
  2         52  
70 1 0 33     145 if (!$lookup_ok and !$self->{CONFIG}->{allow_non_fqdn} and !$secure) {
      0        
71 0         0 return (0, [ "$client_ip\tFAILED reverse lookup at" ]);
72             }
73 1         13 my $log_entry = [];
74             # Check a seperate blocking list for particular client's/networks
75 1 50       36 if (-s $self->{CONFIG}->{hosts_allow_deny}) {
76 0         0 my $deny_all = 0;
77 0         0 my $allowed = 0;
78 0         0 local *ALLOWDENY;
79 0         0 open ALLOWDENY, $self->{CONFIG}->{hosts_allow_deny};
80 0         0 while () {
81 0 0       0 next if /^\#/;
82 0 0       0 next if /^\s+$/;
83 0         0 chomp;
84             # Each line can be one action, DENY, ALLOW or WARN, followed by
85             # an IP, subnet or hostname, whereby 'ALL' is a special case.
86             # If the special rule 'DENY ALL' appears anywhere then
87             # a client will be refused unless they match an 'ALLOW' line.
88             # Lines starting with '#' or whitespace are skipped.
89 0         0 my ($action,$peer) = split /\s+/, $_;
90 0         0 $action =~ s/\s+//g;
91 0         0 $peer =~ s/\s+|\*//g;
92 0 0 0     0 if ($action =~ /deny/i and $peer =~ /all/i) {
    0 0        
93 0         0 $deny_all = 1;
94             } elsif ($client_ip =~ /^$peer/ || $fqdn =~ /^$peer$/i) {
95 0 0 0     0 if ($action =~ /allow/i) {
    0          
    0          
96 0         0 push @$log_entry, "$client_ip\tALLOWED connection at";
97 0         0 $allowed = 1;
98 0         0 last;
99             } elsif ($action =~ /warn/i) {
100 0         0 push @$log_entry, "$client_ip\tWARN connected at";
101             } elsif ($action =~ /deny/i and $peer !~ /all/i) {
102             return (
103 0         0 0, [ @$log_entry, "$client_ip\tDENIED connection at" ]
104             );
105             }
106             }
107             }
108 0         0 close ALLOWDENY;
109 0 0 0     0 if ($deny_all == 1 and $allowed == 0) {
110 0         0 return (0, [ @$log_entry, "$client_ip\tDENIED connection at" ]);
111             }
112 0         0 return (1, $log_entry);
113             }
114 1         11 return (1, $log_entry);
115             }
116              
117             1;