File Coverage

lib/Sisimai/Lhost/MailFoundry.pm
Criterion Covered Total %
statement 48 50 96.0
branch 20 26 76.9
condition 3 4 75.0
subroutine 6 6 100.0
pod 2 2 100.0
total 79 88 89.7


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::MailFoundry;
2 15     15   6093 use parent 'Sisimai::Lhost';
  15         30  
  15         79  
3 15     15   930 use feature ':5.10';
  15         40  
  15         1046  
4 15     15   78 use strict;
  15         25  
  15         366  
5 15     15   70 use warnings;
  15         32  
  15         9249  
6              
7 2     2 1 1285 sub description { 'MailFoundry' }
8             sub make {
9             # Detect an error from MailFoundry
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.1
15 198     198 1 695 my $class = shift;
16 198   100     562 my $mhead = shift // return undef;
17 197   50     527 my $mbody = shift // return undef;
18              
19 197 100       788 return undef unless $mhead->{'subject'} eq 'Message delivery has failed';
20 11 50       28 return undef unless grep { rindex($_, '(MAILFOUNDRY) id') > -1 } @{ $mhead->{'received'} };
  27         98  
  11         35  
21              
22 11         56 state $indicators = __PACKAGE__->INDICATORS;
23 11         33 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
24 11         31 state $startingof = {
25             'message' => ['Unable to deliver message to:'],
26             'error' => ['Delivery failed for the following reason:'],
27             };
28              
29 11         47 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
30 11         74 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
31 11         58 my $readcursor = 0; # (Integer) Points the current cursor position
32 11         42 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
33 11         25 my $v = undef;
34              
35 11         88 for my $e ( split("\n", $emailsteak->[0]) ) {
36             # Read error messages and delivery status lines from the head of the email
37             # to the previous line of the beginning of the original message.
38 77 100       136 unless( $readcursor ) {
39             # Beginning of the bounce message or message/delivery-status part
40 33 100       116 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
41             }
42 77 100       143 next unless $readcursor & $indicators->{'deliverystatus'};
43 55 100       108 next unless length $e;
44              
45             # Unable to deliver message to:
46             # Delivery failed for the following reason:
47             # Server mx22.example.org[192.0.2.222] failed with: 550 No such user here
48             #
49             # This has been a permanent failure. No further delivery attempts will be made.
50 44         60 $v = $dscontents->[-1];
51              
52 44 100       125 if( $e =~ /\AUnable to deliver message to: [<]([^ ]+[@][^ ]+)[>]\z/ ) {
53             # Unable to deliver message to:
54 11 50       41 if( $v->{'recipient'} ) {
55             # There are multiple recipient addresses in the message body.
56 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
57 0         0 $v = $dscontents->[-1];
58             }
59 11         37 $v->{'recipient'} = $1;
60 11         29 $recipients++;
61              
62             } else {
63             # Error message
64 33 100       98 if( $e eq $startingof->{'error'}->[0] ) {
65             # Delivery failed for the following reason:
66 11         36 $v->{'diagnosis'} = $e;
67              
68             } else {
69             # Detect error message
70 22 50       60 next unless length $e;
71 22 50       45 next unless $v->{'diagnosis'};
72 22 50       57 next if index($e, '-') == 0;
73              
74             # Server mx22.example.org[192.0.2.222] failed with: 550 No such user here
75 22         83 $v->{'diagnosis'} .= ' '.$e;
76             }
77             }
78             }
79 11 50       75 return undef unless $recipients;
80              
81 11         27 for my $e ( @$dscontents ) {
82             # Set default values if each value is empty.
83 11         90 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
84             }
85 11         87 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
86             }
87              
88             1;
89             __END__