view release on metacpan or  search on metacpan

lib/Git/Code/Review/Command/mailhandler.pm  view on Meta::CPAN

# ABSTRACT: Manage replies to the code review mailbox.
package Git::Code::Review::Command::mailhandler;
use strict;
use warnings;

use CLI::Helpers qw(
    debug
    debug_var
    output
    verbose
);
use Config::Auto;
use DateTime::Format::Mail;
use Email::Address;
use Email::Simple;
use Email::MIME;
use File::Spec;
use Git::Code::Review -command;
use Git::Code::Review::Notify;
use Git::Code::Review::Utilities qw(:all);
use Mail::IMAPClient;
use Mojo::DOM;
use Text::Wrap qw(fill);
use YAML;


my %METRICS = ();
my %CONFIG;
sub _init {
    return if scalar %CONFIG;
    %CONFIG = gcr_config();
    $CONFIG{ mailhandler } ||= {};
}


sub opt_spec {
    _init();
    my $mail_cfg = $CONFIG{ mailhandler };
    return (
        ['server:s',           "IMAP Server",                      {default=>exists $mail_cfg->{'global.server'}  ? $mail_cfg->{'global.server'} : 'localhost' }],
        ['port:i',             "IMAP Server Port",                 {default=>exists $mail_cfg->{'global.port'}    ? $mail_cfg->{'global.port'} : 993 }],
        ['folder:s',           "IMAP Folder to scan",              {default=>exists $mail_cfg->{'global.folder'}  ? $mail_cfg->{'global.folder'} : 'INBOX' }],
        ['ssl!',               "Use SSL. Use --no-ssl to turn off ssl", {default=>exists $mail_cfg->{'global.ssl'}  ? $mail_cfg->{'global.ssl'} : 1 }],
        ['credentials-file:s', "Location of the Credentials File", {default=>exists $mail_cfg->{'global.credentials-file'}  ? $mail_cfg->{'global.credentials-file'} : '/etc/code-review/mailhandler.config' }],
        ['dry-run',             "Test connection, show all configuration variables and exit",],
    );
}

sub description {
    my $DESC = <<"    EOH";
    SYNOPSIS

        git-code-review mailhandler [options]

    DESCRIPTION

        Manage replies to the code review mailbox.

    EXAMPLES

        git-code-review mailhandler

        git-code-review mailhandler --dry-run

        git-code-review mailhandler --dry-run --server mail.server.com --port 993 --credentials-file ~/mail.config

        git-code-review mailhandler --server mail.server.com --port 993 --credentials-file ~/mail.config

        git-code-review mailhandler --folder Replies

    OPTIONS
    EOH
    $DESC =~ s/^[ ]{4}//mg;
    return $DESC;
}

