Doppelte Mails per Mail::IMAPClient auf einem Exchange-Server finden

Irgendwie habe ich mich mal wieder zu dämlich angestellt als ich die Mails von einem Ordner in den anderen verschieben wollte. Die Mails habe ich nämlich einmal kopiert und einmal verschoben und schon hatte ich das Malheur, die Mails waren doppelt vorhanden.

Das alles wäre nicht weiter schlimm gewesen, wenn es sich nur um ein paar wenige gehandelt hätte, aber bei ca. 1700 hört der Spaß einfach auf. Alles klar, also mal eben ein Perlskript geschrieben, dass per IMAP auf den Exchangeserver zugreift und die Arbeit erledigt.

In Using IMAP::Client with Cyrus IMAP server habe ich ja schon mit dem Perlmodul IMAP::Client gearbeitet und wollte das direkt wieder verwenden. Leider war es mir damit nicht möglich auf den Exchangeserver zuzugreifen, so dass ich auf Mail::IMAPClient umgestiegen bin, womit es dann direkt problemlos funktioniert hat.

Die Idee ist recht simple, ich suche für meine Inbox einfach alle Message-ID Header raus, welche auf jeden Fall eindeutig sein müssen. Wenn ich diese also doppelt finde, weiß ich direkt Bescheid und kann dann die entsprechenden Mails aussortieren.

#!/usr/bin/perl

use strict;
use warnings;

use Mail::IMAPClient;
use Data::Dumper;
use Log::Log4perl qw(:easy);
use Sysadm::Install qw(:all);
use Digest::MD5 qw(md5_base64);

my $server = "servername";
my $inbox  = "INBOX";
my $user   = "username";
my $PASSWD;
my $duplicate_items = "targetfolder";
my %msgids = ();

$PASSWD = password_read("password: ");

my $imap = Mail::IMAPClient->new(
                                  User     => $user,
                                  Password => $PASSWD,
                                  Server   => $server,
                                  UID      => 1,
                                  Peek     => 1
) or die "Incorrect Password";

#Operate on $inbox
$imap->select($inbox);
 
#Retrieve list of messages
my @messages = $imap->messages();

#loop through messages
foreach my $msg (@messages) {

    #get the Message-Id.
    my $messageId = $imap->get_header($msg, "Message-Id");
    
    # store the information for later usage
    push @{$msgids{$messageId}->{msg}}, $msg;
    $msgids{$messageId}->{count}++;
}

print "Finished collecting data...\n";

foreach my $id (keys %msgids) {
    next if $msgids{$id}->{count} < 2;

    # keep the first message
    my $firstid = shift @{$msgids{$id}->{msg}};
    
    my $first_msgtxt = $imap->message_string($firstid);
    my $first_msg_digest = md5_base64($first_msgtxt);
    
    foreach my $msg (@{$msgids{$id}->{msg}}) {
        my $msgtxt = $imap->message_string($firstid);
        my $msg_digest = md5_base64($msgtxt);

        if ($msg_digest eq $first_msg_digest) {
            my $yes = $imap->move($duplicate_items,$msg);
            warn "Unable to move message $msg" unless $yes;
        }
    }
}

#Close IMAP session
$imap->close;

Der ursprüngliche Plan war die Mails direkt in “Gelöschte Objekte” zu verschieben, aber ich konnte auf diesen Ordner nicht zugreifen, ist wohl ein Encoding-Problem (bin für Hinweise jedweder Art dankbar). Daher habe ich einfach einen neuen Ordner erstellt und die Mails dorthin geschoben.

Weil ich ein wenig feige bin und Angst hatte Mails zu verlieren habe ich einfach noch mal die MD5-Summen über den Inhalt der Nachricht gebildet und diese mit den Duplikaten verglichen. Im Falle der Übereinstimmung verschob ich die doppelten Mails in den Zielordner.

Eigentlich wollte ich noch ein vernünftiges Logging einbauen, aber das kommt dann vielleicht in der nächsten Ausbaustufe, ich denke nämlich schon über das automatische Aufräumen meines völlig überfüllten Posteingangs nach. Das ginge zwar auch anders, aber so macht es einfach mehr Spaß ;)