Implement Sisimai::Reason::Speeding for parsing a bounce mail rejecte…

…d due to exceeding a rate limit or sending faster #466
sisimai · Nov 5, 2022 · 44a7be7 · 44a7be7
1 parent 9acdff9
commit 44a7be7
Show file tree

Hide file tree

Showing 10 changed files with 119 additions and 16 deletions.
diff --git a/lib/Sisimai/Reason.pm b/lib/Sisimai/Reason.pm
@@ -7,23 +7,23 @@ my $ModulePath = __PACKAGE__->path;
 my $GetRetried = __PACKAGE__->retry;
 my $ClassOrder = [
     [qw/MailboxFull MesgTooBig ExceedLimit Suspend HasMoved NoRelaying AuthFailure UserUnknown
-        Filtered Rejected HostUnknown SpamDetected TooManyConn Blocked/
+        Filtered Rejected HostUnknown SpamDetected Speeding TooManyConn Blocked/
     ],
     [qw/MailboxFull SpamDetected PolicyViolation VirusDetected NoRelaying AuthFailure SecurityError
-        SystemError NetworkError Suspend Expired ContentError SystemFull NotAccept MailerError/
+        SystemError NetworkError Speeding Suspend Expired ContentError SystemFull NotAccept MailerError/
     ],
     [qw/MailboxFull MesgTooBig ExceedLimit Suspend UserUnknown Filtered Rejected HostUnknown SpamDetected
-        TooManyConn Blocked SpamDetected AuthFailure SecurityError SystemError NetworkError Suspend
-        Expired ContentError HasMoved SystemFull NotAccept MailerError NoRelaying SyntaxError OnHold/
+        Speeding TooManyConn Blocked SpamDetected AuthFailure SecurityError SystemError NetworkError
+        Suspend Expired ContentError HasMoved SystemFull NotAccept MailerError NoRelaying SyntaxError OnHold/
     ],
 ];
 
 sub retry {
     # Reason list better to retry detecting an error reason
-    # @return   [Array] Reason list
+    # @return   [Hash] Reason list
     return {
-        'undefined' => 1, 'onhold' => 1, 'systemerror' => 1, 'securityerror' => 1, 'networkerror' => 1,
-        'hostunknown' => 1, 'userunknown'=> 1
+        'undefined' => 1, 'onhold' => 1, 'systemerror' => 1, 'securityerror' => 1, 'expired' => 1,
+        'suspend' => 1, 'networkerror' => 1, 'hostunknown' => 1, 'userunknown'=> 1
     };
 }
 
@@ -33,7 +33,8 @@ sub index {
     return [qw/
         AuthFailure Blocked ContentError ExceedLimit Expired Filtered HasMoved HostUnknown MailboxFull
         MailerError MesgTooBig NetworkError NotAccept OnHold Rejected NoRelaying SpamDetected VirusDetected
-        PolicyViolation SecurityError Suspend SystemError SystemFull TooManyConn UserUnknown SyntaxError/
+        PolicyViolation SecurityError Speeding Suspend SystemError SystemFull TooManyConn UserUnknown
+        SyntaxError/
     ];
 }
 
