File Coverage

lib/Sisimai/Lhost/Barracuda.pm
Criterion Covered Total %
statement 53 56 94.6
branch 23 28 82.1
condition 5 12 41.6
subroutine 6 6 100.0
pod 2 2 100.0
total 89 104 85.5


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Barracuda;
2 23     23   6098 use parent 'Sisimai::Lhost';
  23         52  
  23         151  
3 23     23   1455 use feature ':5.10';
  23         50  
  23         1609  
4 23     23   131 use strict;
  23         51  
  23         463  
5 23     23   119 use warnings;
  23         58  
  23         14838  
6              
7 2     2 1 1169 sub description { 'Barracuda: https://www.barracuda.com' }
8             sub make {
9             # Detect an error from Barracuda
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.25.6
15 262     262 1 835 my $class = shift;
16 262   100     780 my $mhead = shift // return undef;
17 261   50     659 my $mbody = shift // return undef;
18              
19             # Subject: **Message you sent blocked by our bulk email filter**
20 261 100       1154 return undef unless index($mhead->{'subject'}, 'our bulk email filter') > 0;
21              
22 16         67 state $indicators = __PACKAGE__->INDICATORS;
23 16         43 state $rebackbone = qr|^Content-Type:[ ]text/rfc822-headers|m;
24 16         40 state $startingof = { 'message' => ['Your message to:'] };
25              
26 16         451 require Sisimai::RFC1894;
27 16         100 my $fieldtable = Sisimai::RFC1894->FIELDTABLE;
28 16         47 my $permessage = {}; # (Hash) Store values of each Per-Message field
29              
30 16         77 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
31 16         90 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
32 16         46 my $readcursor = 0; # (Integer) Points the current cursor position
33 16         30 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
34 16         25 my $v = undef;
35              
36 16         159 for my $e ( split("\n", $emailsteak->[0]) ) {
37             # Read error messages and delivery status lines from the head of the email
38             # to the previous line of the beginning of the original message.
39 261 100       410 unless( $readcursor ) {
40             # Beginning of the bounce message or message/delivery-status part
41 97 100       218 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
42 97         159 next;
43             }
44 164 50       275 next unless $readcursor & $indicators->{'deliverystatus'};
45 164 100       290 next unless length $e;
46              
47 126 100       252 if( my $f = Sisimai::RFC1894->match($e) ) {
48             # $e matched with any field defined in RFC3464
49 88 50       170 next unless my $o = Sisimai::RFC1894->field($e);
50 88         137 $v = $dscontents->[-1];
51              
52 88 100       200 if( $o->[-1] eq 'addr' ) {
    100          
53             # Final-Recipient: rfc822; kijitora@example.jp
54             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
55 11 50       52 if( $o->[0] eq 'final-recipient' ) {
56             # Final-Recipient: rfc822; kijitora@example.jp
57 11 50       41 if( $v->{'recipient'} ) {
58             # There are multiple recipient addresses in the message body.
59 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
60 0         0 $v = $dscontents->[-1];
61             }
62 11         24 $v->{'recipient'} = $o->[2];
63 11         29 $recipients++;
64             } else {
65             # X-Actual-Recipient: rfc822; kijitora@example.co.jp
66 0         0 $v->{'alias'} = $o->[2];
67             }
68             } elsif( $o->[-1] eq 'code' ) {
69             # Diagnostic-Code: SMTP; 550 5.1.1 ... User Unknown
70 11         29 $v->{'spec'} = $o->[1];
71 11         36 $v->{'diagnosis'} = $o->[2];
72              
73             } else {
74             # Other DSN fields defined in RFC3464
75 66 50       143 next unless exists $fieldtable->{ $o->[0] };
76 66         133 $v->{ $fieldtable->{ $o->[0] } } = $o->[2];
77              
78 66 100       158 next unless $f == 1;
79 33         106 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2];
80             }
81             }
82             }
83 16 100       98 return undef unless $recipients;
84              
85 11         40 for my $e ( @$dscontents ) {
86             # Set default values if each value is empty.
87 11   0     73 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
      33        
88 11   33     58 $e->{'diagnosis'} ||= Sisimai::String->sweep($e->{'diagnosis'});
89             }
90 11         97 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
91             }
92              
93             1;
94             __END__