# HG changeset patch
# User Heiko Schlittermann (CTQ.kx.schlittermann.de) <hs@schlittermann.de>
# Date 1304420607 -7200
# Node ID aa87981ccf8c33d9b8aedf059ad4c4bd6647e711
# Parent  f6a277e9bda83fec1d0191a939a2a9690683286c
use Log::Log4perl

diff -r f6a277e9bda8 -r aa87981ccf8c Build.PL
--- 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/*")],
diff -r f6a277e9bda8 -r aa87981ccf8c bin/ftbackup
--- 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>;
 }