# HG changeset patch
# User Heiko Schlittermann (ZARAFA.ctq.de) hs@schlittermann.de
# Date 1302790690 -7200
# Node ID 1f379e39248ae7a70325ad5fd8911abcac9b573f
# Parent  840b18b3b93f7ee3db63d67d6c7738e6987ca98e
now rely on the dumpdates file, one more nice option (--info)

diff -r 840b18b3b93f -r 1f379e39248a ftbackup
--- a/ftbackup	Tue Apr 12 14:28:58 2011 +0200
+++ b/ftbackup	Thu Apr 14 16:18:10 2011 +0200
@@ -1,8 +1,9 @@
 #! /usr/bin/perl
+
+use 5.010;
 use strict;
 use warnings;
 
-use 5.10.0;
 use File::Basename;
 use Net::FTP;
 use Perl6::Slurp;
@@ -11,6 +12,8 @@
 use Time::Local;
 use Pod::Usage;
 use POSIX qw(strftime);
+use Date::Parse qw(str2time);
+use Cwd qw(realpath);
 use English qw(-no_match_vars);
 use if $ENV{DEBUG} => qw(Smart::Comments);
 
@@ -31,13 +34,18 @@
 my $opt_dry     = 0;
 my $opt_force   = 0;
 my $opt_label   = "daily";
+my $opt_info    = 0;
 my $opt_config  = "";
 my $opt_dumpdates = "/var/lib/dumpdates";
 
 sub get_configs(@);
 sub get_candidates();
 sub verbose(@);
-sub iso2epoch($);
+sub update_devnames($$$);
+sub examine(@);
+sub decide($@);
+sub real_device($);
+sub devno($);
 
 our @AT_EXIT;
 END { $_->() foreach @AT_EXIT }
@@ -57,7 +65,8 @@
         "L|label=s" => \$opt_label,
         "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] },
         "v|verbose" => \$opt_verbose,
-        "dry"       => \$opt_dry,
+	"i|info"    => \$opt_info,
+        "dry"       => sub { $opt_dry = 1; $opt_verbose = 1 },
         "f|force"   => \$opt_force,
         "h|help"    => sub { pod2usage(-exit => 0, -verbose => 1) },
         "m|man"     => sub { pod2usage(-exit => 0, -verbose => 3) },
@@ -69,9 +78,15 @@
     my %cf = (%CONFIG, get_configs(@CONFIGS));
     $cf{FTP_DIR} =~ s/<HOSTNAME>/$HOSTNAME/g;
     $cf{FTP_DIR} =~ s/<LABEL>/$opt_label/g;
-    my @dev = get_candidates();
+
+    # get the backup candiates -> all file systems from /etc/fstab
+    # with a dump frequence > 0
+    my @devs = get_candidates();
+
     ### %cf
-    ### @dev
+    ### @devs
+
+    verbose +(map { "candidate: $_->{dev} as $_->{rdev}\n" } @devs), "\n";
 
     my @errors = ();
     push @errors, "Need FTP_HOST (see config)." if not defined $cf{FTP_HOST};
@@ -82,11 +97,11 @@
 
     my $ftp;
 
