File Coverage

lib/Sisimai/Lhost/SendGrid.pm
Criterion Covered Total %
statement 74 82 90.2
branch 40 52 76.9
condition 9 22 40.9
subroutine 6 6 100.0
pod 2 2 100.0
total 131 164 79.8


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::SendGrid;
2 16     16   5382 use parent 'Sisimai::Lhost';
  16         25  
  16         80  
3 16     16   851 use feature ':5.10';
  16         30  
  16         910  
4 16     16   65 use strict;
  16         35  
  16         263  
5 16     16   60 use warnings;
  16         28  
  16         15397  
6              
7 2     2 1 999 sub description { 'SendGrid: https://sendgrid.com/' }
8             sub make {
9             # Detect an error from SendGrid
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.0.2
15 224     224 1 651 my $class = shift;
16 224   100     555 my $mhead = shift // return undef;
17 223   50     424 my $mbody = shift // return undef;
18              
19             # Return-Path:
20             # X-Mailer: MIME-tools 5.502 (Entity 5.502)
21 223 100       588 return undef unless $mhead->{'return-path'};
22 137 100       388 return undef unless $mhead->{'return-path'} eq '';
23 16 50       49 return undef unless $mhead->{'subject'} eq 'Undelivered Mail Returned to Sender';
24              
25 16         277 state $indicators = __PACKAGE__->INDICATORS;
26 16         36 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
27 16         23 state $startingof = { 'message' => ['This is an automatically generated message from SendGrid.'] };
28              
29 16         61 require Sisimai::RFC1894;
30 16         49 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
31 16         30 my $permessage = {}; # (Hash) Store values of each Per-Message field
32              
33 16         60 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
34 16         51 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
35 16         37 my $readcursor = 0; # (Integer) Points the current cursor position
36 16         24 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
37 16         22 my $commandtxt = ''; # (String) SMTP Command name begin with the string '>>>'
38 16         23 my $v = undef;
39 16         25 my $p = '';
40              
41 16         130 for my $e ( split("\n", $emailsteak->[0]) ) {
42             # Read error messages and delivery status lines from the head of the email
43             # to the previous line of the beginning of the original message.
44 341 100       396 unless( $readcursor ) {
45             # Beginning of the bounce message or message/delivery-status part
46 48 100       154 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
47 48         57 next;
48             }
49 293 50       373 next unless $readcursor & $indicators->{'deliverystatus'};
50 293 100       339 next unless length $e;
51              
52 213 100       337 if( my $f = Sisimai::RFC1894->match($e) ) {
53             # $e matched with any field defined in RFC3464
54 96         151 my $o = Sisimai::RFC1894->field($e);
55 96         122 $v = $dscontents->[-1];
56              
57 96 100       137 unless( $o ) {
58             # Fallback code for empty value or invalid formatted value
59             # - Status: (empty)
60             # - Diagnostic-Code: 550 5.1.1 ... (No "diagnostic-type" sub field)
61 21 100       90 $v->{'diagnosis'} = $1 if $e =~ /\ADiagnostic-Code:[ ]*(.+)/;
62 21         35 next;
63             }
64              
65 75 100       180 if( $o->[-1] eq 'addr' ) {
    50          
    100          
66             # Final-Recipient: rfc822; kijitora@example.jp
67             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
68 32 100       74 if( $o->[0] eq 'final-recipient' ) {
69             # Final-Recipient: rfc822; kijitora@example.jp
70 16 50       45 if( $v->{'recipient'} ) {
71             # There are multiple recipient addresses in the message body.
72 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
73 0         0 $v = $dscontents->[-1];
74             }
75 16         30 $v->{'recipient'} = $o->[2];
76 16         34 $recipients++;
77              
78             } else {
79             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
80 16         50 $v->{'alias'} = $o->[2];
81             }
82             } elsif( $o->[-1] eq 'code' ) {
83             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
84 0         0 $v->{'spec'} = $o->[1];
85 0         0 $v->{'diagnosis'} = $o->[2];
86              
87             } elsif( $o->[-1] eq 'date' ) {
88             # Arrival-Date: 2012-12-31 23-59-59
89 16 50       81 next unless $e =~ /\AArrival-Date: (\d{4})[-](\d{2})[-](\d{2}) (\d{2})[-](\d{2})[-](\d{2})\z/;
90 16         62 $o->[1] .= 'Thu, '.$3.' ';
91 16         120 $o->[1] .= Sisimai::DateTime->monthname(0)->[int($2) - 1];
92 16         98 $o->[1] .= ' '.$1.' '.join(':', $4, $5, $6);
93 16         62 $o->[1] .= ' '.Sisimai::DateTime->abbr2tz('CDT');
94             } else {
95             # Other DSN fields defined in RFC3464
96 27 50       98 next unless exists $fieldtable->{ $o->[0] };
97 27         58 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
98              
99 27 50       76 next unless $f == 1;
100 0         0 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
101             }
102             } else {
103             # This is an automatically generated message from SendGrid.
104             #
105             # I'm sorry to have to tell you that your message was not able to be
106             # delivered to one of its intended recipients.
107             #
108             # If you require assistance with this, please contact SendGrid support.
109             #
110             # shironekochan:000000: : 192.0.2.250 : mx.example.jp:[192.0.2.153] :
111             # 550 5.1.1 ... User Unknown in RCPT TO
112             #
113             # ------------=_1351676802-30315-116783
114             # Content-Type: message/delivery-status
115             # Content-Disposition: inline
116             # Content-Transfer-Encoding: 7bit
117             # Content-Description: Delivery Report
118             #
119             # X-SendGrid-QueueID: 959479146
120             # X-SendGrid-Sender:
121 117 100       401 if( $e =~ /.+ in (?:End of )?([A-Z]{4}).*\z/ ) {
122             # in RCPT TO, in MAIL FROM, end of DATA
123 11         31 $commandtxt = $1;
124              
125             } else {
126             # Continued line of the value of Diagnostic-Code field
127 106 100       248 next unless index($p, 'Diagnostic-Code:') == 0;
128 5 50       43 next unless $e =~ /\A[ \t]+(.+)\z/;
129 5         20 $v->{'diagnosis'} .= ' '.$1;
130             }
131             }
132             } continue {
133             # Save the current line for the next loop
134 341         451 $p = $e;
135             }
136 16 50       65 return undef unless $recipients;
137              
138 16         37 for my $e ( @$dscontents ) {
139             # Get the value of SMTP status code as a pseudo D.S.N.
140 16         112 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
141 16 100       100 $e->{'status'} = $1.'.0.0' if $e->{'diagnosis'} =~ /\b([45])\d\d[ \t]*/;
142              
143 16 100 66     88 if( $e->{'status'} eq '5.0.0' || $e->{'status'} eq '4.0.0' ) {
144             # Get the value of D.S.N. from the error message or the value of
145             # Diagnostic-Code header.
146 11   33     74 $e->{'status'} = Sisimai::SMTP::Status->find($e->{'diagnosis'}) || $e->{'status'};
147             }
148              
149 16 50       51 if( $e->{'action'} eq 'expired' ) {
150             # Action: expired
151 0         0 $e->{'reason'} = 'expired';
152 0 0 0     0 if( ! $e->{'status'} || substr($e->{'status'}, -4, 4) eq '.0.0' ) {
153             # Set pseudo Status code value if the value of Status is not
154             # defined or 4.0.0 or 5.0.0.
155 0   0     0 $e->{'status'} = Sisimai::SMTP::Status->code('expired') || $e->{'status'};
156             }
157             }
158 16   33     85 $e->{'lhost'} ||= $permessage->{'rhost'};
159 16   66     68 $e->{'command'} ||= $commandtxt;
160             }
161 16         110 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
162             }
163              
164             1;
165             __END__