File Coverage

lib/Sisimai/Lhost/FML.pm
Criterion Covered Total %
statement 45 51 88.2
branch 13 20 65.0
condition 3 4 75.0
subroutine 6 6 100.0
pod 2 2 100.0
total 69 83 83.1


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::FML;
2 16     16   5210 use parent 'Sisimai::Lhost';
  16         716  
  16         75  
3 16     16   825 use feature ':5.10';
  16         25  
  16         891  
4 16     16   72 use strict;
  16         27  
  16         433  
5 16     16   75 use warnings;
  16         34  
  16         12594  
6              
7 2     2 1 991 sub description { 'fml mailing list server/manager' };
8             sub make {
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 parse or the arguments are missing
14             # @since v4.22.3
15 202     202 1 547 my $class = shift;
16 202   100     452 my $mhead = shift // return undef;
17 201   50     424 my $mbody = shift // return undef;
18              
19 201 100       596 return undef unless defined $mhead->{'x-mlserver'};
20 10 50       63 return undef unless $mhead->{'from'} =~ /.+[-]admin[@].+/;
21 10 50       59 return undef unless $mhead->{'message-id'} =~ /\A[<]\d+[.]FML.+[@].+[>]\z/;
22              
23 10         22 state $rebackbone = qr|^Original[ ]mail[ ]as[ ]follows:|m;
24 10         23 state $errortitle = {
25             'rejected' => qr{(?>
26             (?:Ignored[ ])*NOT[ ]MEMBER[ ]article[ ]from[ ]
27             |reject[ ]mail[ ](?:.+:|from)[ ],
28             |Spam[ ]mail[ ]from[ ]a[ ]spammer[ ]is[ ]rejected
29             |You[ ].+[ ]are[ ]not[ ]member
30             )
31             }x,
32             'systemerror' => qr{(?:
33             fml[ ]system[ ]error[ ]message
34             |Loop[ ]Alert:[ ]
35             |Loop[ ]Back[ ]Warning:[ ]
36             |WARNING:[ ]UNIX[ ]FROM[ ]Loop
37             )
38             }x,
39             'securityerror' => qr/Security Alert/,
40             };
41 10         25 state $errortable = {
42             'rejected' => qr{(?>
43             (?:Ignored[ ])*NOT[ ]MEMBER[ ]article[ ]from[ ]
44             |reject[ ](?:
45             mail[ ]from[ ].+[@].+
46             |since[ ].+[ ]header[ ]may[ ]cause[ ]mail[ ]loop
47             |spammers:
48             )
49             |You[ ]are[ ]not[ ]a[ ]member[ ]of[ ]this[ ]mailing[ ]list
50             )
51             }x,
52             'systemerror' => qr{(?:
53             Duplicated[ ]Message-ID
54             |fml[ ].+[ ]has[ ]detected[ ]a[ ]loop[ ]condition[ ]so[ ]that
55             |Loop[ ]Back[ ]Warning:
56             )
57             }x,
58             'securityerror' => qr/Security alert:/,
59             };
60              
61 10         39 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
62 10         66 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
63 10         19 my $readcursor = 0; # (Integer) Points the current cursor position
64 10         20 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
65 10         20 my $v = undef;
66              
67 10         50 for my $e ( split("\n", $emailsteak->[0]) ) {
68             # Read error messages and delivery status lines from the head of the email
69             # to the previous line of the beginning of the original message.
70 65 100       88 next unless length $e;
71              
72             # Duplicated Message-ID in <2ndml@example.com>.
73             # Original mail as follows:
74 40         45 $v = $dscontents->[-1];
75              
76 40 100       95 if( $e =~ /[<]([^ ]+?[@][^ ]+?)[>][.]\z/ ) {
77             # Duplicated Message-ID in <2ndml@example.com>.
78 10 50       27 if( $v->{'recipient'} ) {
79             # There are multiple recipient addresses in the message body.
80 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
81 0         0 $v = $dscontents->[-1];
82             }
83 10         33 $v->{'recipient'} = $1;
84 10         23 $v->{'diagnosis'} = $e;
85 10         19 $recipients++;
86              
87             } else {
88             # If you know the general guide of this list, please send mail with
89             # the mail body
90 30         55 $v->{'diagnosis'} .= $e;
91             }
92             }
93 10 50       33 return undef unless $recipients;
94              
95 10         24 for my $e ( @$dscontents ) {
96 10         58 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
97              
98 10         51 for my $f ( keys %$errortable ) {
99             # Try to match with error messages defined in $errortable
100 23 100       177 next unless $e->{'diagnosis'} =~ $errortable->{ $f };
101 10         21 $e->{'reason'} = $f;
102 10         17 last;
103             }
104 10 50       26 next if $e->{'reason'};
105              
106             # Error messages in the message body did not matched
107 0         0 for my $f ( keys %$errortitle ) {
108             # Try to match with the Subject string
109 0 0       0 next unless $mhead->{'subject'} =~ $errortitle->{ $f };
110 0         0 $e->{'reason'} = $f;
111 0         0 last;
112             }
113             }
114 10         73 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
115             }
116              
117             1;
118             __END__