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   5984 use parent 'Sisimai::Lhost';
  15         36  
  15         83  
3 15     15   911 use feature ':5.10';
  15         45  
  15         1054  
4 15     15   91 use strict;
  15         31  
  15         303  
5 15     15   69 use warnings;
  15         39  
  15         8967  
6              
7 2     2 1 1443 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 746 my $class = shift;
16 198   100     702 my $mhead = shift // return undef;
17 197   50     632 my $mbody = shift // return undef;
18              
19 197 100       784 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         91  
  11         42  
21              
22 11         48 state $indicators = __PACKAGE__->INDICATORS;
23 11         30 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         97 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
30 11         73 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
31 11         34 my $readcursor = 0; # (Integer) Points the current cursor position
32 11         21 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
33 11         24 my $v = undef;
34              
35 11         72 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       117 unless( $readcursor ) {
39             # Beginning of the bounce message or message/delivery-status part
40 33 100       100 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
41             }
42 77 100       158 next unless $readcursor & $indicators->{'deliverystatus'};
43 55 100       94 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         53 $v = $dscontents->[-1];
51              
52 44 100       119 if( $e =~ /\AUnable to deliver message to: [<]([^ ]+[@][^ ]+)[>]\z/ ) {
53             # Unable to deliver message to:
54 11 50       32 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         25 $recipients++;
61              
62             } else {
63             # Error message
64 33 100       73 if( $e eq $startingof->{'error'}->[0] ) {
65             # Delivery failed for the following reason:
66 11         30 $v->{'diagnosis'} = $e;
67              
68             } else {
69             # Detect error message
70 22 50       52 next unless length $e;
71 22 50       50 next unless $v->{'diagnosis'};
72 22 50       56 next if index($e, '-') == 0;
73              
74             # Server mx22.example.org[192.0.2.222] failed with: 550 No such user here
75 22         70 $v->{'diagnosis'} .= ' '.$e;
76             }
77             }
78             }
79 11 50       40 return undef unless $recipients;
80              
81 11         31 for my $e ( @$dscontents ) {
82             # Set default values if each value is empty.
83 11         73 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
84             }
85 11         50 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
86             }
87              
88             1;
89             __END__