PostfixAdmin — авто архивация почты выключенных учеток

Исходные данные:
PostfixAdmin управляет почтовыми учетками в базе mysql «maildb»
mysql user: mailuser
mysql password: mailpassword
Почтовые ящики хранятся в /var/spool/mail/my.domain.ua

root@ns:/root # ls -l /var/spool/mail/my.domain.ua/
total 24
drwxr-xr-x  5 virtual  virtual  512 Aug  1 18:26 admin.email@my.domain.ua
drwxr-xr-x  3 virtual  virtual  512 Sep 27 14:46 alexandr.pisnov@my.domain.ua
drwxr-xr-x  2 virtual  virtual  512 Sep 27 14:46 anastasia.gaeva@my.domain.ua
drwxr-xr-x  2 virtual  virtual  512 Sep 27 14:47 andrey.diervin@my.domain.ua
drwxr-xr-x  2 virtual  virtual  512 Sep 27 14:47 anton.balaba@my.domain.ua
drwxr-xr-x  2 virtual  virtual  512 Sep 27 14:47 bogdan.kruk@my.domain.ua
drwxr-xr-x  2 virtual  virtual  512 Sep 27 14:47 dmitriy.perevozov@my.domain.ua
.........
root@ns:/root #

Задача, после того как пользователь выключен через админку PA — ждем 30 дней (вдруг кому понадобится?) и архивируем ящик пользователя в директорию /home/black/archives, сам ящик удаляется. О том какие ящики были заархивированы/удалены сообщать админу на email admin.email@my.domain.ua

Для решения такой задачки написал скриптик и запускаю его каждую ночь по крону.

#!/usr/bin/perl -w

use strict;
use warnings;
use DBI();
use DBD::mysql;
use Date::Calc qw(Delta_Days);
use File::Path;

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my @abbr = qw(01 02 03 04 05 06 07 08 09 10 11 12);
$year += 1900;
my $now_date = "$year $abbr[$mon] $mday";

my $archive_dir = "/home/black/archives";
opendir my($dh), $archive_dir or die "Couldn't open dir '$archive_dir': $!";
my @files = readdir $dh;
closedir $dh;

my $logfile = "/tmp/mail_archiver.log";
open (LOGFILE, ">$logfile");
print LOGFILE "Accounts that you want to archive:\n";

my $dbh = DBI->connect("DBI:mysql:database=maildb;host=localhost", "mailuser", "mailpassword", {'RaiseError' => 1});

  my $sth = $dbh->prepare("SELECT username,modified FROM mailbox WHERE active=0 and username like '%my.domain%'") or die "Can't prepare statement: $DBI::errstr";
  $sth->execute() or die "Can't execute statement: $DBI::errstr";;
  while (my @row = $sth->fetchrow_array ) {
    my $date_disable = $row[1];
    my $mailbox = $row[0];
    $date_disable =~ s%\ .*$%%g;
    $date_disable =~ s%-%\ %g;
    my @date_modify = split( ' ', $date_disable );
        my $dd = Delta_Days($date_modify[0],$date_modify[1],$date_modify[2],$year,$abbr[$mon],$mday);
        if (grep(/$mailbox/i, @files)) {
          print "Archive already exist ...\n";
        } else {
          if ( $dd > 30) {
          print LOGFILE "\[$mailbox\] disabled $dd days ago - doing archive ... \t";
                if ($mailbox =~ /\@/ ) {
print "$mailbox contain \@\n";
                        if ( -d "/var/spool/mail/my.domain.ua/$mailbox" ) {
                          system("cd /var/spool/mail/my.domain.ua && tar cjf $archive_dir/$mailbox-$year-$abbr[$mon]-$mday.tbz $mailbox");
                          if ($? == 0) {
                          #print "Ready for delete directory /var/spool/mail/my.domain.ua/$mailbox\n";
                          rmtree( "/var/spool/mail/my.domain.ua/$mailbox" ) or die "Can't delete directory: $mailbox \n";
                          print LOGFILE "OK\n";
                          } else {
                            die "ERROR: running archivating failed!: $! $?\n";
                          }
                          } else {
                            print "Can not find mail directory!\n";
                          }
                        } else {
                          print "$mailbox not look like as Email address! Nothing to do ...\n";
                        }
          }
        }
  }
$dbh->disconnect();
close (LOGFILE);

system("grep @ /tmp/mail_archiver.log && mutt -s \"Mail - old account archiver\" admin.email\@my.domain.ua < /tmp/mail_archiver.log");
unlink $logfile;

P.S. Поскольку я тот еще перлописатель — правки/дополнения/замечания приветствуются 🙂

Update1: Немного просветился по поводу извлечения подстроки из строки в perl, оказывается часть кода которая извлекает дату modify учетки из mysql

my $date_disable = $row[1];
    $date_disable =~ s%\ .*$%%g;
    $date_disable =~ s%-%\ %g;
    my @date_modify = split( ' ', $date_disable );

можно написать более изящно, всего одной строчкой вместо четырех!:

my ($modify_year, $modify_month, $modify_day) = unpack("x0 A4 x1 A2 x1 A2", $row[1]);

или так:

my $date_disable = $row[1];
substr($date_disable, -9) = "";
$date_disable =~ s%-%\ %g;
my @date_modify = split( ' ', $date_disable );

И следующим шагом вычислять количество прошедших дней от сегодня до дня модификации функцией Delta_Days
Но вот результаты теста говорят о том что «не все йогурты одинаково полезны»:

root@ns:/root/scripts # ./string.pl | grep test
Benchmark: timing 1000000 iterations of test1, test2, test3...
     test1:  3 wallclock secs ( 2.62 usr +  0.03 sys =  2.66 CPU) @ 376470.59/s (n=1000000)
     test2:  3 wallclock secs ( 2.57 usr +  0.05 sys =  2.62 CPU) @ 380952.38/s (n=1000000)
     test3:  3 wallclock secs ( 2.80 usr +  0.04 sys =  2.84 CPU) @ 351648.35/s (n=1000000)
root@ns:/root/scripts #

Тестировал так:

#!/usr/local/bin/perl -w

use strict;
use Benchmark;

timethese(1000000,
    {
test1 => 'my $string = "2013-09-06 09:12:45"; substr($string, -9) = ""; $string =~ s%-%\ %g; print "My new string is: $string\n";',
test2 => 'my $string = "2013-09-06 09:12:45"; my ($d, $c, $r) = unpack("x0 A4 x1 A2 x1 A2", $string); print "My new string is: $d $c $r\n";',
test3 => 'my $string = "2013-09-06 09:12:45"; $string =~ s%\ .*$%%g; $string =~ s%-%\ %g; print "My new string is: $string\n";'
}
);

Заодно и тестирование производительности кода освоил …. ура! А с оптимальным вариантом так и не определился — оставил так как есть 🙂
Enjoy!

  1. Комментов пока нет

  1. Трэкбэков пока нет.

Why ask?