use strict;
use warnings;
use threads;
use threads::shared;
use IO::Socket::INET;
use File::Next;
use Email::Simple;
{
my %files2id : shared;
my %id2mailbox : shared;
sub add_file {
my ($mailbox,$file,$id)=@_;
lock(%files2id);
$files2id{$mailbox}||=&share({});
$files2id{$mailbox}->{$file}=$id;
$id2mailbox{$id}||=&share([]);
push @{$id2mailbox{$id}},$mailbox;
return;
}
sub del_file {
my ($mailbox,$file)=@_;
lock(%files2id);
return unless exists $files2id{$mailbox};
return unless exists $files2id{$mailbox}->{$file};
my $id=delete $files2id{$mailbox}->{$file};
return unless exists $id2mailbox{$id};
@{$id2mailbox{$id}}=grep {$_ ne $mailbox} @{$id2mailbox{$id}};
delete $id2mailbox{$id} unless @{$id2mailbox{$id}};
return;
}
sub get_mailboxes {
my ($id)=@_;
lock(%files2id);
return unless exists $id2mailbox{$id};
return @{$id2mailbox{$id}};
}
}
sub id_from_file {
my ($dir,$file)=@_;
open my $fh,'<',"$dir/$file" or return;
while (my $line=<$fh>) {
$line=~s{[\x0d\x0a]+\z}{};
return unless length($line);
$line =~ m{^Message-ID: \s* <(\S+?)>}xi and return $1;
}
return;
}
sub split_refs {
my ($str)=@_;
return unless $str;
$str=~s{^.*<}{};$str=~s{>.*$}{};
return split />.*?</,$str;
}
sub mailbox_from_path {
my ($dir)=@_;
$dir=~m{/.maildir/(.*?)/(?:cur|new|tmp)} and return $1;
return;
}
sub ignorable {
return $_[0] =~ m{(?:^|/)(?:\.mail\.SPAM|\.Trash)(?:/|$)};
}
sub scan_directory {
my $files=File::Next::files({
file_filter => sub {
($File::Next::dir =~ m{/(?:cur|new)(?:/|$)})
and
($_ !~ m{^dovecot});
},
descend_filter => sub {
!ignorable($_);
},
follow_symlinks=>0,
}, "$ENV{HOME}/.maildir");
my ($dir,$file,$fullpath,$mailbox,$id);
while (($dir,$file,$fullpath)=$files->()) {
$mailbox=mailbox_from_path($dir);
next unless defined $mailbox;
next if ignorable($mailbox);
$id=id_from_file($dir,$file);
next unless defined $id;
add_file($mailbox,$file,$id);
}
return;
}
{
my $child_pid : shared;
END {
kill 2,$child_pid if $child_pid;
}
sub watch_directory {
$child_pid=
open my $inotify,'-|',
qw(inotifywait -q -m -r
--exclude (^|/)(dovecot|tmp/).*
-c
-e move -e delete -e create),
"$ENV{HOME}/.maildir"
or die "Can't start inotifywait: $!";
while (my $line=<$inotify>) {
chomp($line);
my ($dir,$event,$file)=
($line =~ m{^ ( (?:".*?") | [^,]* ) ,
( (?:".*?") | [^,]* ) ,
( (?:".*?") | [^,]* ) $ }smx );
s{(?:\A")|(?:"\z)}{}g for $dir,$event,$file;
my $mailbox=mailbox_from_path($dir);
next unless defined $mailbox;
next if ignorable($mailbox);
if ($event =~ /CREATE|MOVED_TO/) {
my $id=id_from_file($dir,$file);
if (defined $id) {
add_file($mailbox,$file,$id);
}
}
elsif ($event =~ /DELETE|MOVED_FROM/) {
del_file($mailbox,$file);
}
}
}
}
sub server {
my $serv_sock=IO::Socket::INET->new(
Listen=>10,
LocalAddr=>'127.0.0.1',
LocalPort=>9000,
Proto=>'tcp',
ReuseAddr=>1,
);
while (my $other_sock=$serv_sock->accept) {
threads->create(\&handle_client,$other_sock)->detach;
}
}
sub handle_client {
my ($client)=@_;
my $header;
while (my $line=<$client>) {
$line=~s{[\x0d\x0a]+\z}{\x0d\x0a};
$header.=$line;
last if $line eq "\x0d\x0a";
}
my $header_obj=Email::Simple->new(\$header)->header_obj;
my @refs=(split_refs($header_obj->header('In-Reply-To')),
reverse(split_refs($header_obj->header('References'))));
my @mailboxes;
for my $id (@refs) {
@mailboxes=get_mailboxes($id);
if (@mailboxes) {
print {$client} "$mailboxes[-1]\x0d\x0a"
if $client->connected;
return;
}
}
return;
}
threads->create(\&watch_directory)->detach;
threads->create(\&scan_directory)->detach;
server();