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