From 4d35d00f7766272c3d8da1532003fc9caa160717 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 16 Apr 2009 20:42:26 +0200 Subject: first version --- maildir-indexer.pl | 388 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 388 insertions(+) create mode 100644 maildir-indexer.pl (limited to 'maildir-indexer.pl') diff --git a/maildir-indexer.pl b/maildir-indexer.pl new file mode 100644 index 0000000..1a7a4fc --- /dev/null +++ b/maildir-indexer.pl @@ -0,0 +1,388 @@ +#!/usr/bin/perl +use strict; +use warnings; +use threads; +use threads::shared; +use IO::Socket::INET; +use File::Next; +use Email::Simple; + +=head1 NAME + +maildir-indexer.pl + +=head1 AUTHOR + +Gianni Ceccarelli + +=head1 COPYRIGHT & LICENSE + +Copyright 2009 Gianni Ceccarelli + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +For a copy of the GNU General Public License, see +L. + +=cut + +{ + +=head1 Index handling + +C<%files2id> maps a mailbox-file pair to a message id +(C<$files2id{$mailbox}->{$file}=$id>). + +C<%id2mailbox> maps a message id to a list of mailboxes. + +These hashes are private to the index handling section: the following +function must be used to manipulate the index. + +=cut + +my %files2id : shared; +my %id2mailbox : shared; + +=head2 C + + add_file($mailbox,$file,$id); + +Adds an entry to the index. Takes care of locking, and of sharing +newly-created hashes and arrays. + +=cut + +sub add_file { + my ($mailbox,$file,$id)=@_; + lock(%files2id); + + # Auto-vivified references are not shared, we must share them explicitly. + # See threads::shared for an explanation of the '&share' call style. + + $files2id{$mailbox}||=&share({}); + $files2id{$mailbox}->{$file}=$id; + + $id2mailbox{$id}||=&share([]); + push @{$id2mailbox{$id}},$mailbox; + + return; +} + +=head2 C + + del_file($mailbox,$file); + +Removes an entry from the index. Takes care of locking, and of +removing empty hashes and arrays. + +=cut + +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}; + # remove the mailbox, keeping the order + @{$id2mailbox{$id}}=grep {$_ ne $mailbox} @{$id2mailbox{$id}}; + delete $id2mailbox{$id} unless @{$id2mailbox{$id}}; + + return; +} + +=head2 C + + @mailboxes = get_mailboxes($id); + +Returns all the mailboxes that contain a message with the given +message id, in roughly chronological order. Can return an empty list. + +=cut + +sub get_mailboxes { + my ($id)=@_; + lock(%files2id); + + return unless exists $id2mailbox{$id}; + return @{$id2mailbox{$id}}; +} + +} + +=head1 Message & mailbox parsing + +=head2 C + + $id = id_from_file($dir,$file); + +Returns the message id of the C<$file> in the C<$dir>. Returns +C if the file can't be read, or it does not contain a message +id. + +=cut #' + +sub id_from_file { + my ($dir,$file)=@_; + + # we might use Email::Simple here, but it's useless to load + # and parse the entire message + + open my $fh,'<',"$dir/$file" or return; + while (my $line=<$fh>) { + $line=~s{[\x0d\x0a]+\z}{}; + return unless length($line); # end of headers, no messageid found + $line =~ m{^Message-ID: \s* <(\S+?)>}xi and return $1; + } + return; +} + +=head2 C + + @ids = split_refs($header_field_value); + +Extracts the message ids from the value of a header file such as +C or C. + +=cut + +sub split_refs { + my ($str)=@_; + return unless $str; + + $str=~s{^.*<}{};$str=~s{>.*$}{}; + return split />.*? + + $mailbox = mailbox_from_path($dir); + +Extracts the mailbox name from a directory name. Assumes that all +mailboxes are under a C<.maildir/> directory. Returns C if the +directory name can't be parsed. + +=cut #' + +sub mailbox_from_path { + my ($dir)=@_; + + # /home/dakkar/.maildir/.mail.Personal.Dakkar/cur + # -> + # .mail.Personal.Dakkar + $dir=~m{/.maildir/(.*?)/(?:cur|new|tmp)} and return $1; + return; +} + +=head2 C + + if (ignorable($mailbox)) { ... } + +Returns whether a mailbox can be safely ignored by the indexer. There +are two ignorable mailboxes: C<.Trash> and C<.mail.SPAM>. + +=cut + +sub ignorable { + return $_[0] =~ m{(?:^|/)(?:\.mail\.SPAM|\.Trash)(?:/|$)}; +} + +=head1 Scanning the mail archive + +=head2 C + +Using L, scans C<$ENV{HOME}/.maildir> for message files, +and adds them to the index. + +=cut + +sub scan_directory { + my $files=File::Next::files({ + file_filter => sub { + # /cur/ and /new/ are the only interesting directories in a maildir + ($File::Next::dir =~ m{/(?:cur|new)(?:/|$)}) + and + # we ignore dovecot's files + ($_ !~ m{^dovecot}); + }, + descend_filter => sub { + # ignorable mailboxes are ignored + !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; # might not be a real mailbox + next if ignorable($mailbox); # should not happen + $id=id_from_file($dir,$file); + next unless defined $id; # might not be a message, or have disappeared + add_file($mailbox,$file,$id); + } + + return; +} + +{ + +=head1 Watching the mail archive for changes + +=cut + +my $child_pid : shared; +# cleanup action +END { + kill 2,$child_pid if $child_pid; +} + +=head2 C + +Parses the output from C. For the events C and +C, adds entries to the index. For the events C and +C, removes entries from the index. + +=cut + +sub watch_directory { + # see inotifywait(1) + $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); + + # these lines are a naif parser for the CSV output of inotifywait + 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; # might not be a mailbox event + next if ignorable($mailbox); # ignore ignorable mailboxes + + if ($event =~ /CREATE|MOVED_TO/) { + # a file has appeared: get the message id + my $id=id_from_file($dir,$file); + if (defined $id) { + # it is a proper message, add it to the index + add_file($mailbox,$file,$id); + } + } + elsif ($event =~ /DELETE|MOVED_FROM/) { + # a file has disappeared: remove it from the index + del_file($mailbox,$file); + } + } +} + +} + +=head1 Serving requests + +=head2 C + +Opens a listening socket on C. Whenever a connection +is received, executes C in a separate thread. + +=cut + +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; + } +} + +=head2 C + +This funtction expects a mail message from the socket. The message is +parsesd, and possible references extracted. If the are references, and +one of them is known to the index, the mailbox name of such a +reference is printed to the socket. + +=cut + +sub handle_client { + my ($client)=@_; + + # we get a message header, followed by a blank line + 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; + # In-Reply-To is the most trustworthy + # References are listed in chronological order + # @refs ends up with the ids in decreasing order of importance + 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) { + # we know where a message is! tell the client + # (we only print the most recent mailbox) + # the client may have disconnected: printing to a + # closed socket makes the server die + print {$client} "$mailboxes[-1]\x0d\x0a" + if $client->connected; + + return; + } + } + return; +} + +=head1 Main program + +=over 4 + +=item * + +start C in a thread + +=item * + +start C in another thread + +=item * + +start C in the main thread + +=back + +=cut + +threads->create(\&watch_directory)->detach; +threads->create(\&scan_directory)->detach; +server(); -- cgit v1.2.3