sub execute {
    my($cmd,$opt,$args) = @_;
    die "Not initialized, run git-code-review init!" unless gcr_is_initialized();
    die "Too many arguments: " . join( ' ', @$args ) if scalar @$args > 0;
    _init();
    $CONFIG{ mailhandler }{ 'global.auto-approve' } = 1 unless exists $CONFIG{ mailhandler }{ 'global.auto-approve' }; # not allowed to override via options
    my $auto_approve = $CONFIG{ mailhandler }{ 'global.auto-approve' };

    debug({color=>'cyan'},"Git::Code::Review Mailhandler Config");
    debug_var($opt);
    debug({clear => 1}, "Defaults");
    debug(Dump $CONFIG{mailhandler});

    my @missing_opts = grep { ! exists $opt->{ $_ } } qw( credentials_file server );    # ensure required options are provided
    if ( @missing_opts ) {
        output( {color=>'red',stderr=>1}, sprintf "Missing required options: %s", join( ', ', map { s/\_/-/g; } @missing_opts ) );
        exit 1;
    }
    if ( ! -f $opt->{ credentials_file } ) {
        output({color=>'red',stderr=>1}, sprintf "The credentials file %s does not exist. You can provide the right file with --credentials-file or configure it in global.credentials-file in mailhandler.config file", $opt->{ credentials_file } );
        exit 1;
    }

    # Parse the config file
    my $creds = Config::Auto::parse($opt->{credentials_file});

    # Try to grab the username/password
    my %mapping = (
        username => [qw(user userid username)],
        password => [qw(pass passwd password)],
    );
    my %credentials = ();
    foreach my $key (keys %mapping) {
        foreach my $try (@{ $mapping{$key} }) {
            next unless exists $creds->{$try};
            $credentials{$key} = $creds->{$try};
            last;
        }
        if(!exists $credentials{$key}) {
            output({color=>'red',stderr=>1}, "Unable to find the '$key' in $opt->{credentials_file}");
            exit 1;
        }
    }

    if ( $opt->{ dry_run } ) {
        # show config details for connection test
        output( 'Trying to connect to the mail server with the following settings.' );
        output( join( ": ", @$_ ) ) for (
            [ Server   => $opt->{ server } ],
            [ Port     => $opt->{ port } ],
            [ Ssl      => $opt->{ ssl } ],
            [ credentials_file  => $opt->{ credentials_file } ],
            [ User     => $credentials{ username } ],
            [ Password => '********' ],
            [ AutoApprove => ( $auto_approve ? '1' : '0' ) ],
        );
    }

    my $imap = Mail::IMAPClient->new(
        Server   => $opt->{server},
        Port     => $opt->{port},
        Ssl      => $opt->{ssl},
        User     => $credentials{username},
        Password => $credentials{password},
    ) or die "Unable to connect to $opt->{server}: $@";
    $METRICS{ connected } = 1;
    verbose({color=>'green'}, sprintf "Successfully connected to %s as %s.", $opt->{server}, $credentials{username});

    return if $opt->{ dry_run }; # we were just testing the connection to the mail server

    my @folders = $imap->folders;
    debug({indent=>1}, "+ Folders discovered: " . join(', ', @folders));

    $imap->select($opt->{folder});

    my @unseen = $imap->unseen();
    verbose({indent=>1}, sprintf "+ Found %d unread messages.", ( scalar @unseen ));
    $METRICS{ emails } = scalar @unseen ;

    # Reset these all the time
    my @EnvRelative = qw(
            GIT_AUTHOR_NAME
            GIT_AUTHOR_EMAIL
            GIT_AUTHOR_DATE
    );
    my %precedence;
    @precedence{qw(bulk junk auto_reply)} = ();

    my $refreshed = 0;
    foreach my $msg (@unseen) {
        # Reset key environment variables
        delete $ENV{$_} for @EnvRelative;
        debug({indent=>1}, "Processing $msg");
        # Basic Accessors
        my $email = Email::Simple->new($imap->message_string($msg));
        # For handling multipart messages without fucking everything up
        my $mime  = Email::MIME->new($imap->message_string($msg));

        my $body = undef;
        my @parts = $mime->subparts;
        if( @parts ) {
            foreach my $part (@parts) {
                debug({color=>'magenta'},sprintf "Subpart discovered is %s", $part->content_type);
                if ($part->content_type =~ m[text/plain]) {
                    $body = $part->body_str;
                    last;
                }
                elsif($part->content_type =~ m[text/html]) {
                    my $dom = Mojo::DOM->new($part->body);
                    $body = $dom->all_text;
                }
            }
        }
        $body ||= $mime->body_str;
        debug({color=>'magenta'}, $body);

        my %headers = $email->header_pairs;

        next if exists $headers{'X-Autoreply-Sent-To'};          # Out Of Office
        next if exists $headers{'X-Autorespond'};                # Out Of Office
        next if exists $headers{Precedence} and exists $precedence{lc $headers{Precedence}};  # Out of Office
        # Get Date
        my $received_dt = DateTime::Format::Mail->parse_datetime($headers{Date});
        next unless $received_dt;

        $ENV{GIT_AUTHOR_DATE} = $received_dt->datetime();