view release on metacpan or  search on metacpan

lib/App/Eduard.pm  view on Meta::CPAN

package App::Eduard;

use 5.014000;
use strict;
use warnings;
use parent qw/Exporter/;
our $VERSION = '0.001002';
our @EXPORT_OK = qw/import_pubkeys process_message/;

use Email::Sender::Simple qw/sendmail/;
use File::Share qw/dist_file/;
use File::Slurp qw/read_file/;
use File::Spec::Functions qw/rel2abs/;
use IO::Handle;
use Getopt::Long;
use MIME::Entity;
use MIME::Parser;
use Mail::GnuPG;
use PerlX::Maybe;
use Template;
use Try::Tiny;

sub debug { say STDERR @_ if $ENV{EDUARD_DEBUG} }
sub stringify ($) { join '', map {; '>', $_ } @{$_[0]} }
sub mg {
	Mail::GnuPG->new(
		key                => $ENV{EDUARD_KEY},
		maybe always_trust => $ENV{EDUARD_ALWAYS_TRUST},
		maybe keydir       => $ENV{EDUARD_KEYDIR},
		maybe passphrase   => $ENV{EDUARD_PASSPHRASE},
		maybe use_agent    => $ENV{EDUARD_USE_AGENT},
		@_);
}

sub mp {
	my $parser = MIME::Parser->new;
	$parser->decode_bodies($_[0] // 0);
	$parser->output_to_core(1);
	$parser
}

sub first_part{
	my ($ent) = @_;
	return first_part ($ent->parts(0)) if $ent->parts;
	stringify [$ent->bodyhandle->as_lines]
}

sub import_pubkeys {
	my ($ent, $mg) = @_;
	my @keys;
	if ($ent->mime_type eq 'application/pgp-keys') {
		$ent = mp(1)->parse_data($ent->stringify);
		my $gpg = GnuPG::Interface->new;
		$mg->_set_options($gpg);
		$gpg->options->quiet(1);
		my ($input, $status) = (IO::Handle->new, IO::Handle->new);
		my $pid = $gpg->import_keys(handles => GnuPG::Handles->new(stdin => $input, status => $status));
		my $read = Mail::GnuPG::_communicate([$status], [$input], {$input => $ent->bodyhandle->as_string});
		push @keys, map { /IMPORT_OK \d+ (\w+)/ } $read->{$status};
		waitpid $pid, 0
	}
	push @keys, import_pubkeys ($_, $mg) for $ent->parts;
	@keys
}

sub find_pgp_part {
	my ($ent, $mg) = @_;
	do {
		my $part = find_pgp_part ($_, $mg);
		return $part if $part
	} for $ent->parts;
	return $ent if $ent->bodyhandle && ($mg->is_signed($ent) || $mg->is_encrypted($ent));
	return
}

sub process_message {
	my ($in) = @_;
	my $msg;
	my $parser = mp;

	$msg =                      $in   if     ref $in eq 'MIME::Entity';