view release on metacpan or  search on metacpan

lib/App/FonBot/Plugin/Email.pm  view on Meta::CPAN

use Email::Simple;
use Email::MIME;
use Linux::Inotify2 qw/IN_MOVED_TO/;
use File::Slurp qw/read_file/;
use POE;
use Log::Log4perl qw//;

use File::Glob qw/bsd_glob GLOB_NOSORT/;
use Text::ParseWords qw/shellwords/;

use App::FonBot::Plugin::Common;
use App::FonBot::Plugin::Config qw/$email_batch_seconds $email_from $email_subject/;

##################################################

my $log=Log::Log4perl->get_logger(__PACKAGE__);

my %queues;
my %queue_alarms;
my $session;
my $inotify;

sub init{
	return unless $email_from && $email_subject;
	$log->info('initializing '.__PACKAGE__);
	$session = POE::Session->create(
		inline_states => {
			_start => \&email_start,
			send_message => \&email_send_message,
			flush_queue => \&email_flush_queue,
			inotify_readable => sub{
				$_[HEAP]{inotify}->poll
			},
			shutdown => sub{
				$_[KERNEL]->select_read($inotify)
			}
		},
	);
}

sub fini{
	$log->info('finishing '.__PACKAGE__);
	POE::Kernel->post($session, 'shutdown')
}


sub email_handle_new{
	for my $file (bsd_glob 'Maildir/new/*', GLOB_NOSORT) {
		my $email=Email::MIME->new(scalar read_file $file);

		#untaint $file
		$file =~ /^(.*)$/;
		$file = $1;

		unlink $file;
		return unless defined $email;

		my $replyto=$email->header('From');
		return unless defined $replyto;

		my ($user,$password)=split ' ', $email->header('Subject'), 2;
		chomp $password;

		$log->debug("Processing email from $user");

		eval { pwcheck $user, $password };
		if ($@) {
			$log->debug("Incorrect credentials in email subject from user $user. Exception: $@");
			POE::Kernel->yield(send_message => $replyto, "Incorrect credentials");
			return
		}

		$ok_user_addresses{"$user EMAIL $replyto"}=1;

		my $process_email_part = sub {
			local *__ANON__ = "process_email_part";	#Name this sub. See http://www.perlmonks.org/?node_id=304883

			my $part=$_[0];
			return unless $part->content_type =~ /text\/plain/;

			my @lines=split '\n', $part->body;

			for my $line (@lines) {
				last if $line =~ /^--/;
				$log->debug("Command received via email from $user: $line");
				sendmsg $user, undef, "EMAIL '$replyto'", shellwords $line
			}
		};

		$email->walk_parts($process_email_part);
	}
}

sub email_start{
	$_[KERNEL]->alias_set('EMAIL');
	$_[HEAP]{inotify} = Linux::Inotify2->new;
	$_[HEAP]{inotify}->watch('Maildir/new/',IN_MOVED_TO,\&email_handle_new);

	open $inotify,'<&=',$_[HEAP]{inotify}->fileno;
	$_[KERNEL]->select_read($inotify, 'inotify_readable');
	email_handle_new
}

sub email_send_message{
	my ($address, $message) = @_[ARG0,ARG1];

	$queues{$address}.=$message."\n";
	if (defined $queue_alarms{$address}) {
		$_[KERNEL]->delay_adjust($queue_alarms{$address}, $email_batch_seconds)
	} else {
		$queue_alarms{$address}=$_[KERNEL]->delay_set(flush_queue => $email_batch_seconds, $address)
	}
}

sub email_flush_queue{
	my ($queue) = $_[ARG0];
	return unless exists $queues{$queue};

	my $email=Email::Simple->create(
		header => [
			From => $email_from,
			To => $queue,
			Subject => $email_subject,
		],
		body => $queues{$queue}
	);