imap downloader

imap.pl

#!/usr/bin/env perl

=head1 DESCRIPTION

IMAP downloader.

Usage:

    perl imap.pl -u 'user' -p 'password' -s 'imap.gmail.com' -d './download-dir' -subdir 'maildir' -q 'search-query' -id 999 -from 999

Environment:

    IMAP_DIR
    IMAP_USER
    IMAP_PASS
    IMAP_SERV

=cut
use v5.10;
use strict;
use warnings;
use Net::IMAP::Simple::SSL;
use Email::Simple;
use Class::Date qw/now date -DateParse/;
use Path::Class;
use Email::MIME::Attachment::Stripper;
use YAML::XS;

# globals
our %opts = get_options( @ARGV );
our $DIR = $opts{d} // $ENV{IMAP_DIR} // './imap';
our $MAILDIR = $opts{subdir} ? dir( $DIR, $opts{subdir} ) : $DIR; 
our $USER = $opts{u} || $ENV{IMAP_USER};
our $PASS = $opts{p} // $ENV{IMAP_PASS};
our $SERV = $opts{s} || $ENV{IMAP_SERV} || 'imap.gmail.com';
if( defined $USER && ! defined $PASS ) {
    require Term::ReadKey;
    print "PASSWORD: ";
    Term::ReadKey::ReadMode('noecho');
    $PASS = Term::ReadKey::ReadLine(0);
    Term::ReadKey::ReadMode(0);
    chomp $PASS;
    say '';
}
dir( $MAILDIR )->mkpath;
die "Error: Could not access/create IMAP dir '$MAILDIR'\n" unless -d $MAILDIR;
die "Error: Missing user/password\n" unless defined $USER && defined $PASS;

# load the db and create a logger
our $db = load_db();
# save only last 10 logs
my %old_logs = %{ $db->{logs} || {} };
if( keys %old_logs > 3 ) {
    my @k = sort keys %old_logs;
    $db->{logs} = { map { $_ => $db->{logs}->{$_} } @k[ -3 .. -1 ] };
}

our $log = $db->{logs}->{ Class::Date::now() } = [];
sub logme{ push @$log, $_[0]; say now() . " " . $_[0]; @_ };

( my $pass2 = $PASS ) =~ s{.}{**}g;
logme "CONNECTING to $SERV with $USER/$pass2...";
my $imap = Net::IMAP::Simple::SSL->new( $SERV ) ||
   die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
 
if(!$imap->login( $USER, $PASS )){
    print STDERR "Login failed: " . $imap->errstr . "\n";
    exit(64);
}

logme "CONNECTED.";

my $query = $opts{q};
if( defined $query ) {
    logme "RUNNING SEARCH on '$query'";
    my @ids = $imap->search(qq{OR BODY "$query" SUBJECT "$query"});
    if( defined( my $id = $opts{id} ) ) {
        @ids = ref $id eq 'ARRAY' ? @$id : ($id) ;
    }
    list(@ids);
} elsif( defined( my $id = $opts{id} ) ) {
    logme "ID '$id'";
    my @ids = ref $id eq 'ARRAY' ? @$id : ($id);
    list(@ids);
} else {
    my $last = $imap->last; 
    logme "LAST_IN_DB=$db->{last}, LAST_IN_MBOX=$last";
    my $from = $opts{from} // $db->{last} // $last - 100; # on first time get the top 100
    if( $last > $from ){
        logme "last=$last";
        #my @msgs = $imap->seq("$top:$last");
        logme "LAST=$last to $from";
        list( reverse $from .. $last );
    } else {
        logme "Nothing new.";
    }
}

logme "Done.";
save_db( $db );
exit 0;

sub list{
    for my $msgnum ( @_ ) {
        #say "M=$msgnum";
        my $msg = $imap->get( $msgnum );
        unless( ref $msg ) {
            logme "Message Not Found: $msgnum";
            next;
        }
        my $body = join '',@$msg;
        my $email = Email::Simple->new( $body );
        my %m = $email->header_pairs;
        my $rec = date [split /;/, $m{Received}]->[1];
        my $subject = Encode::decode('MIME-Header', $m{Subject} );
        logme "$msgnum: $subject  - $m{From} $rec";
        use Encode qw/encode decode/;
        dump_email( $subject, $body, $msgnum);
        $db->{last} = $msgnum if $db->{last} < $msgnum;
    }
}

sub dump_email {
	my ( $subject, $msg, $msgnum) = @_;
    ( my $subj_file = $subject ) =~ s/\W+/_/g;
    $subj_file =~ s/\s+/_/g;
    $subj_file =~ s/__+/_/g;
    my $msgdir = dir( $MAILDIR, "$msgnum-$subj_file" );
    # mail folder
    $msgdir->mkpath;
    # convert data
	my $st = Email::MIME::Attachment::Stripper->new( $msg );

    if( ! $st->attachments ) {
        # simple message
        my $file = file $msgdir, 'body.txt';
        open my $ff, '>:raw', $file;
        print $ff $msg ;
        close $ff;
        logme "Simple message written to body.txt";
        return;
    }
    # attachments and message body are all the same
	for my $attach (  $st->attachments ) {
		my $fn = $attach->{filename};
		next unless defined $fn;
        # mail filename
        my $data = $attach->{payload};
        # if noname, its a msg body
        if( !$fn ) {
            my $ext = $data=~m/CALENDAR/s ? 'txt' : 'html'; 
            $fn = $subj_file . ".$ext";
            my $i = 0;
            my $file = file $msgdir, $fn;
            while( -e $file ) {
                $fn = $subj_file . '_' . ++$i . ".$ext";
                $file = file $msgdir, $fn;
            }
        }
		my $file = file $msgdir, $fn;
        # save me
		logme "    ===> $file";
		open my $ff, '>', $file;
		binmode $ff;
		print $ff $data;
		close $ff;
        logme "    Saved file $fn from message $msgnum.";
	}
}

sub load_db {
    my $db_file = file( $DIR, 'db.yaml' ); 
    if( ! -e $db_file ) {   # doesn't exist, touch file
        open my $ff, '>', $db_file;
        close $ff;
        return {};
    } else {
        return Load( scalar $db_file->slurp );
    }
}

sub save_db {
    my $db = shift;
    my $db_file = file( $DIR, 'db.yaml' ); 
    open my $ff, '>', $db_file;
    binmode $ff;
    print $ff Dump( $db );
    close $ff;
}

# usage: my %opts = get_options @ARGV
sub get_options {
    my ( $last_opt, %hash );
    for my $opt (@_) {
        if ( $opt =~ m/^-+(.*)/ ) {
            $last_opt = $1;
            $hash{$last_opt} = [] unless ref $hash{$last_opt};
        }
        else {
            $opt =  Encode::encode_utf8($opt) if Encode::is_utf8($opt);
            push @{ $hash{$last_opt} }, $opt; 
        }
    }
    # convert single option => scalar
    for( keys %hash ) {
        if( @{ $hash{$_} } == 1 ) {
            $hash{$_} = $hash{$_}->[0]; 
        }
    }
    return %hash;
}