Description: |
This is something I run from Win2k's Scheduled Tasks every night, on a server running MDaemon from Alt-N. Everything in- or out-bound from our domain gets copied to a specific account we use strictly for archival. This grabs everything from his user directory that was Last Modified yesterday; moves it to that day's directory on our SnapServer; makes a plain-text index of filename, To, From, and Subject; and then zips up all the mail.
I'd love to see some feedback, because this is my first large-scale utility script. |
#!perl
# Sorts archived mail (by last-modified date) into one directory per d
+ate in yyyymmdd format
# This depends on Date::EzDate 1.06 pre-release - fails on DST off-by-
+one error in 1.0.4
# Date::EzDate 1.06 has a bug OFF of DST - so for non-DST we need 1.04
# Date::EzDate 0.93 doesn't support ->('yesterday') as an initializer
# Third major revision - it only sorts yeterday's mail, making the
+ archive directory if it doesn't exist.
# - it makes an index with Filename, From, To,
+and Subject
# - it will later move the MDaemon log files to
+ the archive directory
# - it zips the mailfiles together, and deletes
+ the uncompressed ones
use strict;
use warnings;
use diagnostics;
use File::Copy;
use Date::EzDate;
use Mail::Header;
use Mail::Address;
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
my $logfile = "//<log directory>/sortmail-error.log";
my $errfile = "//<log directory>/sortmail-stdout.log";
my $indexfile = "index.log";
my $start_dir = "<drive-letter>:/mdaemon/users/*/";
my $target_base_dir = "//<snapsrvr>/archives/mail_archive/";
my $target_date = Date::EzDate->new('yesterday');
my $end_dir = "$target_base_dir$target_date->{'%Y%m%d'}";
my $mail_file = undef;
my @mail_files = undef;
my $mail_date = undef;
my $success = undef;
my ($header, @from, @to,@RCPT_TO, $address, $subject) = undef;
my ($zip, $zip_file, $zip_error, $add_error) = undef;
open(STDERR,">>$logfile") or die ("Couldn't open logfile : quitting! E
+rror: $! \n");
open(STDOUT,">>$errfile") or die ("Couldn't open errfile : quitting! E
+rror: $! \n");
my $time = localtime();
print("\nStarted $time\n");
warn("\nStarted $time\n");
#The directory probably doesn't exist - this makes it.
if (! ( -e $end_dir) ) {
mkdir($end_dir) || die ("Couldn't make directory $end_dir : quitti
+ng! Error: $! \n");
print("Created directory $end_dir\n");
}
opendir(MAILARCHIVE, "$start_dir") || die ("Couldn't open directory $s
+tart_dir : quitting! Error: $! \n");
chdir ($start_dir);
open(INDEX, ">$end_dir/$indexfile");
$zip = Archive::Zip->new();
$zip_file = "$end_dir/".$target_date->{'%Y%m%d'}.".zip";
while ($mail_file = readdir(MAILARCHIVE) ) {
# MDaemon stores all email as *.msg files - simple RFC 822 plain t
+ext
if ($mail_file !~ /msg/i) {
warn ("Skipped $mail_file - wrong file extension.\n");
next;
}
$mail_date = Date::EzDate->new((stat("$mail_file"))[9]);
if ($target_date->{'epochday'} == $mail_date->{'epochday'} ) {
$success = File::Copy::move ("$mail_file", "$end_dir/$mail_fil
+e");
if (!$success) {
warn("File: $mail_file, end_dir: $end_dir, error: $!\n");
next;}
print("name: $mail_file, end_dir: $end_dir \n");
push (@mail_files, $mail_file);
#need to do some Mail::Tools madness here - I want to build an
+ index for fast retrieval
open(MESSAGE, "$end_dir/$mail_file") || warn ("Error opening $
+mail_file for indexing: $!\n");
$header = new Mail::Header\*MESSAGE;
$header->unfold();
close(MESSAGE);
@from = Mail::Address->parse($header->get("From:"));
@to = Mail::Address->parse($header->get("To:"));
@RCPT_TO= Mail::Address->parse($header->get("X-MDRCPT-To:"));
$subject = $header->get("Subject:") || "Perl script says: No S
+ubject in message";
chomp ($subject);
print INDEX "\n$mail_file\nSubject\t$subject\n";
foreach $address(@from ) {print INDEX "From\t".$address
+->format."\n";}
foreach $address(@to ) {print INDEX "To \t".$address
+->format."\n";}
foreach $address(@RCPT_TO ) {print INDEX "X-MDRCPT-To \t"
+.$address->format."\n";}
unless ($zip->addFile("$end_dir/$mail_file") ) {
$add_error = 1;
warn ("Error adding $mail_file to $zip_file \n");
next;
}
}
}
close(INDEX);
if ($zip_error = $zip->writeToFileNamed($zip_file) ) {
warn ("Error zipping $zip_file was $zip_error\n");
$time = localtime();
print("Ended $time\n");
warn("Ended $time\n");
die;
}
unless ($add_error) {
unless ( chdir ("$end_dir/") ) {
warn "can't chdir";
$time = localtime();
print("Ended $time\n");
warn("Ended $time\n");
die;
}
foreach my $file (@mail_files) {
if ($file) { unlink $file || warn ("Error :$! trying to delete
+ file $file !\n");}
}
}
$time = localtime();
print("Ended $time\n");
warn("Ended $time\n");
exit 0;
|