File Coverage

lib/Sisimai/Lhost/Yandex.pm
Criterion Covered Total %
statement 68 69 98.5
branch 31 38 81.5
condition 9 14 64.2
subroutine 6 6 100.0
pod 2 2 100.0
total 116 129 89.9


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Yandex;
2 25     25   5322 use parent 'Sisimai::Lhost';
  25         52  
  25         137  
3 25     25   1511 use feature ':5.10';
  25         49  
  25         1763  
4 25     25   153 use strict;
  25         45  
  25         482  
5 25     25   120 use warnings;
  25         45  
  25         20945  
6              
7 2     2 1 967 sub description { 'Yandex.Mail: https://www.yandex.ru' }
8             sub make {
9             # Detect an error from Yandex.Mail
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.6
15 277     277 1 851 my $class = shift;
16 277   100     886 my $mhead = shift // return undef;
17 276   50     761 my $mbody = shift // return undef;
18              
19             # X-Yandex-Front: mxback1h.mail.yandex.net
20             # X-Yandex-TimeMark: 1417885948
21             # X-Yandex-Uniq: 92309766-f1c8-4bd4-92bc-657c75766587
22             # X-Yandex-Spam: 1
23             # X-Yandex-Forward: 10104c00ad0726da5f37374723b1e0c8
24             # X-Yandex-Queue-ID: 367D79E130D
25             # X-Yandex-Sender: rfc822; shironeko@yandex.example.com
26 276 100       1022 return undef unless $mhead->{'x-yandex-uniq'};
27 16 50       68 return undef unless $mhead->{'from'} eq 'mailer-daemon@yandex.ru';
28              
29 16         48 state $indicators = __PACKAGE__->INDICATORS;
30 16         37 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
31 16         27 state $startingof = { 'message' => ['This is the mail system at host yandex.ru.'] };
32              
33 16         354 require Sisimai::RFC1894;
34 16         84 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
35 16         41 my $permessage = {}; # (Hash) Store values of each Per-Message field
36              
37 16         70 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
38 16         87 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
39 16         33 my $readcursor = 0; # (Integer) Points the current cursor position
40 16         30 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
41 16         28 my @commandset; # (Array) ``in reply to * command'' list
42 16         22 my $v = undef;
43 16         30 my $p = '';
44              
45 16         255 for my $e ( split("\n", $emailsteak->[0]) ) {
46             # Read error messages and delivery status lines from the head of the email
47             # to the previous line of the beginning of the original message.
48 621 100       813 unless( $readcursor ) {
49             # Beginning of the bounce message or message/delivery-status part
50 224 100       418 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
51 224         240 next;
52             }
53 397 50       657 next unless $readcursor & $indicators->{'deliverystatus'};
54 397 100       521 next unless length $e;
55              
56 307 100       533 if( my $f = Sisimai::RFC1894->match($e) ) {
57             # $e matched with any field defined in RFC3464
58 153 50       308 next unless my $o = Sisimai::RFC1894->field($e);
59 153         213 $v = $dscontents->[-1];
60              
61 153 100       280 if( $o->[-1] eq 'addr' ) {
    100          
62             # Final-Recipient: rfc822; kijitora@example.jp
63             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
64 42 100       123 if( $o->[0] eq 'final-recipient' ) {
65             # Final-Recipient: rfc822; kijitora@example.jp
66 21 100       62 if( $v->{'recipient'} ) {
67             # There are multiple recipient addresses in the message body.
68 5         21 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
69 5         13 $v = $dscontents->[-1];
70             }
71 21         44 $v->{'recipient'} = $o->[2];
72 21         40 $recipients++;
73              
74             } else {
75             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
76 21         60 $v->{'alias'} = $o->[2];
77             }
78             } elsif( $o->[-1] eq 'code' ) {
79             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
80 21         47 $v->{'spec'} = $o->[1];
81 21         52 $v->{'diagnosis'} = $o->[2];
82              
83             } else {
84             # Other DSN fields defined in RFC3464
85 90 50       170 next unless exists $fieldtable->{ $o->[0] };
86 90         181 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
87              
88 90 100       186 next unless $f == 1;
89 32         112 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
90             }
91             } else {
92             # The line does not begin with a DSN field defined in RFC3464
93             # : host mx.example.jp[192.0.2.153] said: 550
94             # 5.1.1 ... User Unknown (in reply to RCPT TO
95             # command)
96 154 100       419 if( $e =~ /[ \t][(]in reply to .*([A-Z]{4}).*/ ) {
    50          
97             # 5.1.1 ... User Unknown (in reply to RCPT TO
98 16         49 push @commandset, $1;
99              
100             } elsif( $e =~ /([A-Z]{4})[ \t]*.*command[)]\z/ ) {
101             # to MAIL command)
102 0         0 push @commandset, $1;
103              
104             } else {
105             # Continued line of the value of Diagnostic-Code field
106 138 100       266 next unless index($p, 'Diagnostic-Code:') == 0;
107 5 50       27 next unless $e =~ /\A[ \t]+(.+)\z/;
108 5         24 $v->{'diagnosis'} .= ' '.$1;
109             }
110             }
111             } continue {
112             # Save the current line for the next loop
113 621         803 $p = $e;
114             }
115 16 50       104 return undef unless $recipients;
116              
117 16         34 for my $e ( @$dscontents ) {
118             # Set default values if each value is empty.
119 21   33     102 $e->{'lhost'} ||= $permessage->{'rhost'};
120 21   50     158 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
      66        
121 21   100     80 $e->{'command'} = shift @commandset || '';
122 21         44 $e->{'diagnosis'} =~ y/\n/ /;
123 21         131 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
124             }
125 16         123 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
126             }
127              
128             1;
129             __END__