1package Sisimai::Lhost::Sendmail; 2use parent 'Sisimai::Lhost'; 3use feature ':5.10'; 4use strict; 5use warnings; 6 7sub description { 'V8Sendmail: /usr/sbin/sendmail' } 8sub make { 9 # Parse bounce messages from Sendmail 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 parse or the arguments are missing 14 # @since v4.0.0 15 my $class = shift; 16 my $mhead = shift // return undef; 17 my $mbody = shift // return undef; 18 19 return undef unless $mhead->{'subject'} =~ /(?:see transcript for details\z|\AWarning: )/; 20 return undef if $mhead->{'x-aol-ip'}; # X-AOL-IP is a header defined in AOL 21 22 state $indicators = __PACKAGE__->INDICATORS; 23 state $rebackbone = qr<^Content-Type:[ ](?:message/rfc822|text/rfc822-headers)>m; 24 state $startingof = { 25 # savemail.c:1040|if (printheader && !putline(" ----- Transcript of session follows -----\n", 26 # savemail.c:1041| mci)) 27 # savemail.c:1042| goto writeerr; 28 # savemail.c:1360|if (!putline( 29 # savemail.c:1361| sendbody 30 # savemail.c:1362| ? " ----- Original message follows -----\n" 31 # savemail.c:1363| : " ----- Message header follows -----\n", 32 'message' => [' ----- Transcript of session follows -----'], 33 'error' => ['... while talking to '], 34 }; 35 36 require Sisimai::RFC1894; 37 my $fieldtable = Sisimai::RFC1894->FIELDTABLE; 38 my $permessage = {}; # (Hash) Store values of each Per-Message field 39 40 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; 41 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone); 42 my $readcursor = 0; # (Integer) Points the current cursor position 43 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header 44 my $commandtxt = ''; # (String) SMTP Command name begin with the string '>>>' 45 my $esmtpreply = []; # (Array) Reply from remote server on SMTP session 46 my $sessionerr = 0; # (Integer) Flag, 1 if it is SMTP session error 47 my $anotherset = {}; # (Hash) Another error information 48 my $v = undef; 49 my $p = ''; 50 51 for my $e ( split("\n", $emailsteak->[0]) ) { 52 # Read error messages and delivery status lines from the head of the email 53 # to the previous line of the beginning of the original message. 54 unless( $readcursor ) { 55 # Beginning of the bounce message or message/delivery-status part 56 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0; 57 next; 58 } 59 next unless $readcursor & $indicators->{'deliverystatus'}; 60 next unless length $e; 61 62 if( my $f = Sisimai::RFC1894->match($e) ) { 63 # $e matched with any field defined in RFC3464 64 next unless my $o = Sisimai::RFC1894->field($e); 65 $v = $dscontents->[-1]; 66 67 if( $o->[-1] eq 'addr' ) { 68 # Final-Recipient: rfc822; kijitora@example.jp 69 # X-Actual-Recipient: rfc822; kijitora@example.co.jp 70 if( $o->[0] eq 'final-recipient' ) { 71 # Final-Recipient: rfc822; kijitora@example.jp 72 if( $v->{'recipient'} ) { 73 # There are multiple recipient addresses in the message body. 74 push @$dscontents, __PACKAGE__->DELIVERYSTATUS; 75 $v = $dscontents->[-1]; 76 } 77 $v->{'recipient'} = $o->[2]; 78 $recipients++; 79 80 } else { 81 # X-Actual-Recipient: rfc822; kijitora@example.co.jp 82 $v->{'alias'} = $o->[2]; 83 } 84 } elsif( $o->[-1] eq 'code' ) { 85 # Diagnostic-Code: SMTP; 550 5.1.1 <userunknown@example.jp>... User Unknown 86 $v->{'spec'} = $o->[1]; 87 $v->{'diagnosis'} = $o->[2]; 88 89 } else { 90 # Other DSN fields defined in RFC3464 91 next unless exists $fieldtable->{ $o->[0] }; 92 $v->{ $fieldtable->{ $o->[0] } } = $o->[2]; 93 94 next unless $f == 1; 95 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2]; 96 } 97 } else { 98 # The line does not begin with a DSN field defined in RFC3464 99 # 100 # ----- Transcript of session follows ----- 101 # ... while talking to mta.example.org.: 102 # >>> DATA 103 # <<< 550 Unknown user recipient@example.jp 104 # 554 5.0.0 Service unavailable 105 if( substr($e, 0, 1) ne ' ') { 106 # Other error messages 107 if( $e =~ /\A[>]{3}[ ]+([A-Z]{4})[ ]?/ ) { 108 # >>> DATA 109 $commandtxt = $1; 110 111 } elsif( $e =~ /\A[<]{3}[ ]+(.+)\z/ ) { 112 # <<< Response 113 push @$esmtpreply, $1 unless grep { $1 eq $_ } @$esmtpreply; 114 115 } else { 116 # Detect SMTP session error or connection error 117 next if $sessionerr; 118 if( index($e, $startingof->{'error'}->[0]) == 0 ) { 119 # ----- Transcript of session follows ----- 120 # ... while talking to mta.example.org.: 121 $sessionerr = 1; 122 next; 123 } 124 125 if( $e =~ /\A[<](.+)[>][.]+ (.+)\z/ ) { 126 # <kijitora@example.co.jp>... Deferred: Name server: example.co.jp.: host name lookup failure 127 $anotherset->{'recipient'} = $1; 128 $anotherset->{'diagnosis'} = $2; 129 130 } else { 131 # ----- Transcript of session follows ----- 132 # Message could not be delivered for too long 133 # Message will be deleted from queue 134 if( $e =~ /\A[45]\d\d[ \t]([45][.]\d[.]\d)[ \t].+/ ) { 135 # 550 5.1.2 <kijitora@example.org>... Message 136 # 137 # DBI connect('dbname=...') 138 # 554 5.3.0 unknown mailer error 255 139 $anotherset->{'status'} = $1; 140 $anotherset->{'diagnosis'} .= ' '.$e; 141 142 } elsif( index($e, 'Message: ') == 0 || index($e, 'Warning: ') == 0 ) { 143 # Message could not be delivered for too long 144 # Warning: message still undelivered after 4 hours 145 $anotherset->{'diagnosis'} .= ' '.$e; 146 } 147 } 148 } 149 } else { 150 # Continued line of the value of Diagnostic-Code field 151 next unless index($p, 'Diagnostic-Code:') == 0; 152 next unless $e =~ /\A[ \t]+(.+)\z/; 153 $v->{'diagnosis'} .= ' '.$1; 154 } 155 } 156 } continue { 157 # Save the current line for the next loop 158 $p = $e; 159 } 160 return undef unless $recipients; 161 162 for my $e ( @$dscontents ) { 163 # Set default values if each value is empty. 164 $e->{'lhost'} ||= $permessage->{'rhost'}; 165 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage; 166 $e->{'command'} ||= $commandtxt || ''; 167 $e->{'command'} ||= 'EHLO' if scalar @$esmtpreply; 168 169 if( exists $anotherset->{'diagnosis'} && $anotherset->{'diagnosis'} ) { 170 # Copy alternative error message 171 $e->{'diagnosis'} = $anotherset->{'diagnosis'} if $e->{'diagnosis'} =~ /\A[ \t]+\z/; 172 $e->{'diagnosis'} ||= $anotherset->{'diagnosis'}; 173 $e->{'diagnosis'} = $anotherset->{'diagnosis'} if $e->{'diagnosis'} =~ /\A\d+\z/; 174 } 175 if( scalar @$esmtpreply ) { 176 # Replace the error message in "diagnosis" with the ESMTP Reply 177 my $r = join(' ', @$esmtpreply); 178 $e->{'diagnosis'} = $r if length($r) > length($e->{'diagnosis'}); 179 } 180 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'}); 181 182 if( exists $anotherset->{'status'} && $anotherset->{'status'} ) { 183 # Check alternative status code 184 if( ! $e->{'status'} || $e->{'status'} !~ /\A[45][.]\d[.]\d{1,3}\z/ ) { 185 # Override alternative status code 186 $e->{'status'} = $anotherset->{'status'}; 187 } 188 } 189 190 # @example.jp, no local part 191 # Get email address from the value of Diagnostic-Code header 192 next if $e->{'recipient'} =~ /\A[^ ]+[@][^ ]+\z/; 193 $e->{'recipient'} = $1 if $e->{'diagnosis'} =~ /[<]([^ ]+[@][^ ]+)[>]/; 194 } 195 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] }; 196} 197 1981; 199__END__ 200 201=encoding utf-8 202 203=head1 NAME 204 205Sisimai::Lhost::Sendmail - bounce mail parser class for v8 Sendmail. 206 207=head1 SYNOPSIS 208 209 use Sisimai::Lhost::Sendmail; 210 211=head1 DESCRIPTION 212 213Sisimai::Lhost::Sendmail parses a bounce email which created by v8 Sendmail. 214Methods in the module are called from only Sisimai::Message. 215 216=head1 CLASS METHODS 217 218=head2 C<B<description()>> 219 220C<description()> returns description string of this module. 221 222 print Sisimai::Lhost::Sendmail->description; 223 224=head2 C<B<make(I<header data>, I<reference to body string>)>> 225 226C<make()> method parses a bounced email and return results as a array reference. 227See Sisimai::Message for more details. 228 229=head1 AUTHOR 230 231azumakuniyuki 232 233=head1 COPYRIGHT 234 235Copyright (C) 2014-2021 azumakuniyuki, All rights reserved. 236 237=head1 LICENSE 238 239This software is distributed under The BSD 2-Clause License. 240 241=cut 242