Get the alias address from the Received header of the original message

ChangeLog.md

@@ -4,6 +4,28 @@ RELEASE NOTES for Perl version of Sisimai
 - download: "https://metacpan.org/pod/Sisimai"
 - document: "https://libsisimai.org/"
 
+v5.0.1p1
+---------------------------------------------------------------------------------------------------
+- release: ""
+- version: ""
+- changes:
+  - #507 Migrate the CI from TravisCI to GitHub Actions
+  - Fixed an issue where constant initialization would fail on Perl 5.26
+  - `5.7.23` returned from Office365 is an error related to SPF vilation (authfailure)
+  - #508 Fixed an issue that Sisimai could not get the value of `alias` address correctly when an
+    email forwarded and bounced
+  - `Sisimai::RFC5322->received` now returns a list including all the elements except date time and
+    (comments) found in the `Received` header
+  - Update the error message patterns in `Sisimai::Rhost::Mimecast`
+  - Update the error message patterns in the followings:
+    - `AuthFailure`
+    - `Blocked`
+    - `Expired`
+    - `MailboxFull`
+    - `SecurityError`
+    - `SpamDetected`
+    - `Suspend`
+
 v5.0.1
 ---------------------------------------------------------------------------------------------------
 - release: "Sun,  3 Mar 2024 17:17:17 +0900 (JST)"

lib/Sisimai/Fact.pm

