File Coverage

lib/Sisimai/Lhost/KDDI.pm
Criterion Covered Total %
statement 52 55 94.5
branch 23 32 71.8
condition 12 23 52.1
subroutine 6 6 100.0
pod 2 2 100.0
total 95 118 80.5


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::KDDI;
2 41     41   3227 use parent 'Sisimai::Lhost';
  41         63  
  41         1659  
3 41     41   2584 use v5.26;
  41         171  
4 41     41   142 use strict;
  41         60  
  41         795  
5 41     41   117 use warnings;
  41         53  
  41         24233  
6              
7 1     1 1 2 sub description { 'au by KDDI: https://www.au.kddi.com' }
8             sub inquire {
9             # Detect an error from au by KDDI
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 decode or the arguments are missing
14             # @since v4.0.0
15 912     912 1 2561 my $class = shift;
16 912   100     1722 my $mhead = shift // return undef;
17 911   100     1475 my $mbody = shift // return undef;
18 910 50 0     1041 my $match = 0; $match ||= 1 if Sisimai::String->aligned(\$mhead->{'from'}, ['no-reply@.', '.dion.ne.jp']);
  910         4912  
19 910 100 50     2645 $match ||= 1 if $mhead->{'reply-to'} && $mhead->{'reply-to'} eq 'no-reply@app.auone-net.jp';
      100        
20 910 50 0     1624 $match ||= 1 if grep { rindex($_, 'ezweb.ne.jp (') > -1 } $mhead->{'received'}->@*;
  1762         3299  
21 910 50 0     1454 $match ||= 1 if grep { rindex($_, '.au.com (') > -1 } $mhead->{'received'}->@*;
  1762         2852  
22 910 100       1956 return undef unless $match;
23              
24 16         49 state $indicators = __PACKAGE__->INDICATORS;
25 16         27 state $boundaries = ['Content-Type: message/rfc822'];
26 16         24 state $startingof = {'message' => ['Your mail sent on:', 'Your mail attempted to be delivered on:']};
27              
28 16         66 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; my $v = undef;
  16         29  
29 16         83 my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
30 16         24 my $readcursor = 0; # (Integer) Points the current cursor position
31 16         28 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
32              
33 16         86 for my $e ( split("\n", $emailparts->[0]) ) {
34             # Read error messages and delivery status lines from the head of the email to the previous
35             # line of the beginning of the original message.
36 138 100       153 unless( $readcursor ) {
37             # Beginning of the bounce message or message/delivery-status part
38 106 100       134 $readcursor |= $indicators->{'deliverystatus'} if grep { index($e, $_) == 0 } $startingof->{'message'}->@*;
  212         283  
39             }
40 138 100 66     315 next if ($readcursor & $indicators->{'deliverystatus'}) == 0 || $e eq "";
41              
42 48         67 $v = $dscontents->[-1];
43 48 100       121 if( index($e, ' Could not be delivered to: <') > -1 ) {
    100          
44             # Your mail sent on: Thu, 29 Apr 2010 11:04:47 +0900
45             # Could not be delivered to: <******@**.***.**>
46             # As their mailbox is full.
47 16 50       34 if( $v->{'recipient'} ) {
48             # There are multiple recipient addresses in the message body.
49 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
50 0         0 $v = $dscontents->[-1];
51             }
52              
53 16         113 my $r = Sisimai::Address->s3s4(substr($e, index($e, '<') + 1, ));
54 16 50       58 next unless Sisimai::Address->is_emailaddress($r);
55 16         45 $v->{'recipient'} = $r;
56 16         22 $recipients++;
57              
58             } elsif( index($e, 'Your mail sent on: ') > -1 ) {
59             # Your mail sent on: Thu, 29 Apr 2010 11:04:47 +0900
60 16         44 $v->{'date'} = substr($e, 19, );
61              
62             } else {
63             # As their mailbox is full.
64 16 50       60 $v->{'diagnosis'} .= $e.' ' if index($e, ' ') == 0;
65             }
66             }
67 16 50       50 return undef unless $recipients;
68              
69 16         78 require Sisimai::SMTP::Command;
70 16         32 for my $e ( @$dscontents ) {
71 16   50     112 $e->{'command'} = Sisimai::SMTP::Command->find($e->{'diagnosis'}) || '';
72              
73 16 50 33     67 if( defined $mhead->{'x-spasign'} && $mhead->{'x-spasign'} eq 'NG' ) {
74             # Content-Type: text/plain; ..., X-SPASIGN: NG (spamghetti, au by KDDI)
75             # Filtered recipient returns message that include 'X-SPASIGN' header
76 0         0 $e->{'reason'} = 'filtered';
77              
78             } else {
79             # There is no X-SPASIGN: header in the bounce message
80             # set "userunknown" when the remote server rejected after RCPT command.
81 16 50       44 $e->{'reason'} = 'userunknown' if $e->{'command'} eq 'RCPT';
82             }
83             }
84 16         79 return {"ds" => $dscontents, "rfc822" => $emailparts->[1]};
85             }
86              
87             1;
88             __END__