File Coverage

lib/Sisimai/Lhost/MailFoundry.pm
Criterion Covered Total %
statement 43 45 95.5
branch 17 22 77.2
condition 9 10 90.0
subroutine 6 6 100.0
pod 2 2 100.0
total 77 85 90.5


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::MailFoundry;
2 36     36   3191 use parent 'Sisimai::Lhost';
  36         55  
  36         216  
3 36     36   2472 use v5.26;
  36         98  
4 36     36   124 use strict;
  36         60  
  36         833  
5 36     36   162 use warnings;
  36         47  
  36         16652  
6              
7 1     1 1 2 sub description { 'MailFoundry: https://www.barracuda.com/' }
8             sub inquire {
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 decode or the arguments are missing
14             # @since v4.1.1
15 876     876 1 2611 my $class = shift;
16 876   100     1660 my $mhead = shift // return undef;
17 875   100     1796 my $mbody = shift // return undef;
18              
19 874 100       2177 return undef unless $mhead->{'subject'} eq 'Message delivery has failed';
20 11 50       32 return undef unless grep { rindex($_, '(MAILFOUNDRY) id') > -1 } $mhead->{'received'}->@*;
  22         53  
21              
22 11         34 state $indicators = __PACKAGE__->INDICATORS;
23 11         19 state $boundaries = ['Content-Type: message/rfc822'];
24 11         24 state $startingof = {
25             'message' => ['Unable to deliver message to:'],
26             'error' => ['Delivery failed for the following reason:'],
27             };
28              
29 11         45 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; my $v = undef;
  11         17  
30 11         50 my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
31 11         15 my $readcursor = 0; # (Integer) Points the current cursor position
32 11         16 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
33              
34 11         45 for my $e ( split("\n", $emailparts->[0]) ) {
35             # Read error messages and delivery status lines from the head of the email to the previous
36             # line of the beginning of the original message.
37 77 100       97 unless( $readcursor ) {
38             # Beginning of the bounce message or message/delivery-status part
39 33 100       69 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
40             }
41 77 100 100     189 next if ($readcursor & $indicators->{'deliverystatus'}) == 0 || $e eq "";
42              
43             # Unable to deliver message to:
44             # Delivery failed for the following reason:
45             # Server mx22.example.org[192.0.2.222] failed with: 550 No such user here
46             #
47             # This has been a permanent failure. No further delivery attempts will be made.
48 44         67 $v = $dscontents->[-1];
49              
50 44 100 66     107 if( index($e, 'Unable to deliver message to: <') == 0 && index($e, '@') > 1 ) {
51             # Unable to deliver message to:
52 11 50       24 if( $v->{'recipient'} ) {
53             # There are multiple recipient addresses in the message body.
54 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
55 0         0 $v = $dscontents->[-1];
56             }
57 11         66 $v->{'recipient'} = Sisimai::Address->s3s4(substr($e, index($e, '<'), ));
58 11         24 $recipients++;
59              
60             } else {
61             # Delivery failed for the following reason:
62 33 100       53 if( $e eq $startingof->{'error'}->[0] ) { $v->{'diagnosis'} = $e; next }
  11         18  
  11         15  
63              
64 22 50       34 next unless $v->{'diagnosis'};
65 22 50       40 next if index($e, '-') == 0;
66 22         45 $v->{'diagnosis'} .= ' '.$e;
67             }
68             }
69 11 50       30 return undef unless $recipients;
70 11         49 return {"ds" => $dscontents, "rfc822" => $emailparts->[1]};
71             }
72              
73             1;
74             __END__