1package Security::TLSCheck::Checks::Mail;
2
3use 5.010;
4
5use Carp;
6use English qw( -no_match_vars );
7use Net::SMTP 3.02;
8
9use Moose;
10extends 'Security::TLSCheck::Checks';
11with 'Security::TLSCheck::Checks::Helper::Timing';
12with 'Security::TLSCheck::Checks::Helper::MX';
13
14use Log::Log4perl::EasyCatch;
15
16
17
18=head1 NAME
19
20Security::TLSCheck::Checks::Mail - Checks mailservers for TLS capability
21
22=encoding utf8
23
24=cut
25
26use version; our $VERSION = sprintf "%d", q$Revision: 632 $ =~ /(\d+)/xg;
27
28
29=head1 SYNOPSIS
30
31...
32
33
34=head1 DESCRIPTION
35
36
37
38
39
40=cut
41
42#<<<
43
44{
45my $key_figures =
46   [
47   { name => "#MX unique",            type => "int", source => "count_mx_unique",        description => "Number of unique MX Servers", },
48   { name => "#MX active",            type => "int", source => "count_mx_active",        description => "Number of connectable servers", },
49   { name => "#MX Supports STARTTLS", type => "int", source => "count_support_starttls", description => "Number of servers supporting STARTTLS", },
50   { name => "#MX STARTTLS OK",       type => "int", source => "count_starttls_ok",      description => "Number of servers with successful STARTTLS", },
51   ];
52
53has '+key_figures' => ( default => sub {return $key_figures} );
54}
55
56has '+description' => ( default => "Mail checks" );
57
58has mx_unique           => ( is => 'rw', isa => 'ArrayRef[Str]', traits  => ['Array'], handles => { count_mx_unique        => 'count', add_mx_unique            => 'push', all_unique            => 'elements', }, default => sub {[]}, );
59has mx_active           => ( is => 'rw', isa => 'ArrayRef[Str]', traits  => ['Array'], handles => { count_mx_active        => 'count', add_mx_active            => 'push', all_active            => 'elements', }, default => sub {[]}, );
60has mx_support_starttls => ( is => 'rw', isa => 'ArrayRef[Str]', traits  => ['Array'], handles => { count_support_starttls => 'count', add_mx_supports_starttls => 'push', all_supports_starttls => 'elements', }, default => sub {[]}, );
61has mx_starttls_ok      => ( is => 'rw', isa => 'ArrayRef[Str]', traits  => ['Array'], handles => { count_starttls_ok      => 'count', add_mx_starttls_ok       => 'push', all_starttls_ok       => 'elements', }, default => sub {[]}, );
62
63# For Internal use, for forwarding it to CipherStrength check
64# has mx_for_cipher       => ( is => 'rw', isa => 'ArrayRef[Str]', traits  => ['Array'], handles => { count_for_cipher       => 'count', add_mx_for_cipher        => 'push', all_for_cipher        => 'elements', }, default => sub {[]}, );
65
66#>>>
67
68
69
70=head1 METHODS
71
72=head2 run_checks
73Run all the checks and store the results internally
74
75=cut
76
77sub run_check
78   {
79   my $self = shift;
80
81   TRACE "Checking Mailservers for " . $self->domain;
82
83   my @mx = $self->other_check("Security::TLSCheck::Checks::DNS")->all_mx;
84
85   foreach my $mx ( @mx )
86      {
87      TRACE "Check MX $mx";
88      next if $self->mx_is_checked($mx);
89
90      $self->add_mx_unique($mx);
91
92      my $smtp = Net::SMTP->new( Hello => $self->my_hostname, Host => $mx );
93      if ($smtp)
94         {
95         TRACE "SMTP-Connect to MX $mx OK, SMTP-Banner: "  . $smtp->banner;
96         $self->add_mx_active($mx);
97         eval {
98
99            if ( defined $smtp->supports("STARTTLS") )
100               {
101               TRACE "MX $mx supports STARTTLS";
102               $self->add_mx_supports_starttls($mx);
103               # $self->add_mx_for_cipher($mx);
104
105#               if ( $smtp->starttls(SSL_verifycn_scheme => 'http', ) )
106               if ( $smtp->starttls )
107                  {
108                  TRACE "MX $mx works with STARTTLS";
109                  $self->add_mx_starttls_ok($mx);
110                  }
111               else
112                  {
113                  TRACE "MX $mx: FAILED STARTTLS: $IO::Socket::SSL::SSL_ERROR";
114                  }
115               }
116            else
117               {
118               TRACE "MX $mx does NOT support STARTTLS";
119               }
120
121
122            $smtp->quit;
123            return 1;
124         } or ERROR "Unexpected SMTP Error (MX: $mx): $EVAL_ERROR";
125
126         } ## end if ($smtp)
127      else
128         {
129         DEBUG "SMTP-Connect to MX $mx failed: $EVAL_ERROR";    # Net::SMTP sets EVAL_ERROR!
130         }
131
132      } ## end foreach my $mx ( $self->get_mx...)
133
134   return $self->result;
135   } ## end sub run_check
136
137
138
139__PACKAGE__->meta->make_immutable;
140
1411;
142
143