Script de recherche maillog

Dans certain cas, effectuer une recherche de mail bien précise dans des archives maillog très volumineuse s’avère trop complexe, bien souvent la machine exploitée ou le client email pour cette recherche n'est pas assez performant pour supporter la charge.

Voici une base de script perl à exécuter directement pour copier les emails trouvé directement. Ce script réclame plusieurs heures à l'execution mais peu tourner tranquillement sans être interrompu.

maillog_search.pl

#!/usr/bin/perl -w
 
use strict;
use warnings;
use File::Find;
use Email::Simple;
use Email::Address;
use Data::Dumper;
use File::Copy;
 
my $dir  = '/home/e-smith/files/users/mail/Maildir';
my @from = qw(<KEYWORD>);
my @to   = qw(<KEYWORD>);
my $res  = '/home/e-smith/files/users/mail/Maildir/';
my @domains = qw(
<KEYWORD>
);
my $cnt_total = 0;
my $cnt_matched = 0;
find(\&search, ($dir));
 
sub search {
  my $file = $_;
  print "$cnt_total\n" if $cnt_total =~ m/00$/;
  return unless -f $file;
  return if $file =~ m/^dovecot/ || $file eq 'subscription' || $file eq 'maildirfolder';
  $cnt_total++;
  my $content;
  open F, $file;
  $content .= $_ while(<F>);
  close F;
#  print "Checking $file\n";
  my $email = Email::Simple->new($content);
  my ($from_header) = Email::Address->parse($email->header("From"));
  return unless $from_header;
  my @to_header = Email::Address->parse($email->header("To"));
  my @cc_header = Email::Address->parse($email->header("Cc"));
  if (grep { $_ eq $from_header->user } @from){
    if (grep { $_ eq $from_header->host } @domains){
      $cnt_matched++;
      copy $file, $res . '.from/cur';
      print $file . " matched (from)\n";
    }
  }
  foreach my $addr (@to_header){
    if (grep { $_ eq $addr->user } @to){
      if (grep { $addr->host eq $_ } @domains){
        $cnt_matched++;
        copy $file, $res . '.to/cur';
        print $file . " matched (to)\n";
      }
    }
  }
  foreach my $addr (@cc_header){
    if (grep { $_ eq $addr->user } @to){
      if (grep { $addr->host eq $_ } @domains){
        $cnt_matched++;
        copy $file, $res . '.cc/cur';
        print $file . " matched (cc)\n"; 
      }
    }
  }
}
 
print "Found $cnt_matched file (out of $cnt_total)\n";