File Coverage

lib/Sisimai/RFC3464.pm
Criterion Covered Total %
statement 130 141 92.2
branch 90 114 78.9
condition 40 62 64.5
subroutine 6 6 100.0
pod 2 2 100.0
total 268 325 82.4


line stmt bran cond sub pod time code
1             package Sisimai::RFC3464;
2 12     12   4745 use feature ':5.10';
  12         27  
  12         877  
3 12     12   66 use strict;
  12         27  
  12         222  
4 12     12   69 use warnings;
  12         23  
  12         271  
5 12     12   62 use Sisimai::Lhost;
  12         19  
  12         38275  
6              
7             # http://tools.ietf.org/html/rfc3464
8 2     2 1 1280 sub description { 'Fallback Module for MTAs' };
9             sub make {
10             # Detect an error for RFC3464
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 182     182 1 891 my $class = shift;
16 182   100     586 my $mhead = shift // return undef;
17 181   50     429 my $mbody = shift // return undef;
18 181         280 my $match = 0;
19              
20 181 50       552 return undef unless keys %$mhead;
21 181 50       597 return undef unless ref $mbody eq 'SCALAR';
22              
23 181         450 state $indicators = Sisimai::Lhost->INDICATORS;
24 181         428 state $markingsof = {
25             'command' => qr/[ ](RCPT|MAIL|DATA)[ ]+command\b/,
26             'message' => qr{\A(?>
27             content-type:[ ]*(?:
28             message/x?delivery-status
29             |message/disposition-notification
30             |text/plain;[ ]charset=
31             )
32             |the[ ]original[ ]message[ ]was[ ]received[ ]at[ ]
33             |this[ ]report[ ]relates[ ]to[ ]your[ ]message
34             |your[ ]message[ ](?:
35             could[ ]not[ ]be[ ]delivered
36             |was[ ]not[ ]delivered[ ]to[ ]the[ ]following[ ]recipients
37             )
38             )
39             }x,
40             'error' => qr/\A(?:[45]\d\d[ \t]+|[<][^@]+[@][^@]+[>]:?[ \t]+)/,
41             'rfc822' => qr{\A(?>
42             content-type:[ ]*(?:message/rfc822|text/rfc822-headers)
43             |return-path:[ ]*[<].+[>]
44             )\z
45             }x,
46             };
47              
48 181         749 my $dscontents = [Sisimai::Lhost->DELIVERYSTATUS];
49 181         422 my $rfc822text = ''; # (String) message/rfc822 part text
50 181         315 my $maybealias = ''; # (String) Original-Recipient field
51 181         320 my $blanklines = 0; # (Integer) The number of blank lines
52 181         247 my $readcursor = 0; # (Integer) Points the current cursor position
53 181         305 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
54 181         310 my $itisbounce = 0; # (Integer) Flag for that an email is a bounce
55 181         658 my $connheader = {
56             'date' => '', # The value of Arrival-Date header
57             'rhost' => '', # The value of Reporting-MTA header
58             'lhost' => '', # The value of Received-From-MTA header
59             };
60 181         311 my $v = undef;
61 181         356 my $p = '';
62              
63 181         2677 for my $e ( split("\n", $$mbody) ) {
64             # Read each line between the start of the message and the start of rfc822 part.
65 6603         8517 my $d = lc $e;
66 6603 100       8706 unless( $readcursor ) {
67             # Beginning of the bounce message or message/delivery-status part
68 2272 100       7458 if( $d =~ $markingsof->{'message'} ) {
69 117         286 $readcursor |= $indicators->{'deliverystatus'};
70 117         235 next;
71             }
72             }
73              
74 6486 100       9854 unless( $readcursor & $indicators->{'message-rfc822'} ) {
75             # Beginning of the original message part(message/rfc822)
76 4148 100       12141 if( $d =~ $markingsof->{'rfc822'} ) {
77 124         253 $readcursor |= $indicators->{'message-rfc822'};
78 124         207 next;
79             }
80             }
81              
82 6362 100       9041 if( $readcursor & $indicators->{'message-rfc822'} ) {
83             # message/rfc822 OR text/rfc822-headers part
84 2338 100       3141 unless( length $e ) {
85 195 100       568 last if ++$blanklines > 1;
86 114         153 next;
87             }
88 2143         3760 $rfc822text .= sprintf("%s\n", $e);
89              
90             } else {
91             # message/delivery-status part
92 4024 100       5901 next unless $readcursor & $indicators->{'deliverystatus'};
93 1902 100       2730 next unless length $e;
94              
95 1479         1605 $v = $dscontents->[-1];
96 1479 100       6612 if( $e =~ /\A(Original|Final)-[Rr]ecipient:[ ]*.+;[ ]*([^ ]+)\z/ ) {
    50          
    100          
    100          
    50          
    100          
    100          
97             # 2.3.2 Final-Recipient field
98             # The Final-Recipient field indicates the recipient for which this set
99             # of per-recipient fields applies. This field MUST be present in each
100             # set of per-recipient data.
101             # The syntax of the field is as follows:
102             #
103             # final-recipient-field =
104             # "Final-Recipient" ":" address-type ";" generic-address
105             #
106             # 2.3.1 Original-Recipient field
107             # The Original-Recipient field indicates the original recipient address
108             # as specified by the sender of the message for which the DSN is being
109             # issued.
110             #
111             # original-recipient-field =
112             # "Original-Recipient" ":" address-type ";" generic-address
113             #
114             # generic-address = *text
115 158 100       474 if( $1 eq 'Original' ) {
116             # Original-Recipient: ...
117 37         109 $maybealias = $2;
118              
119             } else {
120             # Final-Recipient: ...
121 121   100     492 my $x = $v->{'recipient'} || '';
122 121         807 my $y = Sisimai::Address->s3s4($2);
123 121 50       566 $y = $maybealias unless Sisimai::RFC5322->is_emailaddress($y);
124              
125 121 100 66     538 if( $x && $x ne $y ) {
126             # There are multiple recipient addresses in the message body.
127 10         35 push @$dscontents, Sisimai::Lhost->DELIVERYSTATUS;
128 10         24 $v = $dscontents->[-1];
129             }
130 121         263 $v->{'recipient'} = $y;
131 121         250 $recipients++;
132 121   100     514 $itisbounce ||= 1;
133              
134 121   66     521 $v->{'alias'} ||= $maybealias;
135 121         250 $maybealias = '';
136             }
137             } elsif( $e =~ /\AX-Actual-Recipient:[ ]*(?:RFC|rfc)822;[ ]*([^ ]+)\z/ ) {
138             # X-Actual-Recipient: RFC822; |IFS=' ' && exec procmail -f- || exit 75 ...
139             # X-Actual-Recipient: rfc822; kijitora@neko.example.jp
140 0 0       0 $v->{'alias'} = $1 unless $1 =~ /[ \t]+/;
141              
142             } elsif( $e =~ /\AAction:[ ]*(.+)\z/ ) {
143             # 2.3.3 Action field
144             # The Action field indicates the action performed by the Reporting-MTA
145             # as a result of its attempt to deliver the message to this recipient
146             # address. This field MUST be present for each recipient named in the
147             # DSN.
148             # The syntax for the action-field is:
149             #
150             # action-field = "Action" ":" action-value
151             # action-value =
152             # "failed" / "delayed" / "delivered" / "relayed" / "expanded"
153             #
154             # The action-value may be spelled in any combination of upper and lower
155             # case characters.
156 121         421 $v->{'action'} = lc $1;
157 121 50       417 $v->{'action'} = $1 if $v->{'action'} =~ /\A([^ ]+)[ ]/; # failed (bad destination mailbox address)
158              
159             } elsif( $e =~ /\AStatus:[ ]*(\d[.]\d+[.]\d+)/ ) {
160             # 2.3.4 Status field
161             # The per-recipient Status field contains a transport-independent
162             # status code that indicates the delivery status of the message to that
163             # recipient. This field MUST be present for each delivery attempt
164             # which is described by a DSN.
165             #
166             # The syntax of the status field is:
167             #
168             # status-field = "Status" ":" status-code
169             # status-code = DIGIT "." 1*3DIGIT "." 1*3DIGIT
170 121         343 $v->{'status'} = $1;
171              
172             } elsif( $e =~ /\AStatus:[ ]*(\d+[ ]+.+)\z/ ) {
173             # Status: 553 Exceeded maximum inbound message size
174 0         0 $v->{'alterrors'} = $1;
175              
176             } elsif( $e =~ /Remote-MTA:[ ]*(?:DNS|dns);[ ]*(.+)\z/ ) {
177             # 2.3.5 Remote-MTA field
178             # The value associated with the Remote-MTA DSN field is a printable
179             # ASCII representation of the name of the "remote" MTA that reported
180             # delivery status to the "reporting" MTA.
181             #
182             # remote-mta-field = "Remote-MTA" ":" mta-name-type ";" mta-name
183             #
184             # NOTE: The Remote-MTA field preserves the "while talking to"
185             # information that was provided in some pre-existing nondelivery
186             # reports.
187             #
188             # This field is optional. It MUST NOT be included if no remote MTA was
189             # involved in the attempted delivery of the message to that recipient.
190 38         141 $v->{'rhost'} = lc $1;
191              
192             } elsif( $e =~ /\ALast-Attempt-Date:[ ]*(.+)\z/ ) {
193             # 2.3.7 Last-Attempt-Date field
194             # The Last-Attempt-Date field gives the date and time of the last
195             # attempt to relay, gateway, or deliver the message (whether successful
196             # or unsuccessful) by the Reporting MTA. This is not necessarily the
197             # same as the value of the Date field from the header of the message
198             # used to transmit this delivery status notification: In cases where
199             # the DSN was generated by a gateway, the Date field in the message
200             # header contains the time the DSN was sent by the gateway and the DSN
201             # Last-Attempt-Date field contains the time the last delivery attempt
202             # occurred.
203             #
204             # last-attempt-date-field = "Last-Attempt-Date" ":" date-time
205 36         120 $v->{'date'} = $1;
206              
207             } else {
208 1005 100 100     3205 if( $e =~ /\ADiagnostic-Code:[ ]*(.+?);[ ]*(.+)\z/ ) {
    100          
    100          
209             # 2.3.6 Diagnostic-Code field
210             # For a "failed" or "delayed" recipient, the Diagnostic-Code DSN field
211             # contains the actual diagnostic code issued by the mail transport.
212             # Since such codes vary from one mail transport to another, the
213             # diagnostic-type sub-field is needed to specify which type of
214             # diagnostic code is represented.
215             #
216             # diagnostic-code-field =
217             # "Diagnostic-Code" ":" diagnostic-type ";" *text
218 79         296 $v->{'spec'} = uc $1;
219 79         213 $v->{'diagnosis'} = $2;
220              
221             } elsif( $e =~ /\ADiagnostic-Code:[ ]*(.+)\z/ ) {
222             # No value of "diagnostic-type"
223             # Diagnostic-Code: 554 ...
224 5         20 $v->{'diagnosis'} = $1;
225              
226             } elsif( index($p, 'Diagnostic-Code:') == 0 && $e =~ /\A[ \t]+(.+)\z/ ) {
227             # Continued line of the value of Diagnostic-Code header
228 26         100 $v->{'diagnosis'} .= ' '.$1;
229 26         76 $e = 'Diagnostic-Code: '.$e;
230              
231             } else {
232 895 100       2804 if( $e =~ /\AReporting-MTA:[ ]*(?:DNS|dns);[ ]*(.+)\z/ ) {
    100          
    100          
233             # 2.2.2 The Reporting-MTA DSN field
234             #
235             # reporting-mta-field =
236             # "Reporting-MTA" ":" mta-name-type ";" mta-name
237             # mta-name = *text
238             #
239             # The Reporting-MTA field is defined as follows:
240             #
241             # A DSN describes the results of attempts to deliver, relay, or gateway
242             # a message to one or more recipients. In all cases, the Reporting-MTA
243             # is the MTA that attempted to perform the delivery, relay, or gateway
244             # operation described in the DSN. This field is required.
245 111   33     833 $connheader->{'rhost'} ||= lc $1;
246              
247             } elsif( $e =~ /\AReceived-From-MTA:[ ]*(?:DNS|dns);[ ]*(.+)\z/ ) {
248             # 2.2.4 The Received-From-MTA DSN field
249             # The optional Received-From-MTA field indicates the name of the MTA
250             # from which the message was received.
251             #
252             # received-from-mta-field =
253             # "Received-From-MTA" ":" mta-name-type ";" mta-name
254             #
255             # If the message was received from an Internet host via SMTP, the
256             # contents of the mta-name sub-field SHOULD be the Internet domain name
257             # supplied in the HELO or EHLO command, and the network address used by
258             # the SMTP client SHOULD be included as a comment enclosed in
259             # parentheses. (In this case, the MTA-name-type will be "dns".)
260 50         173 $connheader->{'lhost'} = lc $1;
261              
262             } elsif( $e =~ /\AArrival-Date:[ ]*(.+)\z/ ) {
263             # 2.2.5 The Arrival-Date DSN field
264             # The optional Arrival-Date field indicates the date and time at which
265             # the message arrived at the Reporting MTA. If the Last-Attempt-Date
266             # field is also provided in a per-recipient field, this can be used to
267             # determine the interval between when the message arrived at the
268             # Reporting MTA and when the report was issued for that recipient.
269             #
270             # arrival-date-field = "Arrival-Date" ":" date-time
271 88         310 $connheader->{'date'} = $1;
272              
273             } else {
274             # Get error message
275 646 100       1342 next if $e =~ /\A[ -]+/;
276 490 100       1757 next unless $e =~ $markingsof->{'error'};
277              
278             # 500 User Unknown
279             # Unknown
280 29         199 $v->{'alterrors'} .= ' '.$e;
281             }
282             }
283             }
284             } # End of message/delivery-status
285             } continue {
286             # Save the current line for the next loop
287 6522         9079 $p = $e;
288             }
289              
290             BODY_PARSER_FOR_FALLBACK: {
291             # Fallback, parse entire message body
292 181 100       784 last if $recipients;
  181         455  
293              
294             # Failed to get a recipient address at code above
295 70 100 50     597 $match ||= 1 if lc($mhead->{'from'}) =~ /\b(?:postmaster|mailer-daemon|root)[@]/;
296 70 100 50     794 $match ||= 1 if lc($mhead->{'subject'}) =~ qr{(?>
297             delivery[ ](?:failed|failure|report)
298             |failure[ ]notice
299             |mail[ ](?:delivery|error)
300             |non[-]delivery
301             |returned[ ]mail
302             |undeliverable[ ]mail
303             |warning:[ ]
304             )
305             }x;
306 70 100       286 if( defined $mhead->{'return-path'} ) {
307             # Check the value of Return-Path of the message
308 50 100 100     399 $match ||= 1 if lc($mhead->{'return-path'}) =~ /(?:[<][>]|mailer-daemon)/;
309             }
310 70 100       220 last unless $match;
311              
312 23         47 state $re_skip = qr{(?>
313             \A[-]+=
314             |\A\s+\z
315             |\A\s*--
316             |\A\s+[=]\d+
317             |\Ahi[ ][!]
318             |content-(?:description|disposition|transfer-encoding|type):[ ]
319             |(?:name|charset)=
320             |--\z
321             |:[ ]--------
322             )
323             }x;
324 23         42 state $re_stop = qr{(?:
325             \A[*][*][*][ ].+[ ].+[ ][*][*][*]
326             |\Acontent-type:[ ]message/delivery-status
327             |\Ahere[ ]is[ ]a[ ]copy[ ]of[ ]the[ ]first[ ]part[ ]of[ ]the[ ]message
328             |\Athe[ ]non-delivered[ ]message[ ]is[ ]attached[ ]to[ ]this[ ]message.
329             |\Areceived:[ \t]*
330             |\Areceived-from-mta:[ \t]*
331             |\Areporting-mta:[ \t]*
332             |\Areturn-path:[ \t]*
333             |\Aa[ ]copy[ ]of[ ]the[ ]original[ ]message[ ]below[ ]this[ ]line:
334             |attachment[ ]is[ ]a[ ]copy[ ]of[ ]the[ ]message
335             |below[ ]is[ ]a[ ]copy[ ]of[ ]the[ ]original[ ]message:
336             |below[ ]this[ ]line[ ]is[ ]a[ ]copy[ ]of[ ]the[ ]message
337             |message[ ]contains[ ].+[ ]file[ ]attachments
338             |message[ ]text[ ]follows:[ ]
339             |original[ ]message[ ]follows
340             |the[ ]attachment[ ]contains[ ]the[ ]original[ ]mail[ ]headers
341             |the[ ]first[ ]\d+[ ]lines[ ]
342             |unsent[ ]message[ ]below
343             |your[ ]message[ ]reads[ ][(]in[ ]part[)]:
344             )
345             }x;
346 23         42 state $re_addr = qr{(?:
347             \A\s*
348             |\A["].+["]\s*
349             |\A[ \t]*recipient:[ \t]*
350             |\A[ ]*address:[ ]
351             |addressed[ ]to[ ]
352             |could[ ]not[ ]be[ ]delivered[ ]to:[ ]
353             |delivered[ ]to[ ]+
354             |delivery[ ]failed:[ ]
355             |did[ ]not[ ]reach[ ]the[ ]following[ ]recipient:[ ]
356             |error-for:[ ]+
357             |failed[ ]recipient:[ ]
358             |failed[ ]to[ ]deliver[ ]to[ ]
359             |intended[ ]recipient:[ ]
360             |mailbox[ ]is[ ]full:[ ]
361             |rcpt[ ]to:
362             |smtp[ ]server[ ][<].+[>][ ]rejected[ ]recipient[ ]
363             |the[ ]following[ ]recipients[ ]returned[ ]permanent[ ]errors:[ ]
364             |the[ ]following[ ]message[ ]to[ ]
365             |unknown[ ]user:[ ]
366             |undeliverable[ ]to[ ]
367             |undeliverable[ ]address:[ ]*
368             |you[ ]sent[ ]mail[ ]to[ ]
369             |your[ ]message[ ]to[ ]
370             )
371             ['"]?[<]?([^\s\n\r@=<>]+[@][-.0-9a-z]+[.][0-9a-z]+)[>]?['"]?
372             }x;
373              
374 23         45 my $b = $dscontents->[-1];
375 23         174 for my $e ( split("\n", $$mbody) ) {
376             # Get the recipient's email address and error messages.
377 152         243 my $d = lc $e;
378 152 100       466 last if $d =~ $markingsof->{'rfc822'};
379 151 100       1888 last if $d =~ $re_stop;
380              
381 146 100       250 next unless length $e;
382 107 100       1730 next if $d =~ $re_skip;
383 89 50       222 next if index($e, '*') == 0;
384              
385 89 100       580 if( $d =~ $re_addr ) {
    50          
386             # May be an email address
387 20   50     114 my $x = $b->{'recipient'} || '';
388 20         154 my $y = Sisimai::Address->s3s4($1);
389 20 50       123 next unless Sisimai::RFC5322->is_emailaddress($y);
390              
391 20 50 33     82 if( $x && $x ne $y ) {
392             # There are multiple recipient addresses in the message body.
393 0         0 push @$dscontents, Sisimai::Lhost->DELIVERYSTATUS;
394 0         0 $b = $dscontents->[-1];
395             }
396 20         38 $b->{'recipient'} = $y;
397 20         38 $recipients++;
398 20   50     78 $itisbounce ||= 1;
399              
400             } elsif( $e =~ /[(](?:expanded|generated)[ ]from:?[ ]([^@]+[@][^@]+)[)]/ ) {
401             # (expanded from: neko@example.jp)
402 0         0 $b->{'alias'} = Sisimai::Address->s3s4($1);
403             }
404 89         256 $b->{'diagnosis'} .= ' '.$e;
405             }
406             } # END OF BODY_PARSER_FOR_FALLBACK
407 181 100       773 return undef unless $itisbounce;
408              
409 131 50 33     467 if( $recipients == 0 && $rfc822text =~ /^To:[ ]*(.+)/m ) {
410             # Try to get a recipient address from "To:" header of the original message
411 0 0       0 if( my $r = Sisimai::Address->find($1, 1) ) {
412             # Found a recipient address
413 0 0       0 push @$dscontents, Sisimai::Lhost->DELIVERYSTATUS if scalar(@$dscontents) == $recipients;
414 0         0 my $b = $dscontents->[-1];
415 0         0 $b->{'recipient'} = $r->[0]->{'address'};
416 0         0 $recipients++;
417             }
418             }
419 131 50       345 return undef unless $recipients;
420              
421 131         2836 require Sisimai::MDA;
422 131         968 my $mdabounced = Sisimai::MDA->make($mhead, $mbody);
423 131         386 for my $e ( @$dscontents ) {
424             # Set default values if each value is empty.
425 141   100     1824 $e->{ $_ } ||= $connheader->{ $_ } || '' for keys %$connheader;
      100        
426              
427 141 50 66     592 if( exists $e->{'alterrors'} && $e->{'alterrors'} ) {
428             # Copy alternative error message
429 29   66     118 $e->{'diagnosis'} ||= $e->{'alterrors'};
430 29 50 33     224 if( index($e->{'diagnosis'}, '-') == 0 || substr($e->{'diagnosis'}, -2, 2) eq '__') {
431             # Override the value of diagnostic code message
432 0 0       0 $e->{'diagnosis'} = $e->{'alterrors'} if $e->{'alterrors'};
433             }
434 29         60 delete $e->{'alterrors'};
435             }
436 141         807 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
437              
438 141 100       407 if( $mdabounced ) {
439             # Make bounce data by the values returned from Sisimai::MDA->make()
440 12   50     60 $e->{'agent'} = $mdabounced->{'mda'} || 'RFC3464';
441 12   50     51 $e->{'reason'} = $mdabounced->{'reason'} || 'undefined';
442 12 50       45 $e->{'diagnosis'} = $mdabounced->{'message'} if $mdabounced->{'message'};
443 12         29 $e->{'command'} = '';
444             }
445 141   66     546 $e->{'date'} ||= $mhead->{'date'};
446 141   50     491 $e->{'status'} ||= Sisimai::SMTP::Status->find($e->{'diagnosis'}) || '';
      66        
447 141 50       870 $e->{'command'} = $1 if $e->{'diagnosis'} =~ $markingsof->{'command'};
448             }
449 131         1100 return { 'ds' => $dscontents, 'rfc822' => $rfc822text };
450             }
451              
452             1;
453             __END__