view release on metacpan or  search on metacpan

lib/Mail/DMARC/Report/Receive.pm  view on Meta::CPAN

package Mail::DMARC::Report::Receive;
use strict;
use warnings;
use feature 'signatures';
no warnings 'experimental::signatures';    ## no critic (ProhibitNoWarnings)
use feature 'try';
no warnings 'experimental::try';    ## no critic (ProhibitNoWarnings)

our $VERSION = '2.20260621';

use Carp;
use Data::Dumper;
use Email::MIME;
use Email::Simple;
use Encode;
use File::Basename;
use IO::Uncompress::Unzip;
use IO::Uncompress::Gunzip;
use Module::Load;
use XML::LibXML;

use parent 'Mail::DMARC::Base';
require Mail::DMARC::Policy;
require Mail::DMARC::Report;
require Mail::DMARC::Report::Aggregate::Record;

sub from_imap($self) {
    try {
        load "Net::IMAP::Simple";
    }
    catch ($error) {
        croak "Net::IMAP::Simple seems to not work, is it installed? $error";
    }

    my $server = $self->config->{imap}{server} or croak "no imap server conf";
    my $folder = $self->config->{imap}{folder} or croak "no imap folder conf";
    my $a_done = $self->config->{imap}{a_done};
    my $f_done = $self->config->{imap}{f_done};
    my $port   = $self->config->{imap}{port} // 993;

    if ( $port != 143 ) {
        try {
            require IO::Socket::SSL;
        }
        catch ($error) {
            croak "Can't load IO::Socket::SSL: $error\n";
        }

        if ( defined $self->config->{imap}{SSL_verify_mode} ) {
            IO::Socket::SSL::set_ctx_defaults(
                SSL_verifycn_scheme => 'imap',
                SSL_verify_mode     => $self->config->{imap}{SSL_verify_mode},
            );
        }
    }

    no warnings qw(once);    ## no critic (Warn)
    my $imap = Net::IMAP::Simple->new(
        $server,
        port    => $port,
        use_ssl => $port != 143,
        )
        or do {
        ## no critic (PackageVar)
        my $err
            = $port == 143
            ? $Net::IMAP::Simple::errstr
            : $Net::IMAP::Simple::SSL::errstr;
        croak "Unable to connect to IMAP: $err\n";
        };

    print "connected to IMAP server $server:$port\n" if $self->verbose;

    $imap->login( $self->config->{imap}{user}, $self->config->{imap}{pass} )
        or croak "Login failed: " . $imap->errstr . "\n";

    print "\tlogged in\n" if $self->verbose;

    my $nm = $imap->select( $self->config->{imap}{folder} );
    $imap->expunge_mailbox( $self->config->{imap}{folder} );
    my @mess = $imap->search( 'UNSEEN', 'DATE' );
    if ( !@mess ) {

        # imap server might not support SORT extension *Gmail*
        @mess = $imap->search('UNSEEN');
    }

    print "\tfound " . scalar @mess . " messages\n" if $self->verbose;

    foreach my $i (@mess) {
        print $imap->seen($i) ? '*' : ' ';
        printf "[%03d] ", $i;
        my $message = $imap->get($i) or do {
            carp "unable to get message $i\n";
            next;
        };
        my $type = $self->from_email_simple( Email::Simple->new("$message") );
        next if !$type;
        my $done_box
            = $type eq 'aggregate' ? $a_done
            : $type eq 'forensic'  ? $f_done
            :                        croak "unknown type!";

        $imap->add_flags( $i, '\Seen' );
        if ($done_box) {
            $imap->copy( $i, $done_box ) or do {
                carp $imap->errstr;
                next;
            };
            $imap->add_flags( $i, '\Deleted' );