Problemas con script perl
Instalé un servidor de correo siguiendo el siguiente tutorial:
http://www.howtoforge.com/virtual_postfix_mysql_quota_courier
El problema lo tengo con el script que hay en la cuarta página que
envía un mail al administrador informando de las quotas. Yo hice una
modificación para que además envíe a cada usuario su quota, con mis
conocimientos de perl fue un milagro que funcionase. Lo adjunto más
abajo [1].
En el trabajo tenemos un dominio "normal": midominio.com
Pero en casa como no puedo pagar dominios uso uno gratuito, tal que
casa.midominio.com
En el trabajo me funciona a la perfección pero en casa no, así que
supongo que será cosa de como obtiene los datos de las cuentas al ser
un dominio con dos puntos o vete a saber qué.
Por si no quedó claro de perl tengo la misma idea que de la
reproducción del abejarruco en cautiverio, bueno miento, menos.
El caso es que debiera llegar un mail al administrador con todas las
quotas y otro a cada usuario con su quota. En vez de eso me llega solo
un mail al "admin" pero sin las quotas y nada del mail a cada usuario:
INFORME DIARIO DE ESPACIO OCUPADO EN CUENTA DE CORREO:
----------------------------------------------
| % USO | NOMBRE DE CUENTA |
----------------------------------------------
--
Resete-e
Mientras que debiera llegar algo como esto a admin:
INFORME DIARIO DE ESPACIO OCUPADO EN CUENTA DE CORREO:
----------------------------------------------
| % USO | NOMBRE DE CUENTA |
----------------------------------------------
| 21 | aaaa@midominio.com |
---------------------------------------------
| 11 | bbb@midominio.com |
---------------------------------------------
| 7 | cccc@midominio.com |
---------------------------------------------
| 4 | dddd@midominio.com |
---------------------------------------------
| 1 | eeee@midominio.com |
---------------------------------------------
--
El administrador
Y a cada usuario:
INFORME DIARIO DE ESPACIO OCUPADO EN CUENTA DE CORREO:
----------------------------------------------
| % USO | NOMBRE DE CUENTA |
----------------------------------------------
| 21 | aaaa@midominio.com |
---------------------------------------------
--
El administrador
[1]El script al completo, perdonad si es mucho código, no se si es
mejor pegarlo aquí o poner un enlace al archivo:
#!/usr/bin/perl -w
# Author <jps@tntmax.com>
#
# This script assumes that virtual_mailbox_base in defined
# in postfix's main.cf file. This directory is assumed to contain
# directories which themselves contain your virtual user's maildirs.
# For example:
#
# -----------/
# |
# |
# home/vmail/domains/
# | |
# | |
# example.com/ foo.com/
# |
# |
# -----------------
# | | |
# | | |
# user1/ user2/ user3/
# |
# |
# maildirsize
#
use strict;
my $POSTFIX_CF = "/etc/postfix/main.cf";
my $MAILPROG = "/usr/sbin/sendmail -t";
my $WARNPERCENT = 80;
my @POSTMASTERS = ('admin@casa.dominio.com');
my $CONAME = 'Resete-e';
my $COADDR = 'admin@casa.dominio.com';
my $SUADDR = 'admin@casa.dominio.com';
my $MAIL_REPORT = 1;
my $MAIL_REPORT_USERS = 1;
my $MAIL_WARNING = 1;
#get virtual mailbox base from postfix config
open(PCF, "< $POSTFIX_CF") or die $!;
my $mboxBase;
while (<PCF>) {
next unless /virtual_mailbox_base\s*=\s*(.*)\s*/;
$mboxBase = $1;
}
close(PCF);
#assume one level of subdirectories for domain names
my @domains;
opendir(DIR, $mboxBase) or die $!;
while (defined(my $name = readdir(DIR))) {
next if $name =~ /^\.\.?$/; #skip '.' and '..'
next unless (-d "$mboxBase/$name");
push(@domains, $name);
}
closedir(DIR);
#iterate through domains for username/maildirsize files
my @users;
chdir($mboxBase);
foreach my $domain (@domains) {
opendir(DIR, $domain) or die $!;
while (defined(my $name = readdir(DIR))) {
next if $name =~ /^\.\.?$/; #skip '.' and '..'
next unless (-d "$domain/$name");
push(@users, {"$name\@$domain" => "$mboxBase/$domain/$name"});
}
}
closedir(DIR);
#get user quotas and percent used
my (%lusers, $report);
foreach my $href (@users) {
foreach my $user (keys %$href) {
my $quotafile = "$href->{$user}/maildirsize";
next unless (-f $quotafile);
open(QF, "< $quotafile") or die $!;
my ($firstln, $quota, $used);
while (<QF>) {
my $line = $_;
if (! $firstln) {
$firstln = 1;
die "Error: corrupt quotafile $quotafile"
unless ($line =~ /^(\d+)S/);
$quota = $1;
last if (! $quota);
next;
}
die "Error: corrupt quotafile $quotafile"
unless ($line =~ /\s*(-?\d+)/);
$used += $1;
}
close(QF);
next if (! $used);
my $percent = int($used / $quota * 100);
$lusers{$user} = $percent unless not $percent;
}
}
#send a report to the postmasters
if ($MAIL_REPORT) {
open(MAIL, "| $MAILPROG");
select(MAIL);
map {print "To: $_\n"} @POSTMASTERS;
print "From: $COADDR\n";
print "Subject: Daily Quota Report.\n";
#print "DAILY QUOTA REPORT:\n\n";
print "INFORME DIARIO DE ESPACIO OCUPADO EN CUENTA DE CORREO:\n\n";
print "----------------------------------------------\n";
#print "| % USAGE | ACCOUNT NAME |\n";
print "| % USO | NOMBRE DE CUENTA |\n";
print "----------------------------------------------\n";
foreach my $luser ( sort { $lusers{$b} <=> $lusers{$a} } keys %lusers )
{ printf("| %3d | %32s |\n", $lusers{$luser}, $luser);
print "---------------------------------------------\n";
}
print "\n--\n";
print "$CONAME\n";
close(MAIL);
}
#send a report to the users
foreach my $luser ( sort { $lusers{$b} <=> $lusers{$a} } keys %lusers ) {
if ($MAIL_REPORT_USERS) {
open(MAIL, "| $MAILPROG");
select(MAIL);
my @TO_USER = ($luser);
map {print "To: $_\n"} @TO_USER;
print "From: $COADDR\n";
print "Subject: Daily Quota Report.\n";
#print "DAILY QUOTA REPORT:\n\n";
print "INFORME DIARIO DE ESPACIO OCUPADO EN CUENTA DE CORREO:\n\n";
print "----------------------------------------------\n";
#print "| % USAGE | ACCOUNT NAME |\n";
print "| % USO | NOMBRE DE CUENTA |\n";
print "----------------------------------------------\n";
printf("| %3d | %32s |\n", $lusers{$luser}, $luser);
print "---------------------------------------------\n";
print "\n--\n";
print "$CONAME\n";
close(MAIL);
}
}
#email a warning to people over quota
if ($MAIL_WARNING) {
foreach my $luser (keys (%lusers)) {
next unless $lusers{$luser} >= $WARNPERCENT; # skip
those under quota
open(MAIL, "| $MAILPROG");
select(MAIL);
print "To: $luser\n";
map {print "BCC: $_\n"} @POSTMASTERS;
print "From: $SUADDR\n";
print "Subject: WARNING: Your mailbox is $lusers{$luser}
full.\n"; print "Reply-to: $SUADDR\n";
print "Your mailbox: $luser is $lusers{$luser} full.\n\n";
print "Once your e-mail box has exceeded your monthly
storage quota\n";
print "your monthly billing will be automatically adjusted.\n";
print "Please consider deleting e-mail and emptying your trash
folder to clear some space.\n\n";
print "Contact <$SUADDR> for further assistance.\n\n";
print "Thank You.\n\n";
print "--\n";
print "$CONAME\n";
close(MAIL);
}
}
Reply to: