-#!/bin/perl
+#!/usr/bin/perl
#============================================================= -*-perl-*-
#
# BackupPC_sendEmail: send status emails to users and admins
# Craig Barratt <cbarratt@users.sourceforge.net>
#
# COPYRIGHT
-# Copyright (C) 2001-2003 Craig Barratt
+# Copyright (C) 2001-2009 Craig Barratt
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
#
#========================================================================
#
-# Version 3.0.0, released 28 Jan 2007.
+# Version 3.2.0, released 31 Jul 2010.
#
# See http://backuppc.sourceforge.net.
#
use lib "/usr/local/BackupPC/lib";
use BackupPC::Lib;
use BackupPC::FileZIO;
+use Encode;
use Data::Dumper;
use Getopt::Std;
use DirHandle ();
-use vars qw($Lang $TopDir $BinDir $LogDir %Conf);
+use vars qw($Lang $TopDir $BinDir $LogDir %Conf $Hosts);
die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
$TopDir = $bpc->TopDir();
$BinDir = $bpc->BinDir();
%Conf = $bpc->Conf();
$Lang = $bpc->Lang();
+$Hosts = $bpc->HostInfoRead();
$bpc->ChildInit();
exit(1);
}
+#
+# Upgrade legacy version of %UserEmailInfo
+#
+# Prior to 3.2.0, it was a hash with entries:
+#
+# $UserEmailInfo{$user}{lastTime}
+# $UserEmailInfo{$user}{lastSubj}
+# $UserEmailInfo{$user}{lastHost}
+#
+# However, if a user had multiple hosts, then an email about one
+# host prevents mail delivery about other hosts. Starting in 3.2.0
+# the hash is:
+#
+# $UserEmailInfo{$user}{$host}{lastTime}
+# $UserEmailInfo{$user}{$host}{lastSubj}
+#
+my $oldFormat = 0;
+foreach my $user ( keys(%UserEmailInfo) ) {
+ if ( defined($UserEmailInfo{$user}{lastTime})
+ && ref($UserEmailInfo{$user}{lastTime}) ne 'HASH' ) {
+ $oldFormat = 1;
+ last;
+ }
+}
+if ( $oldFormat ) {
+ #
+ # Convert to the new format
+ #
+ my %UserEmailInfoOld = %UserEmailInfo;
+ %UserEmailInfo = ();
+ foreach my $user ( keys(%UserEmailInfoOld) ) {
+ next if ( $user eq "" );
+ my $host = $UserEmailInfoOld{$user}{lastHost};
+ next if ( !defined($host) );
+ $UserEmailInfo{$user}{$host}{lastTime} = $UserEmailInfoOld{$user}{lastTime};
+ $UserEmailInfo{$user}{$host}{lastSubj} = $UserEmailInfoOld{$user}{lastSubj};
+ }
+}
+
+#
+# Prune hosts that no longer exist
+#
+foreach my $user ( keys(%UserEmailInfo) ) {
+ foreach my $host ( keys(%{$UserEmailInfo{$user}}) ) {
+ next if ( defined($Hosts->{$host}) );
+ delete($UserEmailInfo{$user}{$host});
+ }
+ next if ( $UserEmailInfo{$user} );
+ delete($UserEmailInfo{$user});
+}
+
my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort});
if ( $err ) {
if ( $opts{c} && $Conf{EMailAdminUserName} ne "" ) {
###########################################################################
# Generate per-host warning messages sent to each user
###########################################################################
-my $Hosts = $bpc->HostInfoRead();
my @AdminBadHosts = ();
foreach my $host ( sort(keys(%Status)) ) {
%Conf = $bpc->Conf();
my $user = $Hosts->{$host}{user};
+ next if ( $user eq "" );
+
#
# Accumulate host errors for the admin email below
#
push(@AdminBadHosts, "$host ($Status{$host}{error})");
}
- next if ( time - $UserEmailInfo{$user}{lastTime}
+ next if ( time - $UserEmailInfo{$user}{$host}{lastTime}
< $Conf{EMailNotifyMinDays} * 24*3600
|| $Conf{XferMethod} eq "archive"
|| $Conf{BackupsDisable}
sub sendUserEmail
{
my($user, $host, $mesg, $subj, $vars) = @_;
+ return if ( $Conf{BackupsDisable} );
+
$vars->{user} = $user;
$vars->{host} = $host;
$vars->{headers} = $Conf{EMailHeaders};
$vars->{domain} = $Conf{EMailUserDestDomain};
$vars->{CgiURL} = $Conf{CgiURL};
$subj =~ s/\$(\w+)/defined($vars->{$1}) ? $vars->{$1} : "\$$1"/eg;
- $vars->{subj} = $subj;
+ $vars->{subj} = encode('MIME-Header', $subj);
$mesg =~ s/\$(\w+)/defined($vars->{$1}) ? $vars->{$1} : "\$$1"/eg;
SendMail($mesg);
- $UserEmailInfo{$user}{lastTime} = time;
- $UserEmailInfo{$user}{lastSubj} = $subj;
- $UserEmailInfo{$user}{lastHost} = $host;
+ $UserEmailInfo{$user}{$host}{lastTime} = time;
+ $UserEmailInfo{$user}{$host}{lastSubj} = $subj;
}
sub SendMail
if ( $opts{t} ) {
binmode(STDOUT, ":utf8") if ( $utf8 );
+
print("#" x 75, "\n");
print $mesg;
return;
printf("Can't run sendmail ($Conf{SendmailPath}): $!\n");
return;
}
- if ( $utf8 ) {
- binmode(MAIL, ":utf8");
- if ($mesg =~ /^Subject: (.*)$/m) {
- my $new_subj = encode('MIME-Header', $1);
- $mesg =~ s/^Subject: .*$/Subject: $new_subj/m;
- }
- }
+ binmode(MAIL, ":utf8") if ( $utf8 );
print MAIL $mesg;
close(MAIL);
}