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