-    if (not @opt_debug ~~ /^output$/) {
+    if (not "output" ~~ \@opt_debug) {
         $ftp = new FTP(
             $cf{FTP_HOST},
             Passive => $cf{FTP_PASSIVE},
-            Debug   => @opt_debug ~~ /^ftp$/
+            Debug   => "ftp" ~~ \@opt_debug,
         ) or die $@;
         $ftp->login or die $ftp->message;
         $ftp->home($ftp->try(pwd => ()));
@@ -95,10 +110,46 @@
         $ftp->try(cwd    => $cf{FTP_DIR});
     }
 
-    ### @dev
+    # examine the situation - we rely on $opt_dumpdates
+    @devs = examine(@devs);
+    @devs = decide($cf{FULL_CYCLE}, @devs);
+
+    ### @devs
+
+    if ($opt_info) {
+	my $lr = (reverse sort { $a <=> $b } map { length $_->{rdev} } @devs)[0];
+	my $ld = (reverse sort { $a <=> $b } map { length $_->{dev} } @devs)[0];
+	my $ln = (reverse sort { $a <=> $b } map { length $_->{devno} } @devs)[0];
+
+	my %l;
+	foreach my $dev (@devs) {
+	    $l{$dev} = sprintf "%*s (%*s %*s)", -$ld => $dev->{dev},
+				       -$lr => $dev->{rdev},
+				       -$ln => $dev->{devno};
+	}
+
+	say "\nsituation\n",
+	    "---------";
+	foreach my $dev (@devs) {
+	    if (!$dev->{last}) { say "$l{$dev}: never" } 
+	    else {
+		for (my $i = 0; $i < @{$dev->{last}}; $i++) {
+		    say "$l{$dev}: $i ", defined($dev->{last}[$i]) ? scalar localtime($dev->{last}[$i]) : "-";
+		}
+	    }
+	}
+
+	say "\nplan\n", "----";
+	foreach my $dev (@devs) {
+	    say "$l{$dev}: level $dev->{level}";
+	}
+
+
+	exit;
+    }
 
     # and now we can start doing something with our filesystems
-  DEVICE: foreach my $dev (@dev) {
+  DEVICE: foreach my $dev (@devs) {
         my $dir = $dev->{mountpoint};
         $dir =~ s/_/__/g;
         $dir =~ s/\//_/g;
@@ -110,7 +161,7 @@
             $ftp->try(mkpath => $dir);
             $ftp->try(cwd    => $dir);
 
-            verbose "Now in @{[$ftp->pwd]}.\n" if $ftp;
+            #verbose "Now in @{[$ftp->pwd]}.\n" if $ftp;
 
             # examine the situation and decide about the level
             # FIXME: currently we simply run a full dump every FULL_CYCLE
@@ -122,28 +173,28 @@
             }
         }
 
-        if (not defined $opt_level) {
-            $opt_level =
-              ($NOW - iso2epoch $last[0]) / 86400 > $cf{FULL_CYCLE} ? 0 : 1;
+	# for safety we check if there is really a full dump not older than xxx days
+        if ($dev->{level} > 0) {
+	    if (!@last) {
+		$dev->{level} = 0;
+		warn "adjusted backup level to 0, last full backup missing\n";
+	    } elsif ($NOW - str2time($last[0]) > ($cf{FULL_CYCLE} * 86_400)) {
+		$dev->{level} = 0;
+		warn sprintf "adjusted backup level to 0, last full backup is %.1f days old\n",
+		    ($NOW - str2time $last[0])/86_400;
+	    }
         }
 
-        my $file = strftime("%F_%R", localtime $NOW) . ".$opt_level";
-        #my $label = "$HOSTNAME:" . basename($dev->{rdev});
+        my $file = strftime("%FT%R.$dev->{level}", localtime $NOW);
         my $label = basename($dev->{rdev});
-        verbose
-"\tdumping $dev->{dev} as $dev->{rdev} on $dev->{mountpoint} to $file\n";
+        verbose "> $dev->{dev} ($dev->{rdev}\@$dev->{mountpoint}) to @{[$ftp->pwd]}/$file\n";
         next if $opt_dry;
 
-        ## complain if there is already a full backup in this
-        ## sequence
-        ##die "level 0 dir should be empty\n" if @{$ftp->try(ls => "*.0.*")};
-
         # For LVM do a snapshot, for regular partitions
         # do nothing. But anyway the device to dump is named in $dev->{dump}
         if ($dev->{lvm}) {
 
             # we can do a snapshot
-            # FIXME: calculate the size
             # FIXME: check the snapshot name is not used already
             my $snap = "$dev->{lvm}{path}-snap.0";
 
@@ -187,11 +238,12 @@
     cat <<___
 HOSTNAME   : $HOSTNAME
 DATE       : $NOW @{[scalar localtime $NOW]}
-LEVEL      : $opt_level
+LEVEL      : $dev->{level}
 DEVICE     : $dev->{dev}
 REAL_DEVICE: $dev->{rdev}
 MOUNTPOINT : $dev->{mountpoint}
 FSTYPE     : $dev->{fstype}
+DEVICE_NO  : $dev->{devno}
 
 # For recovery pass everything following the first
 # ^### START to "recover -rf -". Or do one of the following
@@ -210,16 +262,10 @@
 __HEAD
 
 
-            if ($opt_dumpdates) {
-		open(my $f, "+<", $opt_dumpdates) or die "Can't open $opt_dumpdates: $!\n";
-		$_ = join "", <$f>;
-		s/^$dev->{rdev}\s/$dev->{dump} /mg;
-		seek($f, 0, 0);
-		truncate($f, 0);
-		print $f $_;		
-		close($f);
-	    }
-            exec "dump -$opt_level -L $label -f- -u -z$cf{COMPRESSION_LEVEL} $dev->{dump}"
+	    update_devnames($opt_dumpdates, $dev->{rdev} => $dev->{dump})
+		    if $opt_dumpdates;
+
+            exec "dump -$dev->{level} -L $label -f- -u -z$cf{COMPRESSION_LEVEL} $dev->{dump}"
               . "| openssl enc -pass env:key -salt -blowfish";
             die "Can't exec dumper\n";
         };
@@ -235,16 +281,8 @@
         $dev->{cleanup}->() if $dev->{cleanup};
         verbose "Done.\n";
 
-	# fix the dumpdates
-	if ($opt_dumpdates) {
-		open(my $f, "+<", $opt_dumpdates) or die "Can't open $opt_dumpdates: $!\n";
-		$_ = join "", <$f>;
-		s/^$dev->{dump}\s/$dev->{rdev} /mg;
-		seek($f, 0, 0);
-		truncate($f, 0);
-		print $f $_;
-		close($f);
-	}
+	update_devnames($opt_dumpdates, $dev->{dump} => $dev->{rdev})
+		if $opt_dumpdates;
     }
 
 }
