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   5031 use parent 'Sisimai::Lhost';
  20         44  
  20         93  
3 20     20   1043 use feature ':5.10';
  20         33  
  20         1165  
4 20     20   95 use strict;
  20         31  
  20         333  
5 20     20   76 use warnings;
  20         31  
  20         14328  
6              
7             # X-UI-Out-Filterresults: unknown:0;
8 2     2 1 1096 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 643 my $class = shift;
17 246   100     519 my $mhead = shift // return undef;
18 245   50     470 my $mbody = shift // return undef;
19              
20 245 100       814 return undef unless index($mhead->{'from'}, '"Mail Delivery System"') == 0;
21 31 100       117 return undef unless $mhead->{'subject'} eq 'Mail delivery failed: returning message to sender';
22              
23 17         63 state $indicators = __PACKAGE__->INDICATORS;
24 17         39 state $rebackbone = qr|^---[ ]The[ ]header[ ]of[ ]the[ ]original[ ]message[ ]is[ ]following[.][ ]---|m;
25 17         50 state $startingof = {
26             'message' => ['This message was created automatically by mail delivery software'],
27             'error' => ['For the following reason:'],
28             };
29 17         34 state $messagesof = { 'mesgtoobig' => ['Mail size limit exceeded'] };
30              
31 17         70 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
32 17         92 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
33 17         48 my $readcursor = 0; # (Integer) Points the current cursor position
34 17         38 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
35 17         29 my $v = undef;
36              
37 17         95 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       214 unless( $readcursor ) {
41             # Beginning of the bounce message or message/delivery-status part
42 17 50       114 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
43 17         31 next;
44             }
45 149 50       206 next unless $readcursor & $indicators->{'deliverystatus'};
46 149 100       183 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         112 $v = $dscontents->[-1];
57              
58 97 100       281 if( $e =~ /\A([^ ]+[@][^ ]+?)[:]?\z/ ) {
    100          
59             # general@example.eu
60 17 50       63 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         58 $v->{'recipient'} = $1;
66 17         25 $recipients++;
67              
68             } elsif( index($e, $startingof->{'error'}->[0]) == 0 ) {
69             # For the following reason:
70 6         13 $v->{'diagnosis'} = $e;
71              
72             } else {
73 74 100       130 if( length $v->{'diagnosis'} ) {
74             # Get error message and append the error message strings
75 12         32 $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         169 $v->{'alterrors'} .= ' '.$e;
82             }
83             }
84             }
85 17 50       74 return undef unless $recipients;
86              
87 17         38 for my $e ( @$dscontents ) {
88 17   50     102 $e->{'diagnosis'} ||= $e->{'alterrors'} || '';
      66        
89              
90 17 100       108 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         30 $e->{'rhost'} = $1;
95 11 50       43 $e->{'command'} = 'DATA' if $e->{'diagnosis'} =~ /for TEXT command/;
96 11 50       44 $e->{'spec'} = 'SMTP' if $e->{'diagnosis'} =~ /SMTP error/;
97 11         62 $e->{'status'} = Sisimai::SMTP::Status->find($e->{'diagnosis'});
98             } else {
99             # For the following reason:
100 6         73 $e->{'diagnosis'} =~ s/\A$startingof->{'error'}->[0]//g;
101             }
102 17         129 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
103              
104 17         116 SESSION: for my $r ( keys %$messagesof ) {
105             # Verify each regular expression of session errors
106 17 100       25 next unless grep { index($e->{'diagnosis'}, $_) > -1 } @{ $messagesof->{ $r } };
  17         103  
  17         47  
107 6         15 $e->{'reason'} = $r;
108 6         12 last;
109             }
110             }
111 17         88 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
112             }
113              
114             1;
115             __END__