From 38e90e74f640269b15da8c907a5b6b1c063a88c1 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 29 Dec 2019 11:43:52 +0000 Subject: kill p5 program --- maildir-indexer.pl | 387 ----------------------------------------------------- 1 file changed, 387 deletions(-) delete mode 100644 maildir-indexer.pl diff --git a/maildir-indexer.pl b/maildir-indexer.pl deleted file mode 100644 index e6c7693..0000000 --- a/maildir-indexer.pl +++ /dev/null @@ -1,387 +0,0 @@ -#!/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 Affero General Public License as -published by the Free Software Foundation, version 3. - -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 Affero 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