@@ -258,12 +296,11 @@
 
     # return the list of backup candidates
 
-    my @dev;
+    my @devs;
 
     # later we need the major of the device mapper
-    my $dev_mapper = 0;
-    $_ = (grep /device.mapper/, slurp("/proc/devices"))[0]
-      and $dev_mapper = (split)[0];
+    my $dev_mapper = (grep /device.mapper/, slurp("/proc/devices"))[0];
+    $dev_mapper = (split " " => $dev_mapper)[0] if defined $dev_mapper;
 
     # find all non comment lines
     foreach (grep !/^\s*#/, slurp("/etc/fstab")) {
@@ -271,16 +308,8 @@
         next if not $dump;
 
         # $dev does not have to contain the real device
-        my $rdev = $dev;
-        if ($dev ~~ /^(LABEL|UUID)=/) {
-
-            # NOTE: dump is able to handle LABEL=... too, but I think
-            # it's more easy for recovery to know the real device
-            chomp($rdev = `blkid -c /dev/null -o device -t '$dev'`);
-        }
-        $rdev = readlink $rdev while -l $rdev;
-
-        my ($major, $minor) = ((stat _)[6] >> 8, (stat _)[6] & 0xff);
+        my $rdev = real_device($dev);
+	my ($major, $minor) = devno($rdev);
 
         # if it's LVM we gather more information (to support snapshots)
         my $lvm;
@@ -290,17 +319,18 @@
             ($lvm->{path} = $+{path}) =~ s/^\/dev\///;
         }
 
-        push @dev,
+        push @devs,
           {
             dev        => $dev,
             rdev       => $rdev,
             mountpoint => $mp,
             fstype     => $fstype,
             lvm        => $lvm,
+            devno      => "$major:$minor",
           };
     }
 
-    return @dev;
+    return @devs;
 }
 
 sub get_configs(@) {
@@ -375,16 +405,102 @@
     sub get_home { return $data{ ref shift }{home} }
 }
 
