We live in a world of spam, of free email accounts and large mailing lists. You do
not want to enable promiscuous notifications in such a world. That way lies madness.
But never knowing that the important people in your life — those you love, those who pay you, those who fix your guitars — are trying to contact you because you've turned off notifications is madness also. Perhaps a worse madness.
But Perl exists. CPAN exists. There is a way out.
I wrote a program for more general-purpose mail-handling, mostly clearing spam out of my work accounts, but decided to rewrite in order to handle the act of warning that I had new mail.
#!/home/jacoby/perl5/perlbrew/perls/perl-5.20.2/bin/perl
# specialized version of imap_task that handles just warnings.
# problem with previous attempts is that it kept warning about
# new mail that matched until it was marked it read or deleted
# the goal is to do things once, with a data store independent
# from IMAP that indicates if the warning has been sent.
# YAML? JSON? Mongo? We'll try YAML.
use feature qw'say state' ;
use strict ;
use warnings ;
use utf8 ;
use Carp ;
use DateTime ;
use DateTime::Duration ;
use DateTime::Format::DateParse ;
use Getopt::Long ;
use IO::Interactive qw{interactive} ;
use IO::Socket::SSL ;
use Mail::IMAPClient ;
use YAML::XS qw{ LoadFile DumpFile } ;
use lib '/home/jacoby/lib' ;
use Locked ;
use Notify qw{ notify } ;
use Pushover ;
use Say qw{ say_message } ;
I have gone to
perlbrew for most of my usable Perl, and I would normally use
#!/usr/bin/env perl as my hashbang, but it is hard to tell crontab to use a perl other than system perl, so rather than trying, I specify the perl I want. Your usage will vary.
The next four non-code lines are my standard. That's mostly
use Modern::Perl, I think, but I like being able to specify.
After that, there's a bunch of modules from CPAN.
IO::Socket::SSL and
Mail::IMAPClient are crucial for interacting with the mail server,
YAML::XS is the better YAML module,
according to Gabor Szabo. I like programs that give me verbose output when I run them, but don't clog my cron inbox when run via crontab, so I really overuse
IO::Interactive. I am not sure that I need all the
DateTime stuff I load for this purpose, but better safe than sorry.
Then there's the stuff that I wrote for purposes such as this. I have many programs that I want to behave differently if the computer is locked, which means I'm not at my standing desk, so I wrote
Locked. I wanted to use notify-send on my Ubuntu machines to pop up notifications, so I wrote Notify.
Net::Pushover wasn't written when I started this, so I wrote
Pushover to interact with
Pushover and should've put it on CPAN myself. Alas. And
Say doesn't have to do with
say(), but rather is a wrapper around
eSpeak, a speech synthesizer.
my @sender ;
my $debug = 0 ;
my $task ;
$task = 'work_alert' ;
GetOptions(
'debug=i' => \$debug,
# 'task=s' => \$task,
)
or exit(1) ;
# get the configuration
my $config_file = $ENV{HOME} . '/.imap/' . $task . '.yml' ;
croak 'No task set' if length $task < 1 ;
croak 'No task file' if !-f $config_file ;
my $settings = LoadFile($config_file) ;
$settings->{debug} = $debug ;
# set a message if one hasn't been set
$settings->{message} = $settings->{message} ? $settings->{message} : 'You have mail' ;
my $has_spoken = 0 ;
say {interactive} '='x20;
my $warn_file = $ENV{HOME} . '/.imap_warn.yml' ;
my $warnings = LoadFile($warn_file) ;
check_imap($settings) ;
DumpFile( $warn_file , $warnings ) ;
say {interactive} '-'x20;
exit ;
Here I establish a bunch of globals and everything up for check_imap(), the main part of this program.
There are two YAML files that this program uses. One is
.imap_warn.yml, which is a hash where the key is "$FROM||$SUBJECT||$DATE" and the value is 1, so I can tell if I've been told about a certain email before, and
.imap/work_alert.yml, which is the main configuration file, and looks like this:
---
server: mailserver.example.com
port: 993
username: username
password: you_dont_get_my_password
message: 'You have mail'
folders:
INBOX:
alert:
subject:
- 'big data'
from:
# Family
- jacoby
# The Lab
- boss@example.com
I have used a separate file to hold the specifications for my SMTP and IMAP servers, but here, having all the config in one place seemed right. Since it contains password information, it is especially important that permissions are set correctly, specifically only you can read it. I do not test permissions in this program.
As mentioned, this is adapted from a more general mail-handling program, which takes specific configuration files for the kind of work it does. This just has the one, so that has been commented out, leaving just the debug flag.
I have had issues with YAML empty-writing files, which is why I separated .imap_warn from work_alert.pl.
sub check_imap {
my $settings = shift ;
my $client ;
if ( $settings->{port} == 993 ) {
my $socket = IO::Socket::SSL->new(
PeerAddr => $settings->{server},
PeerPort => $settings->{port},
)
or die "socket(): $@" ;
$client = Mail::IMAPClient->new(
Socket => $socket,
User => $settings->{username},
Password => $settings->{password},
)
or die "new(): $@" ;
}
elsif ( $settings->{port} == 587 ) {
$client = Mail::IMAPClient->new(
Server => $settings->{server},
User => $settings->{username},
Password => $settings->{password},
)
or die "new(): $@" ;
}
my $dispatch ;
$dispatch->{'alert'} = \&alert_and_store_mail ;
$dispatch->{'warn'} = \&warn_mail ;
if ( $client->IsAuthenticated() ) {
say {interactive} 'STARTING' ;
for my $folder ( keys %{ $settings->{folders} } ) {
say {interactive} join ' ', ( '+' x 5 ), $folder ;
$client->select($folder)
or die "Select '$folder' error: ",
$client->LastError, "\n" ;
my $actions = $settings->{folders}->{$folder} ;
for my $msg ( reverse $client->unseen ) {
my $from = $client->get_header( $msg, 'From' ) || '' ;
my $to = $client->get_header( $msg, 'To' ) || '' ;
my $cc = $client->get_header( $msg, 'Cc' ) || '' ;
my $subject = $client->subject($msg) || '' ;
say {interactive} 'F: ' . $from ;
say {interactive} 'S: ' . $subject ;
# say { interactive } 'T: ' . $to ;
# say { interactive } 'C: ' . $cc ;
for my $action ( keys %$actions ) {
# say { interactive } ' for action: ' . $action ;
for my $key ( @{ $actions->{$action}->{from} } ) {
if ( defined $key
&& $from =~ m{$key}i
&& $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
for my $key ( @{ $actions->{$action}->{to} } ) {
if ( $to =~ m{$key}i && $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
for my $key ( @{ $actions->{$action}->{cc} } ) {
if ( $cc =~ m{$key}i && $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
for my $key ( @{ $actions->{$action}->{subject} } ) {
my $match = $subject =~ m{$key}i ;
if ( $subject =~ m{$key}i && $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
}
say {interactive} '' ;
}
say {interactive} join ' ', ( '-' x 5 ), $folder ;
}
# $client->close() is needed to make deletes delete, put putting before the
# logout stops the process.
$client->close ;
$client->logout() ;
say {interactive} 'Finishing' ;
}
say {interactive} 'Bye' ;
}
There are four things we can match on: from, to, cc and subject. I generally match on subject and from, but the code is there.
I have started but not finished
Higher Order Perl by Mark Jason Dominus, but one of the things I got from that book (I
think; if not, then from co-workers) is the concept of a dispatch table, where behavior of the program changes based on the data. I could simplify this a lot more, I'm sure, with more higher-order programming, but I'm reasonably happy with it right now.
# ====================================================================
# send to STDOUT without IO::Interactive, for testing
sub warn_mail {
my ( $client, $msg ) = @_ ;
say {interactive} 'warn' ;
my $from = $client->get_header( $msg, 'From' ) || return ;
my $to = $client->get_header( $msg, 'To' ) || return ;
my $subject = $client->subject($msg) || return ;
my $date = $client->get_header( $msg, 'Date' ) || return ;
my $dt = DateTime::Format::DateParse->parse_datetime($date) ;
my $today = DateTime->now() ;
$dt->set_time_zone('UTC') ;
$today->set_time_zone('UTC') ;
my $delta = $today->delta_days($dt)->in_units('days') ;
say $from ;
say $to ;
say $subject ;
say $dt->ymd ;
say $delta ;
}
# ====================================================================
# alert about new mail
sub alert_and_store_mail {
my ( $client, $msg ) = @_ ;
say {interactive} 'alert and store' ;
my $date = $client->get_header( $msg, 'Date' ) || 'NONE' ;
my $from = $client->get_header( $msg, 'From' ) || 'NONE' ;
my $to = $client->get_header( $msg, 'To' ) || 'NONE' ;
my $subject = $client->subject($msg) || 'NONE' ;
my $key = join '||' , $from , $subject , $date ;
$key =~ s{\s+}{ }g ;
my $title = 'Mail From: ' . $from ;
chomp $title ;
chomp $subject ;
return if $warnings->{$key} ;
$warnings->{$key} = 1 ;
$from =~ s{\"}{}gx ;
if ( is_locked() ) {
pushover(
{ title => $title ,
message => $subject
}
) ;
}
else {
say {interactive} $title ;
say {interactive} $subject ;
say {interactive} defined $warnings->{$key} ? 1 : 0 ;
say {interactive} 'has spoken: ' . $has_spoken ;
if ( ! $has_spoken ) {
say_message( { message => $settings->{message} , title => '' } ) ;
}
notify(
{ title => $title ,
message => $subject ,
icon => '/home/jacoby/Dropbox/Photos/Icons/mail.png' ,
}
) ;
}
$has_spoken = 1 ;
return ;
}
warn() is useful for debugging, but the work of the program is done in
alert_and_store_mail().
$client is the IMAP connection, and
$msg is the message itself. I find that I have to send both. I might be doing it wrong, though.
And here is where my modules come in.
is_locked() returns a boolean, depending on which way you lock your screens.
say_message(),
pushover() and
notify() share a format, a hashref containing title and message.
say_message() tells me that I have notifications coming, and they show up on my desktop. And if I'm away from my desk, they show up on my tablet because of Pushover.
I'll put this into
a repo on GitHub, including all the modules. I would like to get this into shape to be something like App::imap_warn or the like, but I'm not there yet. I'm sure there's interest, because default notifications suck.
