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   5078 use parent 'Sisimai::Lhost';
  15         27  
  15         70  
3 15     15   786 use feature ':5.10';
  15         24  
  15         837  
4 15     15   70 use strict;
  15         27  
  15         277  
5 15     15   75 use warnings;
  15         26  
  15         7619  
6              
7 2     2 1 933 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 623 my $class = shift;
16 198   100     600 my $mhead = shift // return undef;
17 197   50     636 my $mbody = shift // return undef;
18              
19 197 100       598 return undef unless $mhead->{'subject'} eq 'Message delivery has failed';
20 11 50       24 return undef unless grep { rindex($_, '(MAILFOUNDRY) id') > -1 } @{ $mhead->{'received'} };
  27         102  
  11         45  
21              
22 11         44 state $indicators = __PACKAGE__->INDICATORS;
23 11         23 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
24 11         27 state $startingof = {
25             'message' => ['Unable to deliver message to:'],
26             'error' => ['Delivery failed for the following reason:'],
27             };
28              
29 11         46 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
30 11         71 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
31 11         31 my $readcursor = 0; # (Integer) Points the current cursor position
32 11         18 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
33 11         18 my $v = undef;
34              
35 11         60 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       104 unless( $readcursor ) {
39             # Beginning of the bounce message or message/delivery-status part
40 33 100       84 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
41             }
42 77 100       150 next unless $readcursor & $indicators->{'deliverystatus'};
43 55 100       97 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         47 $v = $dscontents->[-1];
51              
52 44 100       100 if( $e =~ /\AUnable to deliver message to: [<]([^ ]+[@][^ ]+)[>]\z/ ) {
53             # Unable to deliver message to:
54 11 50       31 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         36 $v->{'recipient'} = $1;
60 11         18 $recipients++;
61              
62             } else {
63             # Error message
64 33 100       64 if( $e eq $startingof->{'error'}->[0] ) {
65             # Delivery failed for the following reason:
66 11         26 $v->{'diagnosis'} = $e;
67              
68             } else {
69             # Detect error message
70 22 50       40 next unless length $e;
71 22 50       40 next unless $v->{'diagnosis'};
72 22 50       45 next if index($e, '-') == 0;
73              
74             # Server mx22.example.org[192.0.2.222] failed with: 550 No such user here
75 22         58 $v->{'diagnosis'} .= ' '.$e;
76             }
77             }
78             }
79 11 50       35 return undef unless $recipients;
80              
81 11         28 for my $e ( @$dscontents ) {
82             # Set default values if each value is empty.
83 11         64 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
84             }
85 11         57 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
86             }
87              
88             1;
89             __END__