@@ -110,7 +111,6 @@ sub anotherone {
     TRY_TO_MATCH: while(1) {
         my $diagnostic   = lc $argvs->{'diagnosticcode'} // '';
         my $trytomatch   = $reasontext eq '' ? 1 : 0;
-           $trytomatch ||= 1 if $reasontext eq 'expired';
            $trytomatch ||= 1 if exists $GetRetried->{ $reasontext };
            $trytomatch ||= 1 if $argvs->{'diagnostictype'} ne 'SMTP';
         last unless $trytomatch;

diff --git a/lib/Sisimai/Reason/Speeding.pm b/lib/Sisimai/Reason/Speeding.pm
@@ -0,0 +1,98 @@
+package Sisimai::Reason::Speeding;
+use feature ':5.10';
+use strict;
+use warnings;
+
+sub text  { 'speeding' }
+sub description { 'Rejected due to exceeding a rate limit or sending faster' }
+sub match {
+    # Try to match that the given text and regular expressions
+    # @param    [String] argv1  String to be matched with regular expressions
+    # @return   [Integer]       0: Did not match
+    #                           1: Matched
+    # @since v5.0.0
+    my $class = shift;
+    my $argv1 = shift // return undef;
+
+    state $index = [
+        'please try again slower',
+        'receiving mail at a rate that prevents additional messages from being delivered',
+    ];
+    return 1 if grep { rindex($argv1, $_) > -1 } @$index;
+    return 0;
+}
+
+sub true {
+    # Rejected due to exceeding a rate limit or sending faster
+    # @param    [Sisimai::Fact] argvs   Object to be detected the reason
+    # @return   [Integer]               1: is speeding
+    #                                   0: is not speeding
+    # @see      http://www.ietf.org/rfc/rfc2822.txt
+    my $class = shift;
+    my $argvs = shift // return undef;
+
+    # Action: failed
+    # Status: 4.7.1
+    # Remote-MTA: dns; smtp.example.jp
+    # Diagnostic-Code: smtp; 451 4.7.1 <mx.example.org[192.0.2.2]>: Client host rejected: Please try again slower
+    return undef unless $argvs->{'deliverystatus'};
+    return 1 if $argvs->{'reason'} eq 'speeding';
+    return 1 if __PACKAGE__->match(lc $argvs->{'diagnosticcode'});
+    return 0;
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Sisimai::Reason::Speeding - Bounce reason is C<speeding> or not.
+
+=head1 SYNOPSIS
+
+    use Sisimai::Reason::Speeding;
+    print Sisimai::Reason::Speeding->match('400 Delivery time speeding');   # 1
+
+=head1 DESCRIPTION
+
+Sisimai::Reason::Speeding checks the bounce reason is C<speeding> or not. This class is called only
+Sisimai::Reason class.
+
+This is the error that delivery time has speeding due to connection failure or network error and the
+message you sent has been in the queue for long time.
+
+=head1 CLASS METHODS
+
+=head2 C<B<text()>>
+
+C<text()> returns string: C<speeding>.
+
+    print Sisimai::Reason::Speeding->text;  # speeding
+
+=head2 C<B<match(I<string>)>>
+
+C<match()> returns 1 if the argument matched with patterns defined in this class.
+
+    print Sisimai::Reason::Speeding->match('400 Delivery time speeding');   # 1
+
+=head2 C<B<true(I<Sisimai::Fact>)>>
+
+C<true()> returns 1 if the bounce reason is C<speeding>. The argument must be Sisimai::Fact object
+and this method is called only from Sisimai::Reason class.
+
+=head1 AUTHOR
+
+azumakuniyuki
+
+=head1 COPYRIGHT
+
+Copyright (C) 2014-2016,2018,2020,2021 azumakuniyuki, All rights reserved.
+
+=head1 LICENSE
+
+This software is distributed under The BSD 2-Clause License.
+
+=cut
+
diff --git a/lib/Sisimai/SMTP/Status.pm b/lib/Sisimai/SMTP/Status.pm
@@ -496,7 +496,7 @@ use constant StandardCode => {
     '4.4.2'  => 'networkerror', # Bad connection
     '4.4.3'  => 'systemerror',  # Directory server failure
     '4.4.4'  => 'networkerror', # Unable to route
-    '4.4.5'  => 'systemfull',  # Mail system congestion
+    '4.4.5'  => 'systemfull',   # Mail system congestion
     '4.4.6'  => 'networkerror', # Routing loop detected
     '4.4.7'  => 'expired',      # Delivery time expired
     #'4.5.0' => 'networkerror', # Other or undefined protocol status
@@ -605,6 +605,7 @@ use constant InternalCode => {
         'rejected'     => '4.0.918',
         'securityerror'=> '4.0.970',
         'spamdetected' => '4.0.980',
+        'speeding'     => '4.0.946',
         #'suspend'      => '4.0.921',
         'systemerror'  => '4.0.930',
         'systemfull'   => '4.0.931',
@@ -632,6 +633,7 @@ use constant InternalCode => {
         'rejected'       => '5.0.918',
         'securityerror'  => '5.0.970',
         'spamdetected'   => '5.0.980',
+        'speeding'       => '5.0.946',
         'suspend'        => '5.0.921',
         'systemerror'    => '5.0.930',
         'systemfull'     => '5.0.931',

diff --git a/t/200-reason.t b/t/200-reason.t
@@ -92,6 +92,7 @@ my $Message = [
     'smtp;550 5.2.2 <mikeneko@example.co.jp>... Mailbox Full',
     'smtp;550 Requested action not taken: mailbox unavailable (-2019901852:4030:-2147467259)',
     'smtp;550 5.1.1 <kijitora@example.or.jp>... User unknown',
+    '451 4.7.1 <smtp3.example.jp[192.0.2.1]>: Client host rejected: Please try again slower',
     '550 5.1.1 <kijitora@example.jp>... User Unknown ',
     '550 5.1.1 <this-local-part-does-not-exist-on-the-server@example.jp>... ',
     '550 Bad SPF records for [example.org:192.0.2.2], see http://spf.pobox.com/',

diff --git a/t/201-reason-children.t b/t/201-reason-children.t
@@ -25,6 +25,7 @@ my $reasonchildren = {
     'PolicyViolation' => ['570 5.7.7 Email not accepted for policy reasons'],
     'SecurityError'   => ['570 5.7.0 Authentication failure'],
     'SpamDetected'    => ['570 5.7.7 Spam Detected'],
+    'Speeding'        => ['451 4.7.1 <smtp.example.jp[192.0.2.3]>: Client host rejected: Please try again slower'],
     'Suspend'         => ['550 5.0.0 Recipient suspend the service'],
     'SystemError'     => ['500 5.3.5 System config error'],
     'SystemFull'      => ['550 5.0.0 Mail system full'],

diff --git a/t/760-lhost-postfix.t b/t/760-lhost-postfix.t
@@ -58,7 +58,7 @@ my $isexpected = {
     '56' => [['4.4.2',   '',    'networkerror',    0]],
     '57' => [['5.2.1',   '550', 'userunknown',     1]],
     '58' => [['5.7.1',   '550', 'blocked',         0]],
-    '59' => [['5.2.1',   '550', 'exceedlimit',     0]],
+    '59' => [['5.2.1',   '550', 'speeding',        0]],
     '60' => [['4.0.0',   '',    'blocked',         0]],
     '61' => [['5.0.0',   '550', 'suspend',         0]],
     '62' => [['5.0.0',   '550', 'virusdetected',   0]],

diff --git a/t/900-modules.pl b/t/900-modules.pl
@@ -94,6 +94,7 @@ sub list {
             Reason/Rejected.pm
             Reason/SecurityError.pm
             Reason/SpamDetected.pm
+            Reason/Speeding.pm
             Reason/Suspend.pm
             Reason/SyntaxError.pm
             Reason/SystemError.pm

diff --git a/xt/653-lhost-exim.t b/xt/653-lhost-exim.t
@@ -48,7 +48,7 @@ my $isexpected = {
     '01038' => [['5.7.0',   '550', 'blocked',         0]],
     '01039' => [['4.0.922', '',    'mailboxfull',     0]],
     '01040' => [['4.0.947', '',    'expired',         0]],
-    '01041' => [['4.0.947', '451', 'expired',         0]],
+    '01041' => [['4.0.947', '451', 'spamdetected',    0]],
     '01042' => [['5.0.944', '',    'networkerror',    0]],
     '01043' => [['5.0.911', '550', 'userunknown',     1]],
     '01044' => [['5.0.944', '',    'networkerror',    0]],

diff --git a/xt/670-lhost-gmail.t b/xt/670-lhost-gmail.t
@@ -43,8 +43,8 @@ my $isexpected = {
     '01032' => [['5.0.947', '',    'expired',         0]],
     '01033' => [['5.0.971', '',    'blocked',         0]],
     '01034' => [['4.0.947', '',    'expired',         0]],
-    '01035' => [['4.0.947', '',    'expired',         0]],
-    '01036' => [['4.0.947', '',    'expired',         0]],
+    '01035' => [['4.0.971', '',    'blocked',         0]],
+    '01036' => [['4.0.971', '',    'blocked',         0]],
     '01037' => [['5.0.971', '',    'blocked',         0]],
     '01038' => [['5.0.911', '550', 'userunknown',     1]],
     '01039' => [['5.1.1',   '550', 'userunknown',     1]],

diff --git a/xt/760-lhost-postfix.t b/xt/760-lhost-postfix.t
@@ -227,8 +227,8 @@ my $isexpected = {
     '01211' => [['5.1.1',   '550', 'userunknown',     1]],
     '01212' => [['5.2.1',   '550', 'userunknown',     1]],
     '01213' => [['5.1.1',   '550', 'userunknown',     1]],
-    '01214' => [['5.2.1',   '550', 'exceedlimit',     0]],
-    '01215' => [['5.2.1',   '550', 'exceedlimit',     0]],
+    '01214' => [['5.2.1',   '550', 'speeding',        0]],
+    '01215' => [['5.2.1',   '550', 'speeding',        0]],
     '01216' => [['4.0.0',   '',    'blocked',         0]],
     '01217' => [['4.0.0',   '',    'blocked',         0]],
     '01218' => [['4.0.0',   '',    'blocked',         0]],