@@ -165,20 +165,21 @@
 
         OTHER_TEXT_HEADERS: {
             # Scan "Received:" header of the original message
-            my $recvheader = $mesg1->{'header'}->{'received'} || [];
-            if( scalar @$recvheader ) {
-                # Get localhost and remote host name from Received header.
-                $e->{'lhost'} ||= shift Sisimai::RFC5322->received($recvheader->[0])->@*;
-                $e->{'rhost'} ||= pop   Sisimai::RFC5322->received($recvheader->[-1])->@*;
+            my $rr = $mesg1->{'header'}->{'received'} || [];
+            if( scalar @$rr ) {
+                # Get a local host name and a remote host name from the Received header.
+                $p->{'rhost'} ||= Sisimai::RFC5322->received($rr->[-1])->[1] || '';
+                $p->{'lhost'}   = '' if $p->{'lhost'} eq $p->{'rhost'};
+                $p->{'lhost'} ||= Sisimai::RFC5322->received($rr->[ 0])->[0];
             }
 
             for my $v ('rhost', 'lhost') {
                 # Check and rewrite each host name
                 $p->{ $v } =  [split('@', $p->{ $v })]->[-1] if index($p->{ $v }, '@') > -1;
-                y/[]()//d, s/\A.+=// for $p->{ $v };    # Remove [] and (), and strings before "="
+                y/[]()//d, s/\A.+=// for $p->{ $v };                    # Remove [], (), and strings before "="
                 chop $p->{ $v } if substr($p->{ $v }, -1, 1) eq "\r";   # Remove CR at the end of the value
 
-                # Check space character in each value and get the first element
+                # Check a space character in each value and get the first element
                 $p->{ $v } = (split(' ', $p->{ $v }, 2))[0] if rindex($p->{ $v }, ' ') > -1;
                 chop $p->{ $v } if substr($p->{ $v }, -1, 1) eq '.';    # Remove "." at the end of the value
             }
@@ -307,6 +308,31 @@
             $o->{'timezoneoffset'} = $p->{'timezoneoffset'} // '+0000';
         }
 
+        ALIAS: while(1) {
+            # Look up the Envelope-To address from the Received: header in the original message
+            # when the recipient address is same with the value of $o->{'alias'}.
+            last if length $o->{'alias'} == 0;
+            last if $o->{'recipient'}->address ne $o->{'alias'};
+            last unless exists $rfc822data->{'received'};
+            last unless scalar $rfc822data->{'received'}->@*;
+
+            for my $er ( reverse $rfc822data->{'received'}->@* ) {
+                # Search for the string " for " from the Received: header
+                next unless index($er, ' for ') > 1;
+                my $or = Sisimai::RFC5322->received($er);
+
+                next unless scalar @$or;
+                next unless length $or->[5];
+                next unless Sisimai::Address->is_emailaddress($or->[5]);
+                next if $o->{'recipient'}->address eq $or->[5];
+
+                $o->{'alias'} = $or->[5];
+                last;
+            }
+            last;
+        }
+        $o->{'alias'} = '' if $o->{'alias'} eq $o->{'recipient'}->{'address'};
+
         REASON: {
             # Decide the reason of email bounce
             if( $o->{'reason'} eq '' || exists $retryindex->{ $o->{'reason'} } ) {
@@ -377,7 +403,7 @@
 sub softbounce {
     # Emulate "softbounce" accessor for the backward compatible
     # @return   [Integer]
     warn ' ***warning: Sisimai::Fact->softbounce will be removed at v5.1.0. Use Sisimai::Fact->hardbounce instead';
     my $self = shift;
     return  0 if $self->hardbounce == 1;
     return -1 if $self->reason eq 'delivered' || $self->reason eq 'feedback' || $self->reason eq 'vacation';
@@ -729,7 +755,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2022 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/AmazonSES.pm

@@ -288,8 +288,7 @@ sub inquire {
 
         for my $e ( @$dscontents ) {
             # Set default values if each value is empty.
-            $e->{'lhost'} ||= $permessage->{'rhost'};
-            $e->{ $_ }    ||= $permessage->{ $_ } || '' for keys %$permessage;
+            $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
 
             $e->{'diagnosis'} =~ y/\n/ /;
             $e->{'diagnosis'} =  Sisimai::String->sweep($e->{'diagnosis'});
@@ -358,7 +357,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/AmazonWorkMail.pm

@@ -100,7 +100,6 @@ sub inquire {
 
     for my $e ( @$dscontents ) {
         # Set default values if each value is empty.
-        $e->{'lhost'} ||= $permessage->{'rhost'};
         $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
         $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
 
@@ -155,7 +154,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2016-2021,2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2016-2021,2023,2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/Aol.pm

@@ -106,7 +106,6 @@ sub inquire {
 
     for my $e ( @$dscontents ) {
         # Set default values if each value is empty.
-        $e->{'lhost'} ||= $permessage->{'rhost'};
         $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
 
         $e->{'diagnosis'} =~ y/\n/ /;
@@ -158,7 +157,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/Bigfoot.pm

@@ -113,7 +113,6 @@ sub inquire {
 
     for my $e ( @$dscontents ) {
         # Set default values if each value is empty.
-        $e->{'lhost'} ||= $permessage->{'rhost'};
         $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
 
         $e->{'diagnosis'} =  Sisimai::String->sweep($e->{'diagnosis'});
@@ -160,7 +159,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/Domino.pm

@@ -146,7 +146,6 @@ sub inquire {
 
         $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
         $e->{'recipient'} = Sisimai::Address->s3s4($e->{'recipient'});
-        $e->{'lhost'}   ||= $permessage->{'rhost'};
         $e->{ $_ }      ||= $permessage->{ $_ } || '' for keys %$permessage;
 
         for my $r ( keys %$messagesof ) {
@@ -201,7 +200,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/Exim.pm

@@ -151,7 +151,6 @@ sub inquire {
     my $readcursor = 0;     # (Integer) Points the current cursor position
     my $nextcursor = 0;
     my $recipients = 0;     # (Integer) The number of 'Final-Recipient' header
-    my $localhost0 = '';    # (String) Local MTA
     my $boundary00 = '';    # (String) Boundary string
     my $v = undef;
 
@@ -338,18 +337,13 @@ sub inquire {
     }
     return undef unless $recipients;
 
-    if( scalar $mhead->{'received'}->@* ) {
-        # Get the name of local MTA
-        # Received: from marutamachi.example.org (c192128.example.net [192.0.2.128])
-        $p1 = index($mhead->{'received'}->[-1], 'from ');
-        $p2 = index($mhead->{'received'}->[-1], ' ', $p1 + 5);
-        $localhost0 = substr($mhead->{'received'}->[-1], $p1 + 5, $p2 - $p1 - 5) if $p1 > -1 && $p2 > $p1;
-    }
+    # Get the name of the local MTA
+    # Received: from marutamachi.example.org (c192128.example.net [192.0.2.128])
+    my $receivedby = $mhead->{'received'} || [];
+    my $recvdtoken = Sisimai::RFC5322->received($receivedby->[-1]);
 
     for my $e ( @$dscontents ) {
-        # Set default values if each value is empty.
-        $e->{'lhost'} ||= $localhost0;
-
+        # Check the error message, the rhost, the lhost, and the smtp command.
         if( ! $e->{'diagnosis'} && length($boundary00) > 0 ) {
             # Empty Diagnostic-Code: or error message
             # --NNNNNNNNNN-eximdsn-MMMMMMMMMM
@@ -396,14 +390,10 @@ sub inquire {
             # host neko.example.jp [192.0.2.222]: 550 5.1.1 <[email protected]>... User Unknown
             $p1 = index($e->{'diagnosis'}, 'host ');
             $p2 = index($e->{'diagnosis'}, ' ', $p1 + 5);
-            $e->{'rhost'} = substr($e->{'diagnosis'}, $p1 + 5, $p2 - $p1 - 5) if $p1 > -1;
-
-            if( ! $e->{'rhost'} && scalar $mhead->{'received'}->@* ) {
-                # Get localhost and remote host name from Received header.
-                my $r0 = $mhead->{'received'};
-                $e->{'rhost'} = pop Sisimai::RFC5322->received($r0->[-1])->@*;
-            }
+            $e->{'rhost'}   = substr($e->{'diagnosis'}, $p1 + 5, $p2 - $p1 - 5) if $p1 > -1;
+            $e->{'rhost'} ||= $recvdtoken->[1];
         }
+        $e->{'lhost'} ||= $recvdtoken->[0];
 
         unless( $e->{'command'} ) {
             # Get the SMTP command name for the session
@@ -539,7 +529,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/Facebook.pm

@@ -155,7 +155,6 @@ sub inquire {
     return undef unless $recipients;
 
     for my $e ( @$dscontents ) {
-        $e->{'lhost'}   ||= $permessage->{'lhost'};
         $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
 
         my $p0 = index($e->{'diagnosis'}, '-');
@@ -226,7 +225,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/GSuite.pm

@@ -140,7 +140,6 @@ sub inquire {
 
     for my $e ( @$dscontents ) {
         # Set default values if each value is empty.
-        $e->{'lhost'} ||= $permessage->{'rhost'};
         $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage;
 
         if( exists $anotherset->{'diagnosis'} && $anotherset->{'diagnosis'} ) {
@@ -228,7 +227,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2017-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2017-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/GoogleGroups.pm

@@ -56,10 +56,9 @@ sub inquire {
 
     my @entiremesg = split(/\n\n/, $emailparts->[0], 5); pop @entiremesg;
     my $issuedcode = join(' ', @entiremesg); $issuedcode =~ y/\n/ /;
+    my $receivedby = $mhead->{'received'} || [];
     $recordwide->{'diagnosis'} = Sisimai::String->sweep($issuedcode);
-
-    my $serverlist = Sisimai::RFC5322->received($mhead->{'received'}->[0]);
-    $recordwide->{'rhost'} = shift @$serverlist;
+    $recordwide->{'rhost'}     = Sisimai::RFC5322->received($receivedby->[0])->[1];
 
     for my $e ( split(',', $mhead->{'x-failed-recipients'}) ) {
         # X-Failed-Recipients: [email protected], [email protected], ...
@@ -115,7 +114,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2020-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2020-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE
 

lib/Sisimai/Lhost/MXLogic.pm

@@ -80,7 +80,6 @@ sub inquire {
     my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
     my $readcursor = 0;     # (Integer) Points the current cursor position
     my $recipients = 0;     # (Integer) The number of 'Final-Recipient' header
-    my $localhost0 = '';    # (String) Local MTA
     my $v = undef;
 
     for my $e ( split("\n", $emailparts->[0]) ) {
@@ -126,20 +125,13 @@ sub inquire {
     }
     return undef unless $recipients;
 
-    if( scalar $mhead->{'received'}->@* ) {
-        # Get the name of local MTA
-        my $p1 = index(lc $mhead->{'received'}->[-1], 'from ');
-        my $p2 = index(   $mhead->{'received'}->[-1], ' ', $p1 + 5);
-
-        if( ($p1 + 1) * ($p2 + 1) > 0 ) {
-            # Received: from marutamachi.example.org (c192128.example.net [192.0.2.128])
-            $localhost0 = substr($mhead->{'received'}->[-1], $p1 + 5, $p2 - $p1 - 5);
-        }
-    }
+    # Get the name of the local MTA
+    # Received: from marutamachi.example.org (c192128.example.net [192.0.2.128])
+    my $receivedby = $mhead->{'received'} || [];
+    my $recvdtoken = Sisimai::RFC5322->received($receivedby->[-1]);
 
     for my $e ( @$dscontents ) {
-        # Set default values if each value is empty.
-        $e->{'lhost'}   ||=  $localhost0;
+        # Check the error message, the rhost, the lhost, and the smtp command.
         $e->{'diagnosis'} =~ s/[-]{2}.*\z//g;
         $e->{'diagnosis'} =  Sisimai::String->sweep($e->{'diagnosis'});
 
@@ -149,13 +141,11 @@ sub inquire {
             my $p2 = index($e->{'diagnosis'}, ' ', $p1 + 5);
 
             # host neko.example.jp [192.0.2.222]: 550 5.1.1 <[email protected]>... User Unknown
-            $e->{'rhost'} = substr($e->{'diagnosis'}, $p1 + 5, $p2 - $p1 - 5) if $p1 > -1;
-
-            unless( $e->{'rhost'} ) {
-                # Get localhost and remote host name from Received header.
-                $e->{'rhost'} = pop Sisimai::RFC5322->received($mhead->{'received'}->[-1])->@* if scalar $mhead->{'received'}->@*;
-            }
+            # Get the remote host name from the error message or the Received header.
+            $e->{'rhost'}   = substr($e->{'diagnosis'}, $p1 + 5, $p2 - $p1 - 5) if $p1 > -1;
+            $e->{'rhost'} ||= $recvdtoken->[1];
         }
+        $e->{'lhost'}   ||=  $recvdtoken->[0];
 
         unless( $e->{'command'} ) {
             # Get the SMTP command name for the session
@@ -232,7 +222,7 @@ azumakuniyuki
 
 =head1 COPYRIGHT
 
-Copyright (C) 2014-2023 azumakuniyuki, All rights reserved.
+Copyright (C) 2014-2024 azumakuniyuki, All rights reserved.
 
 =head1 LICENSE