jBiff - Announcing New Mail via XMPP/Jabber

The Productivity People say turn off alerts for new mail, because it will suck your brain and suck your time. That's fine well and good. Except when you're coding and your boss shows up over your shoulder and says "Did you get my email?"

I hate having to respond "What email?" So, there's good reasons to have highly-specific alerts. And, to my knowledge, you can't really do that with Thunderbird and Epiphany. So, I began to wonder why I should even use those. Why not use Perl? It has Net::XMPP and more than one IMAP module.

So, I wrote jBiff. First there was biff, the command line tool. Then there was xbiff. Now, we have jBiff, telling your jabber client "You have mail."

I will put it on Github, soon after I figure out how.

#!/usr/bin/perl

# USAGE
# jBiff.pl -imap  -x  -s foo -s bar -s blee

use Carp ;
use Data::Dumper ;
use Getopt::Long ;
use IO::Socket::SSL ;
use IO::Interactive qw{interactive} ;
use Mail::IMAPClient ;
use Modern::Perl ;
use Net::XMPP ;
use subs qw{ imap_part xmpp_part } ;

$Data::Dumper::Indent = 1 ;
my @sender ;
my $debug ;
my $xmpp_identity ;
my $imap_identity ;
GetOptions( 'sender=s' => \@sender,
            'debug=i'  => \$debug,
            'xmpp=s'   => \$xmpp_identity,
            'imap=s'   => \$imap_identity, ) or exit( 1 ) ;

exit if !defined $imap_identity ;
exit if !defined $xmpp_identity ;
exit if length $imap_identity < 1 ;
exit if length $xmpp_identity < 1 ;

imap_part @sender ;

# ====================================================================
#
# Pull credentials from a configuration file
#
# ====================================================================
sub get_credentials {
    my ( $protocol, $identity ) = @_ ;
    my %config_files ;
    my %config_vals ;
    my %config ;

    $config_files{ imap } = '.imap_identities' ;
    $config_files{ smtp } = '.smtp_identities' ;
    $config_files{ xmpp } = '.xmpp_identities' ;

    $config_vals{ imap } = [ qw{
          key server port username password directory
          } ] ;
    $config_vals{ xmpp } = [ qw{
          key host component sender password recipient resource
          } ] ;
    my $stat = ( stat "$ENV{HOME}/$config_files{$protocol}" )[ 2 ] ;
    my $hex_stat = sprintf '%04o', $stat ;

    if ( $hex_stat != 100600 ) {
        say 'You should ensure that this file is not executable,' ;
        say ' and not world or group-readable or -writable.' ;
        exit ;
        }

    if (    -f "$ENV{HOME}/$config_files{$protocol}"
         && -r "$ENV{HOME}/$config_files{$protocol}" ) {
        if ( open my $fh, '<', "$ENV{HOME}/$config_files{$protocol}" ) {
            while ( <$fh> ) {
                chomp $_ ;
                $_ = ( split m{\#}mx, $_ )[ 0 ] ;
                my @creds = split m{\s*,\s*}mx, $_ ;
                next if scalar @creds < 6 ;
                for my $i ( 1 .. $#creds ) {
                    my $key  = $creds[ 0 ] ;
                    my $val  = $creds[ $i ] ;
                    my $key2 = $config_vals{ $protocol }[ $i ] ;
                    $config{ $key }{ $key2 } = $val ;
                    }
                }
            close $fh ;
            }
        my $href = $config{ $identity } ;
        return %$href ;
        }
    else {
        say "No Configuration" ;
        exit ;
        }
    exit ;
    }

# --------------------------------------------------------------------

# ====================================================================
#
# connect to and search your mail server via IMAP
#
# ====================================================================
sub imap_part {
    my @sender = @_ ;
    my $sender = join '|', @sender ;
    my %creds  = get_credentials( 'imap', $imap_identity ) ;

    my $socket = IO::Socket::SSL->new( PeerAddr => $creds{ server },
                                       PeerPort => $creds{ port },
                                       ) or die "socket(): $@" ;

    my $client = Mail::IMAPClient->new( Socket   => $socket,
                                        User     => $creds{ username },
                                        Password => $creds{ password },
                                        ) or die "new(): $@" ;

    if ( $client->IsAuthenticated() ) {
        $client->select( $creds{ directory } )
          or die "Select '$creds{directory}' error: ",
          $client->LastError, "\n" ;

        for my $msg ( reverse $client->unseen ) {
            my $from = $client->get_header( $msg, 'From' ) ;
            my $to   = $client->get_header( $msg, 'To' ) ;
            my $subject = $client->subject( $msg )
              or die "Could not subject $@\n" ;
            if ( $from =~ m{$sender}i ) {
                my $title = 'New mail from ' . $from ;
                my $body  = $subject ;
                $body = join q{"}, '', $body, '' ;
                xmpp_part "$title - $body" ;
                }
            }
        $client->logout() ;
        }
    else {
        say 'FAIL ' . $! ;
        }
    }

# --------------------------------------------------------------------

# ====================================================================
#
# send message via XMPP/Jabber
#
# ====================================================================
sub xmpp_part {
    my $args = shift ;
    my %creds = get_credentials( 'xmpp', $xmpp_identity ) ;

    # connection
    my $hostname       = $creds{ host } ;
    my $port           = 5222 ;
    my $componentname  = $creds{ component } ;
    my $connectiontype = 'tcpip' ;
    my $tls            = 1 ;

    #login
    my $username = $creds{ sender } ;
    my $password = $creds{ password } ;
    my $resource = $creds{ resource } ;

    #msg_to
    my @field ;
    push @field, $creds{ recipient } ;

    my $Connection = new Net::XMPP::Client() ;

    # Connect to talk.google.com
    my $status = $Connection->Connect( hostname       => $hostname,
                                       port           => $port,
                                       componentname  => $componentname,
                                       connectiontype => $connectiontype,
                                       tls            => $tls ) ;
    if ( !( defined( $status ) ) ) {
        print "ERROR: XMPP connection failed.\n" ;
        print " ($!)\n" ;
        exit( 0 ) ;
        }

    # Change hostname
    my $sid = $Connection->{ SESSION }->{ id } ;
    $Connection->{ STREAM }->{ SIDS }->{ $sid }->{ hostname } = $componentname ;

    # Authenticate
    my @result = $Connection->AuthSend( username => $username,
                                        password => $password,
                                        resource => $resource ) ;

    if ( $result[ 0 ] ne "ok" ) {
        print "ERROR: Authorization failed: $result[0] - $result[1]\n" ;
        exit( 0 ) ;
        }

    # Send messages
    foreach ( @field ) {
        $Connection->MessageSend( to       => "$_\@$componentname",
                                  resource => $resource,
                                  subject  => "Notification",
                                  type     => "chat",
                                  body     => $args ) ;
        }

    $Connection->Disconnect() ;
    }

# --------------------------------------------------------------------