1package Sisimai::Lhost::Bigfoot; 2use parent 'Sisimai::Lhost'; 3use feature ':5.10'; 4use strict; 5use warnings; 6 7sub description { 'Bigfoot: http://www.bigfoot.com' } 8sub make { 9 # Detect an error from Bigfoot 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.1.10 15 my $class = shift; 16 my $mhead = shift // return undef; 17 my $mbody = shift // return undef; 18 my $match = 0; 19 20 # 'subject' => qr/\AReturned mail: /, 21 $match ||= 1 if rindex($mhead->{'from'}, '@bigfoot.com>') > -1; 22 $match ||= 1 if grep { rindex($_, '.bigfoot.com ') > -1 } @{ $mhead->{'received'} }; 23 return undef unless $match; 24 25 state $indicators = __PACKAGE__->INDICATORS; 26 state $rebackbone = qr|^Content-Type:[ ]message/partial|m; 27 state $markingsof = { 'message' => qr/\A[ \t]+[-]+[ \t]*Transcript of session follows/ }; 28 29 require Sisimai::RFC1894; 30 my $fieldtable = Sisimai::RFC1894->FIELDTABLE; 31 my $permessage = {}; # (Hash) Store values of each Per-Message field 32 33 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; 34 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone); 35 my $readcursor = 0; # (Integer) Points the current cursor position 36 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header 37 my $commandtxt = ''; # (String) SMTP Command name begin with the string '>>>' 38 my $esmtpreply = ''; # (String) Reply from remote server on SMTP session 39 my $v = undef; 40 my $p = ''; 41 42 for my $e ( split("\n", $emailsteak->[0]) ) { 43 # Read error messages and delivery status lines from the head of the email 44 # to the previous line of the beginning of the original message. 45 unless( $readcursor ) { 46 # Beginning of the bounce message or message/delivery-status part 47 $readcursor |= $indicators->{'deliverystatus'} if $e =~ $markingsof->{'message'}; 48 next; 49 } 50 next unless $readcursor & $indicators->{'deliverystatus'}; 51 next unless length $e; 52 53 if( my $f = Sisimai::RFC1894->match($e) ) { 54 # $e matched with any field defined in RFC3464 55 next unless my $o = Sisimai::RFC1894->field($e); 56 $v = $dscontents->[-1]; 57 58 if( $o->[-1] eq 'addr' ) { 59 # Final-Recipient: rfc822; kijitora@example.jp 60 # X-Actual-Recipient: rfc822; kijitora@example.co.jp 61 if( $o->[0] eq 'final-recipient' ) { 62 # Final-Recipient: rfc822; kijitora@example.jp 63 if( $v->{'recipient'} ) { 64 # There are multiple recipient addresses in the message body. 65 push @$dscontents, __PACKAGE__->DELIVERYSTATUS; 66 $v = $dscontents->[-1]; 67 } 68 $v->{'recipient'} = $o->[2]; 69 $recipients++; 70 71 } else { 72 # X-Actual-Recipient: rfc822; kijitora@example.co.jp 73 $v->{'alias'} = $o->[2]; 74 } 75 } elsif( $o->[-1] eq 'code' ) { 76 # Diagnostic-Code: SMTP; 550 5.1.1 <userunknown@example.jp>... User Unknown 77 $v->{'spec'} = $o->[1]; 78 $v->{'diagnosis'} = $o->[2]; 79 80 } else { 81 # Other DSN fields defined in RFC3464 82 next unless exists $fieldtable->{ $o->[0] }; 83 $v->{ $fieldtable->{ $o->[0] } } = $o->[2]; 84 85 next unless $f == 1; 86 $permessage->{ $fieldtable->{ $o->[0] } } = $o->[2]; 87 } 88 } else { 89 # The line does not begin with a DSN field defined in RFC3464 90 if( substr($e, 0, 1) ne ' ' ) { 91 # ----- Transcript of session follows ----- 92 # >>> RCPT TO:<destinaion@example.net> 93 # <<< 553 Invalid recipient destinaion@example.net (Mode: normal) 94 if( $e =~ /\A[>]{3}[ ]+([A-Z]{4})[ ]?/ ) { 95 # >>> DATA 96 $commandtxt = $1; 97 98 } elsif( $e =~ /\A[<]{3}[ ]+(.+)\z/ ) { 99 # <<< Response 100 $esmtpreply = $1; 101 } 102 } else { 103 # Continued line of the value of Diagnostic-Code field 104 next unless index($p, 'Diagnostic-Code:') == 0; 105 next unless $e =~ /\A[ \t]+(.+)\z/; 106 $v->{'diagnosis'} .= ' '.$1; 107 } 108 } 109 } continue { 110 # Save the current line for the next loop 111 $p = $e; 112 } 113 return undef unless $recipients; 114 115 for my $e ( @$dscontents ) { 116 # Set default values if each value is empty. 117 $e->{'lhost'} ||= $permessage->{'rhost'}; 118 $e->{ $_ } ||= $permessage->{ $_ } || '' for keys %$permessage; 119 120 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'}); 121 $e->{'command'} ||= $commandtxt || ''; 122 $e->{'command'} ||= 'EHLO' if $esmtpreply; 123 } 124 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] }; 125} 126 1271; 128__END__ 129 130=encoding utf-8 131 132=head1 NAME 133 134Sisimai::Lhost::Bigfoot - bounce mail parser class for C<Bigfoot>. 135 136=head1 SYNOPSIS 137 138 use Sisimai::Lhost::Bigfoot; 139 140=head1 DESCRIPTION 141 142Sisimai::Lhost::Bigfoot parses a bounce email which created by C<Bigfoot>. 143Methods in the module are called from only Sisimai::Message. 144 145=head1 CLASS METHODS 146 147=head2 C<B<description()>> 148 149C<description()> returns description string of this module. 150 151 print Sisimai::Lhost::Bigfoot->description; 152 153=head2 C<B<make(I<header data>, I<reference to body string>)>> 154 155C<make()> method parses a bounced email and return results as a array reference. 156See Sisimai::Message for more details. 157 158=head1 AUTHOR 159 160azumakuniyuki 161 162=head1 COPYRIGHT 163 164Copyright (C) 2014-2020 azumakuniyuki, All rights reserved. 165 166=head1 LICENSE 167 168This software is distributed under The BSD 2-Clause License. 169 170=cut 171 172