File Coverage

lib/Sisimai/Lhost/AmazonWorkMail.pm
Criterion Covered Total %
statement 63 69 91.3
branch 33 42 78.5
condition 9 22 40.9
subroutine 6 6 100.0
pod 2 2 100.0
total 113 141 80.1


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::AmazonWorkMail;
2 26     26   6208 use parent 'Sisimai::Lhost';
  26         66  
  26         149  
3 26     26   1913 use feature ':5.10';
  26         62  
  26         1750  
4 26     26   188 use strict;
  26         67  
  26         587  
5 26     26   122 use warnings;
  26         58  
  26         22353  
6              
7             # https://aws.amazon.com/workmail/
8 2     2 1 1164 sub description { 'Amazon WorkMail: https://aws.amazon.com/workmail/' }
9             sub make {
10             # Detect an error from Amazon WorkMail
11             # @param [Hash] mhead Message headers of a bounce email
12             # @param [String] mbody Message body of a bounce email
13             # @return [Hash] Bounce data list and message/rfc822 part
14             # @return [Undef] failed to parse or the arguments are missing
15             # @since v4.1.29
16 425     425 1 1086 my $class = shift;
17 425   100     1185 my $mhead = shift // return undef;
18 424   50     1136 my $mbody = shift // return undef;
19 424         642 my $match = 0;
20 424   100     2834 my $xmail = $mhead->{'x-original-mailer'} || $mhead->{'x-mailer'} || '';
21              
22             # X-Mailer: Amazon WorkMail
23             # X-Original-Mailer: Amazon WorkMail
24             # X-Ses-Outgoing: 2016.01.14-54.240.27.159
25 424 100       1198 $match++ if $mhead->{'x-ses-outgoing'};
26 424 100       1053 if( $xmail ) {
27             # X-Mailer: Amazon WorkMail
28             # X-Original-Mailer: Amazon WorkMail
29 63 100       201 $match++ if $xmail eq 'Amazon WorkMail';
30             }
31 424 100       1341 return undef if $match < 2;
32              
33 36         84 state $indicators = __PACKAGE__->INDICATORS;
34 36         59 state $rebackbone = qr|^content-type:[ ]message/rfc822|m;
35 36         92 state $startingof = { 'message' => ['Technical report:'] };
36              
37 36         812 require Sisimai::RFC1894;
38 36         202 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
39 36         80 my $permessage = {}; # (Hash) Store values of each Per-Message field
40              
41 36         120 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
42 36         227 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
43 36         78 my $readcursor = 0; # (Integer) Points the current cursor position
44 36         80 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
45 36         57 my $v = undef;
46              
47 36         761 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 1527 100       2303 unless( $readcursor ) {
51             # Beginning of the bounce message or message/delivery-status part
52 252 100       574 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
53 252         313 next;
54             }
55 1275 50       1938 next unless $readcursor & $indicators->{'deliverystatus'};
56 1275 100       1878 next unless length $e;
57              
58 1059 100       1759 if( my $f = Sisimai::RFC1894->match($e) ) {
59             # $e matched with any field defined in RFC3464
60 180 50       373 next unless my $o = Sisimai::RFC1894->field($e);
61 180         321 $v = $dscontents->[-1];
62              
63 180 100       436 if( $o->[-1] eq 'addr' ) {
    100          
64             # Final-Recipient: rfc822; kijitora@example.jp
65             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
66 36 50       139 if( $o->[0] eq 'final-recipient' ) {
67             # Final-Recipient: rfc822; kijitora@example.jp
68 36 50       124 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 36         95 $v->{'recipient'} = $o->[2];
74 36         91 $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 36         111 $v->{'spec'} = $o->[1];
83 36         98 $v->{'diagnosis'} = $o->[2];
84              
85             } else {
86             # Other DSN fields defined in RFC3464
87 108 50       290 next unless exists $fieldtable->{ $o->[0] };
88 108         266 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
89              
90 108 100       305 next unless $f == 1;
91 36         137 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
92             }
93             }
94              
95             #
96             #
97             #
98             #
99 987 100       1866 last if index($e, '') == 0;
100             }
101 36 50       230 return undef unless $recipients;
102              
103 36         101 for my $e ( @$dscontents ) {
104             # Set default values if each value is empty.
105 36   33     204 $e->{'lhost'} ||= $permessage->{'rhost'};
106 36   0     246 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
      33        
107 36         284 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
108              
109 36 50       169 if( $e->{'status'} =~ /\A[45][.][01][.]0\z/ ) {
110             # Get other D.S.N. value from the error message
111             # 5.1.0 - Unknown address error 550-'5.7.1 ...
112 0         0 my $errormessage = $e->{'diagnosis'};
113 0 0       0 $errormessage = $1 if $e->{'diagnosis'} =~ /["'](\d[.]\d[.]\d.+)['"]/;
114 0   0     0 $e->{'status'} = Sisimai::SMTP::Status->find($errormessage) || $e->{'status'};
115             }
116              
117             # 554 4.4.7 Message expired: unable to deliver in 840 minutes.
118             # <421 4.4.2 Connection timed out>
119 36 100       252 $e->{'replycode'} = $1 if $e->{'diagnosis'} =~ /[<]([245]\d\d)[ ].+[>]/;
120 36   50     302 $e->{'reason'} ||= Sisimai::SMTP::Status->name($e->{'status'}) || '';
      33        
121             }
122 36         342 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
123             }
124              
125             1;
126             __END__