Mail-DMARC

 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;

our $VERSION = '1.20260306';

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 {
    my $self = shift;
    load "Net::IMAP::Simple";
    croak "Net::IMAP::Simple seems to not work, is it installed?" if $@;

    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) {
        eval "use IO::Socket::SSL";  ## no critic (Eval)
        if ( $@ ) {
            croak "Can't load IO::Socket::SSL: $!\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 (! scalar @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' );
        };
    }

    $imap->quit;
    return 1;
}



( run in 3.294 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )