File Coverage

lib/Sisimai/Lhost/EinsUndEins.pm
Criterion Covered Total %
statement 59 61 96.7
branch 24 30 80.0
condition 6 9 66.6
subroutine 6 6 100.0
pod 2 2 100.0
total 97 108 89.8


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::EinsUndEins;
2 20     20   6191 use parent 'Sisimai::Lhost';
  20         42  
  20         117  
3 20     20   1228 use feature ':5.10';
  20         39  
  20         1416  
4 20     20   108 use strict;
  20         56  
  20         395  
5 20     20   94 use warnings;
  20         100  
  20         17231  
6              
7             # X-UI-Out-Filterresults: unknown:0;
8 2     2 1 1288 sub description { '1&1: https://www.1und1.de/' }
9             sub make {
10             # Detect an error from 1&1
11             # @param [Hash] mhead Message headers of a bounce email
12             # @param [String] mbody Message body of a bounce email
13             # @return [Hash] Bounce data list and message/rfc822 part
14             # @return [Undef] failed to parse or the arguments are missing
15             # @since v4.1.9
16 246     246 1 773 my $class = shift;
17 246   100     694 my $mhead = shift // return undef;
18 245   50     503 my $mbody = shift // return undef;
19              
20 245 100       894 return undef unless index($mhead->{'from'}, '"Mail Delivery System"') == 0;
21 31 100       177 return undef unless $mhead->{'subject'} eq 'Mail delivery failed: returning message to sender';
22              
23 17         86 state $indicators = __PACKAGE__->INDICATORS;
24 17         52 state $rebackbone = qr|^---[ ]The[ ]header[ ]of[ ]the[ ]original[ ]message[ ]is[ ]following[.][ ]---|m;
25 17         44 state $startingof = {
26             'message' => ['This message was created automatically by mail delivery software'],
27             'error' => ['For the following reason:'],
28             };
29 17         39 state $messagesof = { 'mesgtoobig' => ['Mail size limit exceeded'] };
30              
31 17         79 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
32 17         118 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
33 17         76 my $readcursor = 0; # (Integer) Points the current cursor position
34 17         35 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
35 17         34 my $v = undef;
36              
37 17         139 for my $e ( split("\n", $emailsteak->[0]) ) {
38             # Read error messages and delivery status lines from the head of the email
39             # to the previous line of the beginning of the original message.
40 166 100       266 unless( $readcursor ) {
41             # Beginning of the bounce message or message/delivery-status part
42 17 50       135 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
43 17         34 next;
44             }
45 149 50       271 next unless $readcursor & $indicators->{'deliverystatus'};
46 149 100       256 next unless length $e;
47              
48             # The following address failed:
49             #
50             # general@example.eu
51             #
52             # For the following reason:
53             #
54             # Mail size limit exceeded. For explanation visit
55             # http://postmaster.1and1.com/en/error-messages?ip=%1s
56 97         122 $v = $dscontents->[-1];
57              
58 97 100       378 if( $e =~ /\A([^ ]+[@][^ ]+?)[:]?\z/ ) {
    100          
59             # general@example.eu
60 17 50       81 if( $v->{'recipient'} ) {
61             # There are multiple recipient addresses in the message body.
62 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
63 0         0 $v = $dscontents->[-1];
64             }
65 17         65 $v->{'recipient'} = $1;
66 17         32 $recipients++;
67              
68             } elsif( index($e, $startingof->{'error'}->[0]) == 0 ) {
69             # For the following reason:
70 6         24 $v->{'diagnosis'} = $e;
71              
72             } else {
73 74 100       128 if( length $v->{'diagnosis'} ) {
74             # Get error message and append the error message strings
75 12         42 $v->{'diagnosis'} .= ' '.$e;
76              
77             } else {
78             # OR the following format:
79             # neko@example.fr:
80             # SMTP error from remote server for TEXT command, host: ...
81 62         208 $v->{'alterrors'} .= ' '.$e;
82             }
83             }
84             }
85 17 50       94 return undef unless $recipients;
86              
87 17         64 for my $e ( @$dscontents ) {
88 17   50     103 $e->{'diagnosis'} ||= $e->{'alterrors'} || '';
      66        
89              
90 17 100       145 if( $e->{'diagnosis'} =~ /host:[ ]+(.+?)[ ]+.+[ ]+reason:.+/ ) {
91             # SMTP error from remote server for TEXT command,
92             # host: smtp-in.orange.fr (193.252.22.65)
93             # reason: 550 5.2.0 Mail rejete. Mail rejected. ofr_506 [506]
94 11         41 $e->{'rhost'} = $1;
95 11 50       82 $e->{'command'} = 'DATA' if $e->{'diagnosis'} =~ /for TEXT command/;
96 11 50       73 $e->{'spec'} = 'SMTP' if $e->{'diagnosis'} =~ /SMTP error/;
97 11         106 $e->{'status'} = Sisimai::SMTP::Status->find($e->{'diagnosis'});
98             } else {
99             # For the following reason:
100 6         83 $e->{'diagnosis'} =~ s/\A$startingof->{'error'}->[0]//g;
101             }
102 17         166 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
103              
104 17         165 SESSION: for my $r ( keys %$messagesof ) {
105             # Verify each regular expression of session errors
106 17 100       35 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
  17         122  
  17         54  
107 6         15 $e->{'reason'} = $r;
108 6         23 last;
109             }
110             }
111 17         101 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
112             }
113              
114             1;
115             __END__