File Coverage

lib/Sisimai/Data.pm

Criterion	Covered	Total	%
statement	198	202	98.0
branch	104	132	78.7
condition	71	100	71.0
subroutine	15	15	100.0
pod	2	4	50.0
total	390	453	86.0

package Sisimai::Data;
use feature ':5.10';
use strict;
use warnings;
use Sisimai::Address;
use Sisimai::String;
use Sisimai::Reason;
use Sisimai::Rhost;
use Sisimai::Time;
use Sisimai::DateTime;
use Sisimai::SMTP::Error;
use Class::Accessor::Lite (
    'new' => 0,
    'rw'  => [
        'catch',    # [?] Results generated by hook method
        'token',    # [String] Message token/MD5 Hex digest value
        'lhost',    # [String] local host name/Local MTA
        'rhost',    # [String] Remote host name/Remote MTA
        'alias',    # [String] Alias of the recipient address
        'listid',   # [String] List-Id header of each ML
        'reason',   # [String] Bounce reason
        'action',   # [String] The value of Action: header
        'origin',   # [String] Email path as a data source
        'subject',  # [String] UTF-8 Subject text
        'timestamp',    # [Sisimai::Time] Date: header in the original message
        'addresser',    # [Sisimai::Address] From address
        'recipient',    # [Sisimai::Address] Recipient address which bounced
        'messageid',    # [String] Message-Id: header
        'replycode',    # [String] SMTP Reply Code
        'smtpagent',    # [String] Module(Engine) name
        'softbounce',   # [Integer] 1 = Soft bounce, 0 = Hard bounce, -1 = ?
        'smtpcommand',  # [String] The last SMTP command
        'destination',  # [String] The domain part of the "recipinet"
        'senderdomain', # [String] The domain part of the "addresser"
        'feedbacktype', # [String] Feedback Type
        'diagnosticcode',   # [String] Diagnostic-Code: Header
        'diagnostictype',   # [String] The 1st part of Diagnostic-Code: Header
        'deliverystatus',   # [String] Delivery Status(DSN)
        'timezoneoffset',   # [Integer] Time zone offset(seconds)
    ]
);

sub new {
    # Constructor of Sisimai::Data
    # @param    [Hash] argvs    Data
    # @return   [Sisimai::Data] Structured email data
    my $class = shift;
    my $argvs = { @_ };

    # Create email address object
    my $as = Sisimai::Address->make($argvs->{'addresser'});
    my $ar = Sisimai::Address->make({ 'address' => $argvs->{'recipient'} });
    return undef unless ref $as eq 'Sisimai::Address';
    return undef unless ref $ar eq 'Sisimai::Address';

    my $thing = {
        'addresser' => $as,
        'recipient' => $ar,
        'senderdomain' => $as->host,
        'destination'  => $ar->host,
        'alias' => $argvs->{'alias'} || $ar->alias,
        'token' => Sisimai::String->token($as->address, $ar->address, $argvs->{'timestamp'}),
    };

    # Create Sisimai::Time object
    $thing->{'timestamp'} = Sisimai::Time->new($argvs->{'timestamp'});
    $thing->{'timezoneoffset'} = $argvs->{'timezoneoffset'} // '+0000';

    # Callback method
    $thing->{'catch'} = $argvs->{'catch'} // undef;

    my @v1 = (qw|
        listid subject messageid smtpagent diagnosticcode diagnostictype deliverystatus
        reason lhost rhost smtpcommand feedbacktype action softbounce replycode origin
    |);
    $thing->{ $_ } = $argvs->{ $_ } // '' for @v1;
    $thing->{'replycode'} ||= Sisimai::SMTP::Reply->find($argvs->{'diagnosticcode'}) || '';

    return bless($thing, __PACKAGE__);
}

