File Coverage

lib/Sisimai/Lhost/Outlook.pm
Criterion Covered Total %
statement 78 81 96.3
branch 38 46 82.6
condition 8 12 66.6
subroutine 6 6 100.0
pod 2 2 100.0
total 132 147 89.8


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Outlook;
2 25     25   5404 use parent 'Sisimai::Lhost';
  25         54  
  25         155  
3 25     25   1509 use feature ':5.10';
  25         51  
  25         1640  
4 25     25   150 use strict;
  25         49  
  25         557  
5 25     25   134 use warnings;
  25         58  
  25         22954  
6              
7 2     2 1 979 sub description { 'Microsoft Outlook.com: https://www.outlook.com/' }
8             sub make {
9             # Detect an error from Microsoft Outlook.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.3
15 618     618 1 1479 my $class = shift;
16 618   100     1542 my $mhead = shift // return undef;
17 617   50     1386 my $mbody = shift // return undef;
18 617         864 my $match = 0;
19              
20             # X-Message-Delivery: Vj0xLjE7RD0wO0dEPTA7U0NMPTk7bD0xO3VzPTE=
21             # X-Message-Info: AuEzbeVr9u5fkDpn2vR5iCu5wb6HBeY4iruBjnutBzpStnUabbM...
22 617 100       2229 $match++ if index($mhead->{'subject'}, 'Delivery Status Notification') > -1;
23 617 100       1621 $match++ if $mhead->{'x-message-delivery'};
24 617 100       1710 $match++ if $mhead->{'x-message-info'};
25 617 100       971 $match++ if grep { rindex($_, '.hotmail.com') > -1 } @{ $mhead->{'received'} };
  1151         3756  
  617         1542  
26 617 100       2382 return undef if $match < 2;
27              
28 41         97 state $indicators = __PACKAGE__->INDICATORS;
29 41         88 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
30 41         77 state $startingof = { 'message' => ['This is an automatically generated Delivery Status Notification'] };
31 41         82 state $messagesof = {
32             'hostunknown' => ['The mail could not be delivered to the recipient because the domain is not reachable'],
33             'userunknown' => ['Requested action not taken: mailbox unavailable'],
34             };
35              
36 41         452 require Sisimai::RFC1894;
37 41         228 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
38 41         114 my $permessage = {}; # (Hash) Store values of each Per-Message field
39              
40 41         181 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
41 41         222 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
42 41         85 my $readcursor = 0; # (Integer) Points the current cursor position
43 41         79 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
44 41         75 my $v = undef;
45 41         82 my $p = '';
46              
47 41         379 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 783 100       1108 unless( $readcursor ) {
51             # Beginning of the bounce message or message/delivery-status part
52 164 100       551 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
53 164         189 next;
54             }
55 619 50       966 next unless $readcursor & $indicators->{'deliverystatus'};
56 619 100       872 next unless length $e;
57              
58 440 100       791 if( my $f = Sisimai::RFC1894->match($e) ) {
59             # $e matched with any field defined in RFC3464
60 297 50       543 next unless my $o = Sisimai::RFC1894->field($e);
61 297         409 $v = $dscontents->[-1];
62              
63 297 100       583 if( $o->[-1] eq 'addr' ) {
    100          
64             # Final-Recipient: rfc822; kijitora@example.jp
65             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
66 46 50       145 if( $o->[0] eq 'final-recipient' ) {
67             # Final-Recipient: rfc822; kijitora@example.jp
68 46 100       152 if( $v->{'recipient'} ) {
69             # There are multiple recipient addresses in the message body.
70 5         20 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
71 5         17 $v = $dscontents->[-1];
72             }
73 46         104 $v->{'recipient'} = $o->[2];
74 46         97 $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         98 $v->{'spec'} = $o->[1];
83 36         111 $v->{'diagnosis'} = $o->[2];
84              
85             } else {
86             # Other DSN fields defined in RFC3464
87 215 50       436 next unless exists $fieldtable->{ $o->[0] };
88 215         386 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
89              
90 215 100       778 next unless $f == 1;
91 123         364 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
92             }
93             } else {
94             # Continued line of the value of Diagnostic-Code field
95 143 50       308 next unless index($p, 'Diagnostic-Code:') == 0;
96 0 0       0 next unless $e =~ /\A[ \t]+(.+)\z/;
97 0         0 $v->{'diagnosis'} .= ' '.$1;
98             }
99             } continue {
100             # Save the current line for the next loop
101 783         1139 $p = $e;
102             }
103 41 50       176 return undef unless $recipients;
104              
105 41         142 for my $e ( @$dscontents ) {
106             # Set default values if each value is empty.
107 46   66     153 $e->{'lhost'} ||= $permessage->{'rhost'};
108 46   50     338 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
      66        
109 46         320 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
110              
111 46 100       152 unless( $e->{'diagnosis'} ) {
112             # No message in 'diagnosis'
113 10 100       45 if( $e->{'action'} eq 'delayed' ) {
114             # Set pseudo diagnostic code message for delaying
115 5         15 $e->{'diagnosis'} = 'Delivery to the following recipients has been delayed.';
116              
117             } else {
118             # Set pseudo diagnostic code message
119 5         12 $e->{'diagnosis'} = 'Unable to deliver message to the following recipients, ';
120 5         18 $e->{'diagnosis'} .= 'due to being unable to connect successfully to the destination mail server.';
121             }
122             }
123              
124 46         161 SESSION: for my $r ( keys %$messagesof ) {
125             # Verify each regular expression of session errors
126 87 100       115 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
  87         374  
  87         174  
127 10         29 $e->{'reason'} = $r;
128 10         28 last;
129             }
130             }
131 41         339 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
132             }
133              
134             1;
135             __END__