File Coverage

blib/lib/Net/Prober/smtp.pm
Criterion Covered Total %
statement 22 26 84.6
branch 3 6 50.0
condition n/a
subroutine 5 6 83.3
pod 0 2 0.0
total 30 40 75.0


line stmt bran cond sub pod time code
1             package Net::Prober::smtp;
2             $Net::Prober::smtp::VERSION = '0.17';
3 1     1   8 use strict;
  1         3  
  1         34  
4 1     1   8 use warnings;
  1         2  
  1         28  
5 1     1   5 use base 'Net::Prober::Probe::TCP';
  1         1  
  1         364  
6              
7             sub args {
8             return {
9 0     0 0 0 host => undef,
10             port => 25,
11             timeout => 30,
12             ssl => 0,
13             username => undef,
14             password => undef,
15             };
16             }
17              
18             sub probe {
19 1     1 0 2 my ($self, $args) = @_;
20              
21 1         5 my ($host, $port, $timeout, $username, $password) =
22             $self->parse_args($args, qw(host port timeout username password));
23              
24 1         8 my $t0 = $self->time_now();
25              
26 1         6 my $sock = $self->open_socket($args);
27 1 50       14849 if (! $sock) {
28 0         0 return $self->probe_failed(
29             reason => qq{Couldn't connect to smtp server $host:$port},
30             );
31             }
32              
33 1         4 chomp (my $esmtp_banner = $self->_get_reply($sock));
34              
35 1 50       7 if (! $esmtp_banner) {
36 0         0 return $self->probe_failed(
37             reason => qq{Couldn't get SMTP banner from $host:$port}
38             );
39             }
40              
41 1 50       17 if ($esmtp_banner !~ qr{^220 \s+ }x) {
42 0         0 return $self->probe_failed(
43             reason => qq{Incorrect SMTP banner from $host:$port? ($esmtp_banner)},
44             );
45             }
46              
47 1         17 $sock->send("QUIT\r\n");
48              
49 1         133 return $self->probe_ok(
50             banner => $esmtp_banner,
51             status => 220,
52             );
53              
54             }
55              
56             sub _get_reply {
57 1     1   3 my ($self, $sock) = @_;
58 1         9 $sock->recv(my $reply, 256);
59 1         93998 return $reply;
60             }
61              
62             1;
63              
64             __END__