tuto:ipasserelle:divers:script_recherche_maillog [WikiT]

Cette page est en lecture seule. Vous pouvez afficher le texte source, mais ne pourrez pas le modifier. Contactez votre administrateur si vous pensez qu'il s'agit d'une erreur.
====== 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.

<note important>La version suivante présente encore un bug, certain emails ne sont pas copiés correctement et offre un fichier vide de 0 octets.</note>

<file perl 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";

</file>