File Coverage

lib/Sisimai/Lhost/MessageLabs.pm
Criterion Covered Total %
statement 65 69 94.2
branch 29 38 76.3
condition 5 12 41.6
subroutine 6 6 100.0
pod 2 2 100.0
total 107 127 84.2


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::MessageLabs;
2 16     16   5419 use parent 'Sisimai::Lhost';
  16         37  
  16         106  
3 16     16   998 use feature ':5.10';
  16         31  
  16         1057  
4 16     16   95 use strict;
  16         31  
  16         297  
5 16     16   80 use warnings;
  16         42  
  16         13628  
6              
7 2     2 1 951 sub description { 'Symantec.cloud http://www.messagelabs.com' }
8             sub make {
9             # Detect an error from MessageLabs.com
10             # @param [Hash] mhead Message headers of a bounce email
11             # @param [String] mbody Message body of a bounce email
12             # @return [Hash] Bounce data list and message/rfc822 part
13             # @return [Undef] failed to parse or the arguments are missing
14             # @since v4.1.10
15 219     219 1 686 my $class = shift;
16 219   100     672 my $mhead = shift // return undef;
17 218   50     609 my $mbody = shift // return undef;
18              
19             # X-Msg-Ref: server-11.tower-143.messagelabs.com!1419367175!36473369!1
20             # X-Originating-IP: [10.245.230.38]
21             # X-StarScan-Received:
22             # X-StarScan-Version: 6.12.5; banners=-,-,-
23             # X-VirusChecked: Checked
24 218 100       746 return undef unless defined $mhead->{'x-msg-ref'};
25 16 50       71 return undef unless rindex($mhead->{'from'}, 'MAILER-DAEMON@messagelabs.com') > -1;
26 16 50       64 return undef unless index($mhead->{'subject'}, 'Mail Delivery Failure') == 0;
27              
28 16         65 state $indicators = __PACKAGE__->INDICATORS;
29 16         43 state $rebackbone = qr|^Content-Type:[ ]text/rfc822-headers|m;
30 16         31 state $startingof = { 'message' => ['Content-Type: message/delivery-status'] };
31 16         44 state $refailures = {
32             'userunknown' => qr/(?:542 .+ Rejected|No such user)/,
33             'securityerror' => qr/Please turn on SMTP Authentication in your mail client/,
34             };
35              
36 16         360 require Sisimai::RFC1894;
37 16         80 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
38 16         38 my $permessage = {}; # (Hash) Store values of each Per-Message field
39              
40 16         68 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
41 16         87 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
42 16         34 my $readcursor = 0; # (Integer) Points the current cursor position
43 16         28 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
44 16         34 my $v = undef;
45 16         28 my $p = '';
46              
47 16         181 for my $e ( split("\n", $emailsteak->[0]) ) {
48             # Read error messages and delivery status lines from the head of the email
49             # to the previous line of the beginning of the original message.
50 461 100       644 unless( $readcursor ) {
51             # Beginning of the bounce message or message/delivery-status part
52 316 100       578 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
53 316         345 next;
54             }
55 145 50       254 next unless $readcursor & $indicators->{'deliverystatus'};
56 145 100       219 next unless length $e;
57              
58 129 100       250 if( my $f = Sisimai::RFC1894->match($e) ) {
59             # $e matched with any field defined in RFC3464
60 117 50       262 next unless my $o = Sisimai::RFC1894->field($e);
61 117         173 $v = $dscontents->[-1];
62              
63 117 100       244 if( $o->[-1] eq 'addr' ) {
    100          
64             # Final-Recipient: rfc822; kijitora@example.jp
65             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
66 16 50       50 if( $o->[0] eq 'final-recipient' ) {
67             # Final-Recipient: rfc822; kijitora@example.jp
68 16 50       57 if( $v->{'recipient'} ) {
69             # There are multiple recipient addresses in the message body.
70 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
71 0         0 $v = $dscontents->[-1];
72             }
73 16         32 $v->{'recipient'} = $o->[2];
74 16         45 $recipients++;
75              
76             } else {
77             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
78 0         0 $v->{'alias'} = $o->[2];
79             }
80             } elsif( $o->[-1] eq 'code' ) {
81             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
82 16         35 $v->{'spec'} = $o->[1];
83 16         47 $v->{'diagnosis'} = $o->[2];
84              
85             } else {
86             # Other DSN fields defined in RFC3464
87 85 50       174 next unless exists $fieldtable->{ $o->[0] };
88 85         162 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
89              
90 85 100       198 next unless $f == 1;
91 32         93 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
92             }
93             } else {
94             # Continued line of the value of Diagnostic-Code field
95 12 100       35 next unless index($p, 'Diagnostic-Code:') == 0;
96 6 50       28 next unless $e =~ /\A[ \t]+(.+)\z/;
97 0         0 $v->{'diagnosis'} .= ' '.$1;
98             } # End of message/delivery-status
99             } continue {
100             # Save the current line for the next loop
101 461         615 $p = $e;
102             }
103 16 50       75 return undef unless $recipients;
104              
105 16         40 for my $e ( @$dscontents ) {
106             # Set default values if each value is empty.
107 16   33     89 $e->{'lhost'} ||= $permessage->{'rhost'};
108 16   0     110 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
      33        
109 16         101 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
110              
111 16         62 SESSION: for my $r ( keys %$refailures ) {
112             # Verify each regular expression of session errors
113 25 100       198 next unless $e->{'diagnosis'} =~ $refailures->{ $r };
114 16         38 $e->{'reason'} = $r;
115 16         40 last;
116             }
117             }
118 16         121 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
119             }
120              
121             1;
122             __END__