File Coverage

lib/Sisimai/Lhost/X5.pm
Criterion Covered Total %
statement 64 70 91.4
branch 29 42 69.0
condition 6 10 60.0
subroutine 6 6 100.0
pod 2 2 100.0
total 107 130 82.3


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::X5;
2 17     17   6140 use parent 'Sisimai::Lhost';
  17         38  
  17         112  
3 17     17   1050 use feature ':5.10';
  17         44  
  17         1151  
4 17     17   93 use strict;
  17         24  
  17         338  
5 17     17   74 use warnings;
  17         54  
  17         15511  
6              
7 2     2 1 1226 sub description { 'Unknown MTA #5' }
8             sub make {
9             # Detect an error from Unknown MTA #5
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.13.0
15 202     202 1 681 my $class = shift;
16 202   100     569 my $mhead = shift // return undef;
17 201   50     548 my $mbody = shift // return undef;
18 201         286 my $match = 0;
19 201         354 my $plain = '';
20              
21 201 100 66     1927 $match++ if defined $mhead->{'to'} && rindex($mhead->{'to'}, 'NotificationRecipients') > -1;
22 201 100       627 if( rindex($mhead->{'from'}, 'TWFpbCBEZWxpdmVyeSBTdWJzeXN0ZW0') > -1 ) {
23             # From: "=?iso-2022-jp?B?TWFpbCBEZWxpdmVyeSBTdWJzeXN0ZW0=?=" <...>
24             # Mail Delivery Subsystem
25 5         21 for my $f ( split(' ', $mhead->{'from'}) ) {
26             # Check each element of From: header
27 5 50       24 next unless Sisimai::MIME->is_mimeencoded(\$f);
28 5 50       34 $match++ if rindex(Sisimai::MIME->mimedecode([$f]), 'Mail Delivery Subsystem') > -1;
29 5         22 last;
30             }
31             }
32              
33 201 50       722 if( Sisimai::MIME->is_mimeencoded(\$mhead->{'subject'}) ) {
34             # Subject: =?iso-2022-jp?B?UmV0dXJuZWQgbWFpbDogVXNlciB1bmtub3du?=
35 0         0 $plain = Sisimai::MIME->mimedecode([$mhead->{'subject'}]);
36 0 0       0 $match++ if rindex($plain, 'Mail Delivery Subsystem') > -1;
37             }
38 201 100       1752 return undef if $match < 2;
39              
40 5         51 state $indicators = __PACKAGE__->INDICATORS;
41 5         16 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
42 5         14 state $startingof = { 'message' => ['Content-Type: message/delivery-status'] };
43              
44 5         340 require Sisimai::RFC1894;
45 5         27 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
46 5         36 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
47 5         19 my $readcursor = 0; # (Integer) Points the current cursor position
48 5         7 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
49 5         11 my $v = undef;
50 5         10 my $p = '';
51              
52             # Pick the second message/rfc822 part because the format of email-x5-*.eml
53             # is nested structure
54 5         70 my $prefillets = [split($rebackbone, $$mbody, 2)];
55 5         62 $prefillets->[1] =~ s/\A.+?\n\n//ms;
56 5         35 my $emailsteak = Sisimai::RFC5322->fillet(\$prefillets->[1], $rebackbone);
57              
58 5         89 for my $e ( split("\n", $emailsteak->[0]) ) {
59             # Read error messages and delivery status lines from the head of the email
60             # to the previous line of the beginning of the original message.
61 125 100       170 unless( $readcursor ) {
62             # Beginning of the bounce message or message/delivery-status part
63 60 100       123 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
64 60         64 next;
65             }
66 65 50       124 next unless $readcursor & $indicators->{'deliverystatus'};
67 65 100       112 next unless length $e;
68              
69 50         54 $v = $dscontents->[-1];
70 50 100       95 if( Sisimai::RFC1894->match($e) ) {
71             # $e matched with any field defined in RFC3464
72 45 50       97 next unless my $o = Sisimai::RFC1894->field($e);
73 45         68 $v = $dscontents->[-1];
74              
75 45 100       124 if( $o->[-1] eq 'addr' ) {
    100          
76             # Final-Recipient: rfc822; kijitora@example.jp
77             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
78 10 100       34 if( $o->[0] eq 'final-recipient' ) {
79             # Final-Recipient: rfc822; kijitora@example.jp
80 5 50       280 if( $v->{'recipient'} ) {
81             # There are multiple recipient addresses in the message body.
82 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
83 0         0 $v = $dscontents->[-1];
84             }
85 5         14 $v->{'recipient'} = $o->[2];
86 5         14 $recipients++;
87              
88             } else {
89             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
90 5         19 $v->{'alias'} = $o->[2];
91             }
92             } elsif( $o->[-1] eq 'code' ) {
93             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
94 5         55 $v->{'spec'} = $o->[1];
95 5         22 $v->{'diagnosis'} = $o->[2];
96              
97             } else {
98             # Other DSN fields defined in RFC3464
99 30 50       70 next unless exists $fieldtable->{ $o->[0] };
100 30         77 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
101             }
102             } else {
103             # Continued line of the value of Diagnostic-Code field
104 5 50       43 next unless index($p, 'Diagnostic-Code:') == 0;
105 0 0       0 next unless $e =~ /\A[ \t]+(.+)\z/;
106 0         0 $v->{'diagnosis'} .= ' '.$1;
107             }
108             } continue {
109             # Save the current line for the next loop
110 125         171 $p = $e;
111             }
112 5 50       25 return undef unless $recipients;
113              
114 5   33     26 $_->{'diagnosis'} ||= Sisimai::String->sweep($_->{'diagnosis'}) for @$dscontents;
115 5         36 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
116             }
117              
118             1;
119             __END__