-sub iso2epoch($) {
-    return 0 if not $_[0];
-    $_[0] =~ /(?<year>\d+)\D(?<mon>\d+)\D(?<mday>\d+)
-	      (?:\D(?<hour>\d\d)\D(?<min>\d\d)(?:\D(?<sec>\d\d))?)?/x;
-    my %iso = ((sec => 0, min => 0, hour => 0), %+);
-    $iso{mon}--;
-    $iso{year} += 1900 if $iso{year} < 100;
-    return timelocal(@iso{qw/sec min hour mday mon year/});
+sub update_devnames($$$) {
+	my ($file, $from, $to) = @_;
+	open(my $f, "+>>", $file) or die "Can't open $file: $!\n";
+	seek($f, 0, 0);
+	my $_ = join "", <$f>;
+	s/^$from\s/$to /mg;
+	truncate($f, 0);
+	# fix the dumpdates
+	print $f $_;		
+	close($f);
+}
+
+sub real_device($) {
+    my $dev = shift;
+
+    if ($dev ~~ /^(LABEL|UUID)=/) {
+	# NOTE: dump is able to handle LABEL=... too, but I think
+	# it's more easy for recovery to know the real device
+	chomp($dev = `blkid -c /dev/null -o device -t '$dev'`);
+    }
+    $dev = realpath($dev);
+}
+
+sub devno($) {
+    my @mm = ((stat shift)[6] >> 8, (stat _)[6] & 0xff);
+    return wantarray ? @mm : "$mm[0]:$mm[1]";
 }
 
+
+# put the last dump information (level and date) into
+# the device structure - information is obtained from $opt_dumpdates
+sub examine(@) {
+    my @devs = @_;
+    my %dd;
+
+    open(my $dd, "+>>", $opt_dumpdates);
+    seek($dd, 0, 0);
+    while (<$dd>) {
+	my ($dev, $level, $date) = /^(\S+)\s+(\d+)\s+(.{30})/
+	    or die "Can't parse $opt_dumpdates: `$_'\n";
+	my $rdev = real_device($dev);
+	my $devno = devno($rdev);
+
+	push @{$dd{$rdev}} => {
+	    dev => $dev,
+	    rdev => real_device($dev),
+	    level => $level,
+	    date => str2time($date),
+	    devno => scalar(devno(real_device($dev))),
+	}
+    }
+    close($dd);
+
+    foreach my $dev (@devs) {
+	my $dd = $dd{$dev->{rdev}};
+
+	if (!$dd) {
+	    $dev->{last} = undef;
+	    next;
+	}
+
+	foreach my $dump (@$dd) {
+	    $dev->{last}[$dump->{level}] = $dump->{date};
+	}
+    }
+
+    ### @devs
+    return @devs;
+}
+
+sub decide($@) {
+    my ($cycle, @devs) = @_;
+
+    foreach my $dev (@devs) {
+	if (defined $opt_level) {
+	    $dev->{level} = $opt_level;
+	    next;
+	}
+
+	if (!$dev->{last}
+	    or not $dev->{last}[0]
+	    or $NOW - $dev->{last}[0] > ($cycle * 86_400)) {
+	    $dev->{level} = 0;
+	    next;
+	}
+
+	$dev->{level} = 1;
+	    
+    }
+
+    return @devs;
+}
+
+#/dev/vda1 0 Thu Apr 14 12:54:31 2011 +0200
+#/dev/vda1 1 Thu Apr 14 12:54:16 2011 +0200
+
 __END__
 
 =head1 NAME
@@ -415,7 +531,7 @@
 Enables debugging for the specified items (comma separated).
 If no item is specified, just some debugging is done.
 
-Valid items are B<ftp>, B<output> and currently nothing else.
+Valid items are B<ftp>, B<output>, B<devices> and currently nothing else.
 
 =over
 
@@ -431,11 +547,19 @@
 
 Even more debugging is shown using the DEBUG=1 environment setting.
 
+=item B<--dry>
+
+Dry run, no real backup is done, this option implies B<--verbose>. (default: off)
+
 =item B<-f>|B<--force>
 
 Use more power (e.g. overwrite a previous level backup and remove all
 invalidated other backups). (default: 0)
 
+=item B<-i>|B<--info>
+
+Just output information about the last backups. (default: off)
+
 =item B<-l>|B<--level> I<level>
 
 The backup level. Level other than "0" needs a previous