The Old Monk

mutt addressbook collector

I have a tiny helper script to collect addresses from my outgoing emails, and add them to my .aliases file. I only care about people who I send out email to, and I've noticed that collecting addresses from incoming emails leads to too much noise. Although I could set it up to *not* pick up addresses from spam and mails which have my firstname (ecommerce stuff which is NOT spam). But that's for later.

Here's the helper (I use msmtp for sending out email as evindent in my mutt config) :

#!/usr/bin/perl -w
use strict;

my $home = "/home/gera";
my $msmtp = "/usr/bin/msmtp";
my $aliasfile = "/home/gera/.aliases";

open ALIASES, "<$aliasfile" or quit("cannot open $aliasfile : $!");
my %aliases = ();
my %collected = ();
while() {
	s/#.*$//;
	chomp;
	next unless $_;
	my ($nick, $name, $email) = ($_ =~ /^alias\t+(\S+)\t+(.+?)\t+<(\S+)>/);
	quit("cannot parse $_") unless ($nick && $name && $email);
	$aliases{$email} = {
		"nick"	=> $nick,
		"name"	=> $name,
	};
}
close ALIASES;

# now read the email contents and try to figure out the addresses
local $/ = undef;	# slurp mode

my $email = ;
my ($to) = ($email =~ /^To:(.*)$/m);
my ($cc) = ($email =~ /^Cc:(.*)$/m);
my @addresses = split( /,/, "$to,$cc");
foreach my $address (@addresses) {
	chomp;
	next unless $address;
	# the address is of the form of "Firstname Lastname "
	# or "" or "email@address"
	my ($name, undef, $email) = ($address =~ /^(.*?)\s*(<|)([^<>]*?)(>|)$/);
	quit("cannot parse $address") unless $email;
	next if exists $aliases{$email};
	# else, add it to the aliases.
	# See if everything is populated. We'll have to invent a nickname here
	if(! $name) {
		($name = $email) =~ s/\@.*//;
	}
	my $nick;
	($nick = lc $name) =~ tr/ //d;
	$collected{$email} = {
		"nick"	=> $nick,
		"name"	=> $name,
	};
}

if(scalar(keys %collected) != 0) {
	# save to tmp file
	open ALIASES, ">$aliasfile.new.$$" or quit("cannot open $aliasfile.new.$$ : $!");
	foreach my $email (sort keys %aliases) {
		my $nick = $aliases{$email}->{nick};
		my $name = $aliases{$email}->{name};
		print ALIASES "alias	$nick	$name	<$email>\n";
	}
	print ALIASES "\n\n#collected email addresses\n\n";
	foreach my $email (sort keys %collected) {
		my $nick = $collected{$email}->{nick};
		my $name = $collected{$email}->{name};
		print ALIASES "alias	$nick	$name	<$email>\n";
	}
	close ALIASES;

	# move tmp file to $aliasfile
	rename("$aliasfile.new.$$", $aliasfile);
}

# send mail onward
open(MSMTP, "|$msmtp @ARGV") or quit("cannot open pipe to $msmtp @ARGV : $!");
print MSMTP $email;
close(MSMTP) or quit("cannot close pipe to MSMTP : $!");

exit(0);


sub quit
{
	my $msg = shift;
	open LOGFILE, ">$home/.msmtp_helper.log" || die "cannot open log file : $!";
	print LOGFILE "$msg\n";
	close LOGFILE;
	exit(127);
}

Edit : fixed formatting.