sub make {
    # Another constructor of Sisimai::Data
    # @param        [Hash] argvs
    # @option argvs [Sisimai::Message] data Data Object
    # @option argvs [Integeer] delivered    Include "delivered" status or not
    # @return       [Array, Undef]     List of Sisimai::Data or Undef if the
    #                                  argument is not Sisimai::Message object
    my $class = shift;
    my $argvs = { @_ };

    return undef unless exists $argvs->{'data'};
    return undef unless ref $argvs->{'data'} eq 'Sisimai::Message';
    return undef unless $argvs->{'data'}->ds;
    return undef unless $argvs->{'data'}->rfc822;

    state $retryindex = Sisimai::Reason->retry;
    state $rfc822head = Sisimai::RFC5322->HEADERFIELDS('all');

    my $delivered1 = $argvs->{'delivered'} // 0;
    my $messageobj = $argvs->{'data'};
    my $rfc822data = $messageobj->rfc822;
    my $objectlist = [];

    LOOP_DELIVERY_STATUS: for my $e ( @{ $messageobj->ds } ) {
        # Create parameters for new() constructor.
        my $p = {
            'catch'          => $messageobj->catch   // undef,
            'lhost'          => $e->{'lhost'}        // '',
            'rhost'          => $e->{'rhost'}        // '',
            'alias'          => $e->{'alias'}        // '',
            'action'         => $e->{'action'}       // '',
            'reason'         => $e->{'reason'}       // '',
            'replycode'      => $e->{'replycode'}    // '',
            'smtpagent'      => $e->{'agent'}        // '',
            'recipient'      => $e->{'recipient'}    // '',
            'softbounce'     => $e->{'softbounce'}   // '',
            'smtpcommand'    => $e->{'command'}      // '',
            'feedbacktype'   => $e->{'feedbacktype'} // '',
            'diagnosticcode' => $e->{'diagnosis'}    // '',
            'diagnostictype' => $e->{'spec'}         // '',
            'deliverystatus' => $e->{'status'}       // '',
        };
        unless( $delivered1 ) {
            # Skip if the value of "deliverystatus" begins with "2." such as 2.1.5
            next if index($p->{'deliverystatus'}, '2.') == 0;
        }

        EMAIL_ADDRESS: {
            # Detect email address from message/rfc822 part
            for my $f ( @{ $rfc822head->{'addresser'} } ) {
                # Check each header in message/rfc822 part
                my $h = lc $f;
                next unless exists $rfc822data->{ $h };
                next unless $rfc822data->{ $h };

                my $j = Sisimai::Address->find($rfc822data->{ $h }) || [];
                next unless scalar @$j;
                $p->{'addresser'} = $j->[0];
                last;
            }

            unless( $p->{'addresser'} ) {
                # Fallback: Get the sender address from the header of the bounced
                # email if the address is not set at loop above.
                my $j = Sisimai::Address->find($messageobj->{'header'}->{'to'}) || [];
                $p->{'addresser'} = $j->[0] if scalar @$j;
            }
        }
        next unless $p->{'addresser'};
        next unless $p->{'recipient'};

        TIMESTAMP: {
            # Convert from a time stamp or a date string to a machine time.
            my $datestring = undef;
            my $zoneoffset = 0;
            my @datevalues; push @datevalues, $e->{'date'} if $e->{'date'};

            # Date information did not exist in message/delivery-status part,...
            for my $f ( @{ $rfc822head->{'date'} } ) {
                # Get the value of Date header or other date related header.
                next unless $rfc822data->{ $f };
                push @datevalues, $rfc822data->{ $f };
            }

            # Set "date" getting from the value of "Date" in the bounce message
            push @datevalues, $messageobj->{'header'}->{'date'} if scalar(@datevalues) < 2;

            while( my $v = shift @datevalues ) {
                # Parse each date value in the array
                $datestring = Sisimai::DateTime->parse($v);
                last if $datestring;
            }

            if( defined $datestring && $datestring =~ /\A(.+)[ ]+([-+]\d{4})\z/ ) {
                # Get the value of timezone offset from $datestring
                # Wed, 26 Feb 2014 06:05:48 -0500
                $datestring = $1;
                $zoneoffset = Sisimai::DateTime->tz2second($2);
                $p->{'timezoneoffset'} = $2;
            }

            eval {
                # Convert from the date string to an object then calculate time
                # zone offset.
                my $t = Sisimai::Time->strptime($datestring, '%a, %d %b %Y %T');
                $p->{'timestamp'} = ($t->epoch - $zoneoffset) // undef;
            };
        }
        next unless defined $p->{'timestamp'};

        OTHER_TEXT_HEADERS: {
            # Scan "Received:" header of the original message
            my $recvheader = $argvs->{'data'}->{'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]) };
            }

            for my $v ('rhost', 'lhost') {
                $p->{ $v } =~ y/[]()//d;    # Remove square brackets and curly brackets from the host variable
                $p->{ $v } =~ s/\A.+=//;    # Remove string 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
                $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
            }

            # Subject: header of the original message
            $p->{'subject'} = $rfc822data->{'subject'} // '';
            chop $p->{'subject'} if substr($p->{'subject'}, -1, 1) eq "\r";

            if( $p->{'listid'} = $rfc822data->{'list-id'} // '' ) {
                # Get the value of List-Id header: "List name "
                $p->{'listid'} =  $1 if $p->{'listid'} =~ /\A.*([<].+[>]).*\z/;
                $p->{'listid'} =~ y/<>//d;
                chop $p->{'listid'}  if substr($p->{'listid'}, -1, 1) eq "\r";
                $p->{'listid'} =  '' if rindex($p->{'listid'}, ' ') > -1;
            }

            if( $p->{'messageid'} = $rfc822data->{'message-id'} // '' ) {
                # Leave only string inside of angle brackets(<>)
                $p->{'messageid'} = $1 if $p->{'messageid'} =~ /\A([^ ]+)[ ].*/;
                $p->{'messageid'} = $1 if $p->{'messageid'} =~ /[<]([^ ]+?)[>]/;
            }

            CHECK_DELIVERY_STATUS_VALUE: {
                # Cleanup the value of "Diagnostic-Code:" header
                chop $p->{'diagnosticcode'} if substr($p->{'diagnosticcode'}, -1, 1) eq "\r";

                if( $p->{'diagnosticcode'} ) {
                    # Count the number of D.S.N. and SMTP Reply Code
                    my $vs = Sisimai::SMTP::Status->find($p->{'diagnosticcode'});
                    my $vr = Sisimai::SMTP::Reply->find($p->{'diagnosticcode'});
                    my $vm = 0;

                    if( $vs ) {
                        # How many times does the D.S.N. appeared
                        $vm += 1 while $p->{'diagnosticcode'} =~ /\b\Q$vs\E\b/g;
                        $p->{'deliverystatus'} = $vs if $vs =~ /\A[45][.][1-9][.][1-9]\z/;
                    }

                    if( $vr ) {
                        # How many times does the SMTP reply code appeared
                        $vm += 1 while $p->{'diagnosticcode'} =~ /\b$vr\b/g;
                        $p->{'replycode'} ||= $vr;
                    }

                    if( $vm > 2 ) {
                        # Build regular expression for removing string like '550-5.1.1'
                        # from the value of "diagnosticcode"
                        my $re = qr/[ ]$vr[- ](?:\Q$vs\E)?/;

                        # 550-5.7.1 [192.0.2.222] Our system has detected that this message is
                        # 550-5.7.1 likely unsolicited mail. To reduce the amount of spam sent to Gmail,
                        # 550-5.7.1 this message has been blocked. Please visit
                        # 550 5.7.1 https://support.google.com/mail/answer/188131 for more information.
                        $p->{'diagnosticcode'} =~ s/$re/ /g;
                        $p->{'diagnosticcode'} =~ s|.+||i;
                        $p->{'diagnosticcode'} =  Sisimai::String->sweep($p->{'diagnosticcode'});
                    }
                }
                $p->{'diagnostictype'} ||= 'X-UNIX'   if $p->{'reason'} eq 'mailererror';
                $p->{'diagnostictype'} ||= 'SMTP' unless $p->{'reason'} =~ /\A(?:feedback|vacation)\z/;
            }

            # Check the value of SMTP command
            $p->{'smtpcommand'} = '' unless $p->{'smtpcommand'} =~ /\A(?:EHLO|HELO|MAIL|RCPT|DATA|QUIT)\z/;
            $p->{'origin'} = $argvs->{'origin'};    # Set the path to the original email

            # Check "Action:" field
            next if length $p->{'action'};
            if( $p->{'reason'} eq 'expired' ) {
                # Action: delayed
                $p->{'action'} = 'delayed';

            } elsif( index($p->{'deliverystatus'}, '5') == 0 || index($p->{'deliverystatus'}, '4') == 0 ) {
                # Action: failed
                $p->{'action'} = 'failed';
            }
        }
        next unless my $o = __PACKAGE__->new(%$p);

        if( $o->reason eq '' || exists $retryindex->{ $o->reason } ) {
            # Decide the reason of email bounce
            my $r; $r   = Sisimai::Rhost->get($o) if Sisimai::Rhost->match($o->rhost);
                   $r ||= Sisimai::Rhost->get($o, $o->destination) if Sisimai::Rhost->match($o->destination);
                   $r ||= Sisimai::Reason->get($o);
                   $r ||= 'undefined';
            $o->reason($r);
        }

        if( $o->reason eq 'delivered' || $o->reason eq 'feedback' || $o->reason eq 'vacation' ) {
            # The value of reason is "delivered", "vacation" or "feedback".
            $o->softbounce(-1);
            $o->replycode('') unless $o->reason eq 'delivered';

        } else {
            # Bounce message which reason is "feedback" or "vacation" does
            # not have the value of "deliverystatus".
            unless( length $o->softbounce ) {
                # Set the value of softbounce
                my $textasargv = $p->{'deliverystatus'}.' '.$p->{'diagnosticcode'};
                substr($textasargv, 0, 1, '') if substr($textasargv, 0, 1) eq ' ';
                my $softorhard = Sisimai::SMTP::Error->soft_or_hard($o->reason, $textasargv);

                if( $softorhard ) {
                    # Returned value is "soft" or "hard"
                    $o->softbounce($softorhard eq 'soft' ? 1 : 0);

                } else {
                    # Returned value is an empty string or undef
                    $o->softbounce(-1);
                }
            }

            unless( $o->deliverystatus ) {
                # Set pseudo status code
                my $textasargv = $o->replycode.' '.$p->{'diagnosticcode'};
                substr($textasargv, 0, 1, '') if substr($textasargv, 0, 1) eq ' ';

                my $getchecked = Sisimai::SMTP::Error->is_permanent($textasargv);
                my $tmpfailure = defined $getchecked ? ( $getchecked == 1 ? 0 : 1 ) : 0;

                if( my $pseudocode = Sisimai::SMTP::Status->code($o->reason, $tmpfailure) ) {
                    # Set the value of "deliverystatus" and "softbounce".
                    $o->deliverystatus($pseudocode);
                    if( $o->softbounce == -1 ) {
                        # Set the value of "softbounce" again when the value is -1
                        if( my $softorhard = Sisimai::SMTP::Error->soft_or_hard($o->reason, $pseudocode) ) {
                            # Returned value is "soft" or "hard"
                            $o->softbounce($softorhard eq 'soft' ? 1 : 0);

                        } else {
                            # Returned value is an empty string or undef
                            $o->softbounce(-1);
                        }
                    }
                }
            }

            if( $o->replycode ) {
                # Check both of the first digit of "deliverystatus" and "replycode"
                my $d1 = substr($o->deliverystatus, 0, 1);
                my $r1 = substr($o->replycode, 0, 1);
                $o->replycode('') unless $d1 eq $r1;
            }
        }
        push @$objectlist, $o;

    } # End of for(LOOP_DELIVERY_STATUS)

    return $objectlist;
}

