File Coverage

lib/Haineko/SMTPD/Session.pm

Criterion	Covered	Total	%
statement	120	136	88.2
branch	32	60	53.3
condition	20	30	66.6
subroutine	19	19	100.0
pod	3	12	25.0
total	194	257	75.4

package Haineko::SMTPD::Session;
use feature ':5.10';
use strict;
use warnings;
use Class::Accessor::Lite;
use Haineko::SMTPD::Response;
use Haineko::SMTPD::Address;
use Time::Piece;

my $rwaccessors = [
    'stage',        # (Integer)
    'started',      # (Time::Piece) When it connected
    'response',     # (Ref->Array->Haineko::SMTPD::Response) SMTP Reponse
    'addresser',    # (Haineko::SMTPD::Address) Envelope sender
    'recipient',    # (Ref->Arrey->Haineko::SMTPD::Address) Envelope recipients
];
my $roaccessors = [
    'queueid',      # (String) Queue ID
    'referer',      # (String) HTTP REFERER
    'useragent',    # (String) User agent name
    'remoteaddr',   # (String) Client IP address
    'remoteport',   # (String) Client port number
];
my $woaccessors = [];
Class::Accessor::Lite->mk_accessors( @$rwaccessors );
Class::Accessor::Lite->mk_ro_accessors( @$roaccessors );


sub new {
    my $class = shift;
    my $argvs = { @_ };
    my $nekor = $argvs->{'response'} || undef;
    my $nekos = {
        'stage'    => $argvs->{'stage'} // 0,
        'started'  => Time::Piece->new,
        'queueid'  => $argvs->{'queueid'}  || __PACKAGE__->make_queueid,
    };

    if( $nekor ) {
        if( ref $nekor eq 'Haineko::SMTPD::Response' ) {
            # Response in the argument is an object
            $nekos->{'response'} = [ $nekor ];

        } elsif( ref $nekor eq 'ARRAY' ) {
            # Response in the argument is an array reference
            $nekos->{'response'} = [];
            for my $e ( @$nekor ) {
                # Check each item:
                #   Haineko::SMTPD::Response object or HASH reference
                if( ref $e eq 'Haineko::SMTPD::Response' ) {
                    push @{ $nekos->{'response'} }, $e;

                } elsif( ref $e eq 'HASH' ) {
                    # Create Haineko::SMTPD::Response object from the HASH reference
                    push @{ $nekos->{'response'} }, Haineko::SMTPD::Response->new( %$e );
                }
            }
        }
    }
    map { $nekos->{ $_ } ||= $argvs->{ $_ } || undef } @$roaccessors;

    while(1) {
        # Create email address objects
        my $c = 'Haineko::SMTPD::Address';
        my $r = [];
        my $t = $argvs->{'recipient'} || [];

        map { push @$r, $c->new( 'address' => $_ ) } @$t;
        $nekos->{'recipient'} = $r if scalar @$r;

        last unless defined $argvs->{'addresser'};
        $nekos->{'addresser'} = $c->new( 'address' => $argvs->{'addresser'} );

        last;
    }
    return bless $nekos, __PACKAGE__;
}

sub make_queueid {
    my $class = shift;
    my $size1 = 16;
    my $time1 = new Time::Piece;
    my $chars = [ '0'..'9', 'A'..'Z', 'a'..'x' ];
    my $idstr = q();
    my $queue = {
        'Y' => $chars->[ $time1->_year % 60 ],
        'M' => $chars->[ $time1->_mon ],
        'D' => $chars->[ $time1->mday ],
        'h' => $chars->[ $time1->hour ],
        'm' => $chars->[ $time1->min ],
        's' => $chars->[ $time1->sec ],
        'q' => $chars->[ int rand(60) ],
        'p' => sprintf( "%05d", $$ ),
    };

    $idstr .= $queue->{ $_ } for ( qw/Y M D h m s q p/ );

    while(1) {
        $idstr .= $chars->[ int rand( scalar( @$chars ) ) ];
        last if length $idstr == $size1;
    }
    return $idstr;
}

