--- a/Build.PL Tue May 03 11:50:06 2011 +0200
+++ b/Build.PL Tue May 03 13:03:27 2011 +0200
@@ -7,8 +7,9 @@
dist_version_from => "bin/ftbackup",
requires => {
perl => "5.10.0",
- "Net::FTP" => 0,
- "Date::Parse" => 0,
+ "Net::FTP" => "2.77",
+ "Date::Parse" => "2.27",
+ "Log::Log4perl" => "1.16",
},
script_files => [glob("bin/*")],
--- a/bin/ftbackup Tue May 03 11:50:06 2011 +0200
+++ b/bin/ftbackup Tue May 03 13:03:27 2011 +0200
@@ -15,17 +15,26 @@
use English qw(-no_match_vars);
use if $ENV{DEBUG} => qw(Smart::Comments);
use File::Temp;
+use Log::Log4perl qw(:easy);
$ENV{LC_ALL} = "C";
my $ME = basename $0;
my $VERSION = "0.9";
+my $LOG_LEVEL = $ALL;
my @CONFIGS = ("/etc/$ME.conf", "$ENV{HOME}/.$ME.conf", "$ME.conf");
+Log::Log4perl->easy_init({
+ level => $ALL,
+ file => -t STDERR ? "STDERR" : ">/var/log/ftbackup/log",
+ layout => "%-6p{1} - %d (%5r) | %m%n"
+ });
+
my $HOSTNAME = hostname;
my $NOW = time();
+
my $opt_level = undef;
my $opt_today = strftime("%F", localtime $NOW);
my @opt_debug = ();
@@ -53,7 +62,8 @@
our @AT_EXIT;
END { $_->() foreach @AT_EXIT }
-$SIG{INT} = sub { warn "Got signal INT\n"; exit 1 };
+$SIG{INT} = sub { INFO "Got signal INT\n"; exit 1 };
+$SIG{__DIE__} = sub { LOGDIE @_ };
my %CONFIG = (
FTP_DIR => "backup/<LABEL>/<HOSTNAME>",
@@ -63,14 +73,11 @@
KEEP => 2,
);
-END {
- say STDERR "*** $ME STOP: " . localtime if not -t STDERR;
-}
+ALWAYS "START";
+END { ALWAYS "STOP" }
MAIN: {
- say STDERR "*** $ME START: " . localtime if not -t STDERR;
-
Getopt::Long::Configure("bundling");
GetOptions(
"l|level=i" => \$opt_level,
@@ -113,7 +120,7 @@
if system("command -v lvm >/dev/null");
push @errors, "Command `fsck' not found. ($ENV{PATH})"
if system("command -v fsck >/dev/null");
- die "$ME: pre-flight check failed:\n\t", join("\n\t" => @errors), "\n"
+ LOGDIE "$ME: pre-flight check failed:\n\t", join("\n\t" => @errors), "\n"
if @errors;
my $ftp;
@@ -165,8 +172,8 @@
$cf{FTP_HOST},
Passive => $cf{FTP_PASSIVE},
Debug => "ftp" ~~ \@opt_debug,
- ) or die $@;
- $ftp->login or die $ftp->message;
+ ) or LOGDIE $@;
+ $ftp->login or LOGDIE $ftp->message;
$ftp->home($ftp->try(pwd => ()));
$ftp->try(binary => ());
$ftp->try(mkpath => $cf{FTP_DIR});
@@ -203,11 +210,11 @@
if ($dev->{level} > 0) {
if (!@last) {
$dev->{level} = 0;
- warn "adjusted backup level to 0, last full backup missing\n";
+ WARN "adjusted backup level to 0, last full backup missing\n";
}
elsif (($NOW - $last[0]) > ($cf{FULL_CYCLE} * 86_400)) {
$dev->{level} = 0;
- warn sprintf
+ WARN sprintf
"adjusted backup level to 0, last full backup is %.1f days old\n",
($NOW - $last[0]) / 86_400;
}
@@ -230,7 +237,7 @@
verbose "Creating snapshot $snap\n";
system($_ =
"lvcreate -s -L 1G -n $snap $dev->{lvm}{path} >/dev/null");
- die "failed system command: $_\n" if $?;
+ LOGDIE "failed system command: $_\n" if $?;
$dev->{cleanup} = sub {
system "lvdisplay $snap &>/dev/null"
@@ -245,7 +252,7 @@
system($_ =
"fsck -f @{[$opt_verbose ? '-C0' : '']} -y $device");
last if not $?;
- warn "fsck on $device (using: $_) failed"
+ INFO "fsck on $device (using: $_) failed"
. ($retries > 1 ? ", retrying…\n" : "") . "\n";
}
@@ -314,7 +321,7 @@
}
else {
print while <$dump>;
- warn "STOPPED after the first dump\n";
+ WARN "STOPPED after the first dump to STDOUT\n";
exit;
}
$dev->{cleanup}->() if $dev->{cleanup};
@@ -349,7 +356,7 @@
# executable exclude list
# <inum><space><filename><NULL>
local $/ = "\0";
- open(my $ex, "-|", "$excludelist") or die "Can't open $excludelist: $!\n";
+ open(my $ex, "-|", "$excludelist") or LOGDIE "Can't open $excludelist: $!\n";
while (<$ex>) {
chomp;
my ($i, $f) = split " ", $_;
@@ -358,7 +365,7 @@
}
}
else {
- open(my $ex, "<", $excludelist) or die "Can't open $excludelist: $!\n";
+ open(my $ex, "<", $excludelist) or LOGDIE "Can't open $excludelist: $!\n";
while (<$ex>) { chomp; @files{(glob)} = () }
@inodes{ map { (stat)[1] } keys %files} = ();
@@ -427,17 +434,17 @@
{
my $p = (stat)[2] & 07777;
my $u = (stat _)[4];
- die
+ LOGDIE
"$ME: $_ has wrong permissions: found @{[sprintf '%04o', $p]}, need 0600\n"
if $p != 0600;
- die
+ LOGDIE
"$ME: owner of $_ ($u) is not the EUID ($EUID) of this process\n"
if (stat _)[4] != $EUID;
# FIXME: should check the containing directories too!
};
- open(my $f, $_) or die "Can't open $_: $!\n";
+ open(my $f, $_) or LOGDIE "Can't open $_: $!\n";
my %h = map { split /\s*=\s*/, $_, 2 } grep { !/^\s*#/ and /=/ } <$f>;
map { chomp } values %h;
%r = (%r, %h);
@@ -456,11 +463,13 @@
use strict;
use warnings;
use base qw(Net::FTP);
+ use Log::Log4perl qw(:easy);
my %data;
sub new {
my $class = shift;
+ WARN("ABER HALLO");
return bless Net::FTP->new(@_) => $class;
}
@@ -468,7 +477,7 @@
my $self = shift;
my $func = shift;
$self->$func(@_)
- or die "FTP $func failed: " . $self->message . "\n";
+ or LOGDIE "FTP $func failed: " . $self->message . "\n";
}
sub mkpath {
@@ -499,7 +508,7 @@
sub update_devnames($$$) {
my ($file, $from, $to) = @_;
- open(my $f, "+>>" => $file) or die "Can't open $file: $!\n";
+ open(my $f, "+>>" => $file) or LOGDIE "Can't open $file: $!\n";
seek($f, 0, 0);
my $_ = join "", <$f>;
s/^$from\s/$to /mg;
@@ -536,7 +545,7 @@
seek($dd, 0, 0);
while (<$dd>) {
my ($dev, $level, $date) = /^(\S+)\s+(\d+)\s+(.{30})/
- or die "Can't parse $opt_dumpdates: `$_'\n";
+ or LOGDIE "Can't parse $opt_dumpdates: `$_'\n";
my $rdev = real_device($dev);
my $devno = devno($rdev);
@@ -579,9 +588,9 @@
sub get_estimate($$) {
my ($dev, $level) = @_;
- print STDERR "% estimating $dev->{rdev} at level $level: ";
+ INFO "estimating $dev->{rdev} at level $level";
chomp(my $_ = `dump -S -$level -E $dev->{exclude}{inodes} $dev->{rdev}`);
- print STDERR human_number($_) . "Byte\n";
+ INFO "level $level will use ~ " . human_number($_) . "B";
return $_;
}
@@ -610,7 +619,7 @@
}
}
}
- warn "% $dev->{dev} will use level $dev->{level}\n";
+ INFO "$dev->{dev} will use level $dev->{level}\n";
}
return @devs;
@@ -618,7 +627,7 @@
sub slurp($) {
my $f = shift;
- open(my $fh, "<", $f) or die "Can't open $f: $!\n";
+ open(my $fh, "<", $f) or LOGDIE "Can't open $f: $!\n";
return <$fh>;
}