sub damn {
    # Convert from object to hash reference
    # @return   [Hash] Data in Hash reference
    my $self = shift;
    my $data = undef;

    eval {
        my $v = {};
        state $stringdata = [qw|
            token lhost rhost listid alias reason subject messageid smtpagent
            smtpcommand destination diagnosticcode senderdomain deliverystatus
            timezoneoffset feedbacktype diagnostictype action replycode catch
            softbounce origin
        |];

        for my $e ( @$stringdata ) {
            # Copy string data
            $v->{ $e } = $self->$e // '';
        }
        $v->{'addresser'} = $self->addresser->address;
        $v->{'recipient'} = $self->recipient->address;
        $v->{'timestamp'} = $self->timestamp->epoch;
        $data = $v;
    };
    return $data;
}

sub dump {
    # Data dumper
    # @param    [String] type   Data format: json, yaml
    # @return   [String, Undef] Dumped data or Undef if the value of first
    #                           argument is neither "json" nor "yaml"
    my $self = shift;
    my $type = shift || 'json';
    return undef unless $type =~ /\A(?:json|yaml)\z/;

    my $referclass = 'Sisimai::Data::'.uc($type);
    my $modulepath = 'Sisimai/Data/'.uc($type).'.pm';

    require $modulepath;
    return $referclass->dump($self);
}

1;
__END__