File Coverage

lib/Sisimai/Lhost/EinsUndEins.pm
Criterion Covered Total %
statement 60 62 96.7
branch 23 28 82.1
condition 9 12 75.0
subroutine 6 6 100.0
pod 2 2 100.0
total 100 110 90.9


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::EinsUndEins;
2 36     36   4782 use parent 'Sisimai::Lhost';
  36         304  
  36         294  
3 36     36   3031 use v5.26;
  36         134  
4 36     36   205 use strict;
  36         66  
  36         1241  
5 36     36   229 use warnings;
  36         65  
  36         49213  
6              
7             # X-UI-Out-Filterresults: unknown:0;
8 1     1 1 4 sub description { '1&1: https://www.1und1.de/' }
9             sub inquire {
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 decodes or the arguments are missing
15             # @since v4.1.9
16 884     884 1 3228 my $class = shift;
17 884   100     2575 my $mhead = shift // return undef;
18 883   100     2883 my $mbody = shift // return undef;
19              
20 882 100       4112 return undef unless index($mhead->{'from'}, '"Mail Delivery System"') == 0;
21 32 100       155 return undef unless $mhead->{'subject'} eq 'Mail delivery failed: returning message to sender';
22              
23 17         66 state $indicators = __PACKAGE__->INDICATORS;
24 17         36 state $boundaries = ['--- The header of the original message is following. ---'];
25 17         61 state $startingof = {
26             'message' => ['This message was created automatically by mail delivery software'],
27             'error' => ['For the following reason:'],
28             };
29 17         38 state $messagesof = {'emailtoolarge' => ['Mail size limit exceeded']};
30              
31 17         86 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; my $v = undef;
  17         38  
32 17         79 my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
33 17         36 my $readcursor = 0; # (Integer) Points the current cursor position
34 17         39 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
35              
36 17         138 for my $e ( split("\n", $emailparts->[0]) ) {
37             # Read error messages and delivery status lines from the head of the email to the previous
38             # line of the beginning of the original message.
39 166 100       272 unless( $readcursor ) {
40             # Beginning of the bounce message or message/delivery-status part
41 17 50       107 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
42 17         31 next;
43             }
44 149 100 66     534 next if ($readcursor & $indicators->{'deliverystatus'}) == 0 || $e eq "";
45              
46             # The following address failed:
47             #
48             # general@example.eu
49             #
50             # For the following reason:
51             #
52             # Mail size limit exceeded. For explanation visit
53             # http://postmaster.1and1.com/en/error-messages?ip=%1s
54 97         131 $v = $dscontents->[-1];
55              
56 97 100       407 if( $e =~ /\A\s*([^ ]+[@][^ ]+?)[:]?\z/ ) {
    100          
57             # general@example.eu OR
58             # the line begin with 4 space characters, end with ":" like " neko@example.eu:"
59 17 50       65 if( $v->{'recipient'} ) {
60             # There are multiple recipient addresses in the message body.
61 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
62 0         0 $v = $dscontents->[-1];
63             }
64 17         163 $v->{'recipient'} = Sisimai::Address->s3s4($e);
65 17         45 $recipients++;
66              
67             } elsif( index($e, $startingof->{'error'}->[0]) == 0 ) {
68             # For the following reason:
69 6         15 $v->{'diagnosis'} = $e;
70              
71             } else {
72 74 100       121 if( length $v->{'diagnosis'} ) {
73             # Get error message and append the error message strings
74 12         72 $v->{'diagnosis'} .= ' '.$e;
75              
76             } else {
77             # OR the following format:
78             # neko@example.fr:
79             # SMTP error from remote server for TEXT command, host: ...
80 62         208 $v->{'alterrors'} .= ' '.$e;
81             }
82             }
83             }
84 17 50       102 return undef unless $recipients;
85              
86 17         135 require Sisimai::SMTP::Command;
87 17         48 for my $e ( @$dscontents ) {
88 17   50     110 $e->{'diagnosis'} ||= $e->{'alterrors'} || '';
      66        
89 17         170 $e->{'command'} = Sisimai::SMTP::Command->find($e->{'diagnosis'});
90              
91 17 100       95 if( Sisimai::String->aligned(\$e->{'diagnosis'}, ['host: ', ' reason:']) ) {
92             # SMTP error from remote server for TEXT command,
93             # host: smtp-in.orange.fr (193.252.22.65)
94             # reason: 550 5.2.0 Mail rejete. Mail rejected. ofr_506 [506]
95 11         40 my $p1 = index($e->{'diagnosis'}, 'host: ');
96 11         33 my $p2 = index($e->{'diagnosis'}, ' reason:');
97              
98 11         70 $e->{'rhost'} = Sisimai::String->sweep(substr($e->{'diagnosis'}, $p1 + 6, $p2 - $p1 - 6));
99 11 50       59 $e->{'command'} = 'DATA' if index($e->{'diagnosis'}, 'for TEXT command') > -1;
100 11 50       59 $e->{'spec'} = 'SMTP' if index($e->{'diagnosis'}, 'SMTP error') > -1;
101 11         121 $e->{'status'} = Sisimai::SMTP::Status->find($e->{'diagnosis'});
102             } else {
103             # For the following reason:
104 6         21 substr($e->{'diagnosis'}, 0, length $startingof->{'error'}->[0], '');
105             }
106 17         97 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
107              
108 17         88 SESSION: for my $r ( keys %$messagesof ) {
109             # Verify each regular expression of session errors
110 17 100       65 next unless grep { index($e->{'diagnosis'}, $_) > -1 } $messagesof->{ $r }->@*;
  17         99  
111 6         25 $e->{'reason'} = $r;
112 6         16 last;
113             }
114             }
115 17         124 return {"ds" => $dscontents, "rfc822" => $emailparts->[1]};
116             }
117              
118             1;
119             __END__