File Coverage

lib/Sisimai/Lhost/FML.pm
Criterion Covered Total %
statement 46 53 86.7
branch 13 20 65.0
condition 6 7 85.7
subroutine 6 6 100.0
pod 2 2 100.0
total 73 88 82.9


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::FML;
2 39     39   4958 use parent 'Sisimai::Lhost';
  39         81  
  39         288  
3 39     39   3338 use v5.26;
  39         158  
4 39     39   191 use strict;
  39         102  
  39         1003  
5 39     39   216 use warnings;
  39         113  
  39         27420  
6              
7 1     1 1 5 sub description { 'fml mailing list server/manager: https://www.fml.org/' };
8             sub inquire {
9             # Detect an error from fml mailing list server/manager
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.22.3
15 903     903 1 4408 my $class = shift;
16 903   100     2700 my $mhead = shift // return undef;
17 902   100     2351 my $mbody = shift // return undef;
18              
19 901 100       3518 return undef unless defined $mhead->{'x-mlserver'};
20 10 50       46 return undef unless index($mhead->{'from'}, '-admin@') > 0;
21 10 50       56 return undef unless index($mhead->{'message-id'}, '.FML') > 1;
22              
23 10         30 state $boundaries = ['Original mail as follows:'];
24 10         39 state $errortitle = {
25             'rejected' => [
26             ' are not member',
27             'NOT MEMBER article from ',
28             'reject mail ',
29             'Spam mail from a spammer is rejected',
30             ],
31             'systemerror' => [
32             'fml system error message',
33             'Loop Alert: ',
34             'Loop Back Warning: ',
35             'WARNING: UNIX FROM Loop',
36             ],
37             'securityerror' => ['Security Alert'],
38             };
39 10         47 state $errortable = {
40             'rejected' => [
41             ' header may cause mail loop',
42             'NOT MEMBER article from ',
43             'reject mail from ',
44             'reject spammers:',
45             'You are not a member of this mailing list',
46             ],
47             'notcompliantrfc' => ['Duplicated Message-ID'],
48             'securityerror' => ['Security alert:'],
49             'systemerror' => [
50             ' has detected a loop condition so that',
51             'Loop Back Warning:',
52             ],
53             };
54              
55 10         68 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; my $v = undef;
  10         24  
56 10         48 my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
57 10         22 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
58              
59 10         71 for my $e ( split("\n", $emailparts->[0]) ) {
60             # Read error messages and delivery status lines from the head of the email to the previous
61             # line of the beginning of the original message.
62 65 100       142 next unless length $e;
63              
64             # Duplicated Message-ID in <2ndml@example.com>. Original mail as follows:
65 40         90 $v = $dscontents->[-1];
66              
67 40         63 my $p1 = index($e, '<');
68 40         52 my $p2 = rindex($e, '>');
69 40 100 66     129 if( $p1 > 0 && $p2 > 0 ) {
70             # You are not a member of this mailing list .
71 10 50       39 if( $v->{'recipient'} ) {
72             # There are multiple recipient addresses in the message body.
73 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
74 0         0 $v = $dscontents->[-1];
75             }
76 10         42 $v->{'recipient'} = substr($e, $p1 + 1, $p2 - $p1 - 1);
77 10         19 $v->{'diagnosis'} = $e;
78 10         26 $recipients++;
79              
80             } else {
81             # If you know the general guide of this list, please send mail with the mail body
82 30         68 $v->{'diagnosis'} .= $e;
83             }
84             }
85 10 50       74 return undef unless $recipients;
86              
87 10         27 for my $e ( @$dscontents ) {
88 10         75 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
89              
90 10         47 for my $f ( keys %$errortable ) {
91             # Try to match with error messages defined in $errortable
92 27 100       84 next unless grep { index($e->{'diagnosis'}, $_) > -1 } $errortable->{ $f }->@*;
  55         145  
93 10         29 $e->{'reason'} = $f;
94 10         22 last;
95             }
96 10 50       58 next if $e->{'reason'};
97              
98             # Error messages in the message body did not matched
99 0         0 for my $f ( keys %$errortitle ) {
100             # Try to match with the Subject string
101 0 0       0 next unless grep { index($mhead->{'subject'}, $_) > -1 } $errortitle->{ $f }->@*;
  0         0  
102 0         0 $e->{'reason'} = $f;
103 0         0 last;
104             }
105             }
106 10         68 return {"ds" => $dscontents, "rfc822" => $emailparts->[1]};
107             }
108              
109             1;
110             __END__