sub done {
    my $class = shift;
    my $argvs = shift || return 0;  # (String) SMTP Command
    my $value = {
        'ehlo' => ( 1 << 0 ),
        'auth' => ( 1 << 1 ),
        'mail' => ( 1 << 2 ),
        'rcpt' => ( 1 << 3 ),
        'data' => ( 1 << 4 ),
        'quit' => ( 1 << 5 ),
    };
    return $value->{ $argvs } || 0;
}

sub add_response {
    my $self = shift;
    my $argv = shift || return $self;

    return $self unless ref $argv eq 'Haineko::SMTPD::Response';
    push @{ $self->{'response'} }, $argv;
    return $self;
}

sub ehlo {
    my $self = shift;
    my $argv = shift || 0;  # (Integer)
    my $ehlo = __PACKAGE__->done('ehlo');
    $self->{'stage'} = $ehlo if $argv;
    return $self->{'stage'} & $ehlo ? 1 : 0;
}

sub auth {
    my $self = shift;
    my $argv = shift || 0;
    my $auth = __PACKAGE__->done('auth');
    $self->{'stage'} |= $auth if $argv;
    return $self->{'stage'} & $auth ? 1 : 0;
}

sub mail {
    my $self = shift;
    my $argv = shift || 0;
    my $mail = __PACKAGE__->done('mail');
    $self->{'stage'} |= $mail if $argv;
    return $self->{'stage'} & $mail ? 1 : 0;
}

sub rcpt {
    my $self = shift;
    my $argv = shift || 0;
    my $rcpt = __PACKAGE__->done('rcpt');
    $self->{'stage'} |= $rcpt if $argv;
    return $self->{'stage'} & $rcpt ? 1 : 0;
}

sub data {
    my $self = shift;
    my $argv = shift || 0;
    my $data = __PACKAGE__->done('data');
    $self->{'stage'} |= $data if $argv;
    return $self->{'stage'} & $data ? 1 : 0;
}

sub rset {
    my $self = shift;
    $self->{'stage'} = __PACKAGE__->done('ehlo');
    return 1;
}

sub quit {
    my $self = shift;
    $self->{'stage'} = 0;
    return 1;
}

sub damn {
    my $self = shift;
    my $smtp = {};

    for my $e ( @$rwaccessors, @$roaccessors ) {

        next if $e =~ m/(?:response|addresser|recipient|started|stage)/;
        $smtp->{ $e } = $self->{ $e };
    }

    while(1) {
        last unless defined $self->{'addresser'};
        last unless ref $self->{'addresser'};
        last unless ref $self->{'addresser'} eq 'Haineko::SMTPD::Address';

        $smtp->{'addresser'} = $self->{'addresser'}->address;
        last;
    }

    while(1) {
        last unless defined $self->{'recipient'};
        last unless ref $self->{'recipient'} eq 'ARRAY';

        $smtp->{'recipient'} = [];
        for my $e ( @{ $self->{'recipient'} } ) {

            next unless ref $e eq 'Haineko::SMTPD::Address';
            push @{ $smtp->{'recipient'} }, $e->address;
        }
        last;
    }

    while(1) {
        last unless defined $self->{'response'};
        last unless ref $self->{'response'} eq 'ARRAY';

        $smtp->{'response'} = [];
        for my $e ( @{ $self->{'response'} } ) {
            next unless ref $e eq 'Haineko::SMTPD::Response';
            push @{ $smtp->{'response'} }, $e->damn;
        }

        last if scalar @{ $smtp->{'response'} };
        $smtp->{'response'} = [ Haineko::SMTPD::Response->new ];
        last;
    }

    $smtp->{'timestamp'} = {
        'datetime' => $self->started->cdate,
        'unixtime' => $self->started->epoch,
    };
    return $smtp;
}

1;
__END__