[perltidy]
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Fri, 29 Apr 2011 12:12:09 +0200
changeset 63 40f277278d72
parent 62 b7bec6037fd2
child 64 f9f9e2398ba5
[perltidy]
bin/ftbackup
--- a/bin/ftbackup	Fri Apr 29 09:56:27 2011 +0200
+++ b/bin/ftbackup	Fri Apr 29 12:12:09 2011 +0200
@@ -17,24 +17,24 @@
 
 $ENV{LC_ALL} = "C";
 
-my $ME = basename $0;
+my $ME      = basename $0;
 my $VERSION = "0.9";
 
 my @CONFIGS = ("/etc/$ME.conf", "$ENV{HOME}/.$ME.conf", "$ME.conf");
 
 my $HOSTNAME = hostname;
-my $NOW  = time();
+my $NOW      = time();
 
-my $opt_level   = undef;
-my $opt_today   = strftime("%F", localtime $NOW);
-my @opt_debug   = ();
-my $opt_verbose = 0;
-my $opt_dry     = 0;
-my $opt_force   = 0;
-my $opt_label   = "daily";
-my $opt_info    = 0;
-my $opt_config  = "";
-my $opt_clean   = 1;
+my $opt_level     = undef;
+my $opt_today     = strftime("%F", localtime $NOW);
+my @opt_debug     = ();
+my $opt_verbose   = 0;
+my $opt_dry       = 0;
+my $opt_force     = 0;
+my $opt_label     = "daily";
+my $opt_info      = 0;
+my $opt_config    = "";
+my $opt_clean     = 1;
 my $opt_dumpdates = "/var/lib/dumpdates";
 
 sub slurp($);
@@ -54,11 +54,11 @@
 $SIG{INT} = sub { warn "Got signal INT\n"; exit 1 };
 
 my %CONFIG = (
-    FTP_DIR     => "backup/<LABEL>/<HOSTNAME>",
-    FTP_PASSIVE => 1,
+    FTP_DIR           => "backup/<LABEL>/<HOSTNAME>",
+    FTP_PASSIVE       => 1,
     COMPRESSION_LEVEL => 6,
-    FULL_CYCLE  => 7,
-    KEEP => 2,
+    FULL_CYCLE        => 7,
+    KEEP              => 2,
 );
 
 END {
@@ -75,15 +75,16 @@
         "L|label=s" => \$opt_label,
         "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] },
         "v|verbose" => \$opt_verbose,
-	"i|info"    => \$opt_info,
+        "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) },
+        "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) },
+        "m|man"  => sub { pod2usage(-exit => 0, -verbose => 3) },
         "C|config=s" => sub { @CONFIGS = ($_[1]) },
-	"V|version" => sub { print "$ME: $VERSION\n"; exit 0 },
-	"c|clean!"  => \$opt_clean,
-	"D|dumpdates=s" => \$opt_dumpdates,
+        "V|version" => sub { print "$ME: $VERSION\n"; exit 0 },
+        "c|clean!" => \$opt_clean,
+        "D|dumpdates=s" => \$opt_dumpdates,
     ) or pod2usage;
 
     my %cf = (%CONFIG, get_configs(@CONFIGS));
@@ -97,17 +98,19 @@
     ### %cf
     ### @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};
     push @errors, "Need KEY (see config)."      if not defined $cf{KEY};
-    push @errors, "Command `dump' not found. ($ENV{PATH})"   if system("command -v dump >/dev/null");
-    push @errors, "Command `lvm' not found. ($ENV{PATH})"    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" if @errors;
+    push @errors, "Command `dump' not found. ($ENV{PATH})"
+      if system("command -v dump >/dev/null");
+    push @errors, "Command `lvm' not found. ($ENV{PATH})"
+      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"
+      if @errors;
 
     my $ftp;
 
@@ -131,36 +134,39 @@
     ### @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 $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};
-	}
+        my %l;
+        foreach my $dev (@devs) {
+            $l{$dev} = sprintf "%*s (%*s %*s)",
+              -$ld => $dev->{dev},
+              -$lr => $dev->{rdev},
+              -$ln => $dev->{devno};
+        }
 
-	say "\ncurrent situation\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 "\ncurrent situation\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 for next dump\n", 
-	      "------------------";
-	foreach my $dev (@devs) {
-	    say "$l{$dev}: level $dev->{level}";
-	}
+        say "\nplan for next dump\n", "------------------";
+        foreach my $dev (@devs) {
+            say "$l{$dev}: level $dev->{level}";
+        }
 
-
-	exit;
+        exit;
     }
 
     # and now we can start doing something with our filesystems
@@ -177,33 +183,36 @@
             $ftp->try(cwd    => $dir);
 
             #verbose "Now in @{[$ftp->pwd]}.\n" if $ftp;
-	    unlink_old_dumps($ftp, $cf{KEEP} + 1)
-		if $opt_clean;
+            unlink_old_dumps($ftp, $cf{KEEP} + 1)
+              if $opt_clean;
 
             # examine the situation and decide about the level
             # FIXME: currently we simply run a full dump every FULL_CYCLE
             # days, the intermediate dumps are level 1
             foreach (reverse sort $ftp->ls) {
                 /^(?<date>.*)\.(?<level>\d+)$/ or next;
-		$last[$+{level}] = str2time $+{date};
+                $last[$+{level}] = str2time $+{date};
             }
         }
 
-	# for safety we check if there is really a full dump not older than xxx days
+    # 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 - $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 - $last[0])/86_400;
-	    }
+            if (!@last) {
+                $dev->{level} = 0;
+                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
+"adjusted backup level to 0, last full backup is %.1f days old\n",
+                  ($NOW - $last[0]) / 86_400;
+            }
         }
 
         my $file = strftime("%FT%R.$dev->{level}", localtime $NOW);
         my $label = basename($dev->{rdev});
-        verbose "> $dev->{dev} ($dev->{rdev}\@$dev->{mountpoint}) to @{[$ftp->pwd]}/$file\n";
+        verbose
+"> $dev->{dev} ($dev->{rdev}\@$dev->{mountpoint}) to @{[$ftp->pwd]}/$file\n";
         next if $opt_dry;
 
         # For LVM do a snapshot, for regular partitions
@@ -286,17 +295,17 @@
 #-- START
 __HEAD
 
+            update_devnames($opt_dumpdates, $dev->{rdev} => $dev->{dump})
+              if $opt_dumpdates;
 
-	    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}"
+            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";
         };
 
         if ($ftp) {
-	    verbose("sending dump to " . $ftp->pwd . "/$file\n");
+            verbose("sending dump to " . $ftp->pwd . "/$file\n");
             $ftp->try(put => $dump, $file);
         }
         else {
@@ -307,11 +316,11 @@
         $dev->{cleanup}->() if $dev->{cleanup};
         verbose "Done.\n";
 
-	update_devnames($opt_dumpdates, $dev->{dump} => $dev->{rdev})
-		if $opt_dumpdates;
+        update_devnames($opt_dumpdates, $dev->{dump} => $dev->{rdev})
+          if $opt_dumpdates;
 
-	unlink_old_dumps($ftp, $cf{KEEP})
-	    if $ftp and $opt_clean;
+        unlink_old_dumps($ftp, $cf{KEEP})
+          if $ftp and $opt_clean;
     }
 
 }
@@ -338,7 +347,7 @@
 
         # $dev does not have to contain the real device
         my $rdev = real_device($dev);
-	my ($major, $minor) = devno($rdev);
+        my ($major, $minor) = devno($rdev);
 
         # if it's LVM we gather more information (to support snapshots)
         my $lvm;
@@ -381,7 +390,7 @@
             # FIXME: should check the containing directories too!
         };
 
-	open(my $f, $_) or die "Can't open $_: $!\n";
+        open(my $f, $_) or die "Can't open $_: $!\n";
         my %h = map { split /\s*=\s*/, $_, 2 } grep { !/^\s*#/ and /=/ } <$f>;
         map { chomp } values %h;
         %r = (%r, %h);
@@ -425,9 +434,11 @@
     sub home {
         my $self = shift;
         return $data{ ref $self }{home} = shift if @_;
-        $self->try(cwd => exists $data{ ref $self }{home}
+        $self->try(
+            cwd => exists $data{ ref $self }{home}
             ? $data{ ref $self }{home}
-            : "/");
+            : "/"
+        );
         return $self->pwd();
     }
 
@@ -435,23 +446,24 @@
 }
 
 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);
-	print $f $_;		
-	close($f);
+    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);
+    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'`);
+
+        # 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);
 }
@@ -462,7 +474,6 @@
     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 get_history(@) {
@@ -472,32 +483,32 @@
     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);
+        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))),
-	}
+        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}};
+        my $dd = $dd{ $dev->{rdev} };
 
-	if (!$dd) {
-	    $dev->{last} = undef;
-	    next;
-	}
+        if (!$dd) {
+            $dev->{last} = undef;
+            next;
+        }
 
-	foreach my $dump (@$dd) {
-	    $dev->{last}[$dump->{level}] = $dump->{date};
-	}
+        foreach my $dump (@$dd) {
+            $dev->{last}[$dump->{level}] = $dump->{date};
+        }
     }
 
     ### @devs
@@ -508,13 +519,12 @@
     my $n = shift;
     my @units = ("", qw(K M G T));
     while (length($n) > 3) {
-	$n = int($n / 1024);
-	shift @units;
+        $n = int($n / 1024);
+        shift @units;
     }
     return "$n $units[0]";
 }
 
-
 sub get_estimate($$) {
     my ($dev, $level) = @_;
     print STDERR "% estimating $dev->{rdev} at level $level: ";
@@ -527,28 +537,33 @@
     my ($cycle, @devs) = @_;
 
     foreach my $dev (@devs) {
-	if (defined $opt_level) {
-	    $dev->{level} = $opt_level;
-	} 
-	elsif (!$dev->{last}
-	    or not $dev->{last}[0]
-	    or $NOW - $dev->{last}[0] > ($cycle * 86_400)) {
-	    $dev->{level} = 0;
-	} 
-	else { $dev->{level} = 1 }
+        if (defined $opt_level) {
+            $dev->{level} = $opt_level;
+        }
+        elsif (!$dev->{last}
+            or not $dev->{last}[0]
+            or $NOW - $dev->{last}[0] > ($cycle * 86_400))
+        {
+            $dev->{level} = 0;
+        }
+        else { $dev->{level} = 1 }
 
-	# now we'll see if the level really saves space compared
-	# with the next lower level
-	my @estimates;
-	while (my $l = $dev->{level} > 0) {
-	    $estimates[$l] //= get_estimate($dev, $l);
-	    $estimates[$l - 1] //= get_estimate($dev, $l - 1);
+        # now we'll see if the level really saves space compared
+        # with the next lower level
+        my @estimates;
+        while (my $l = $dev->{level} > 0) {
+            $estimates[$l]     //= get_estimate($dev, $l);
+            $estimates[$l - 1] //= get_estimate($dev, $l - 1);
 
-	    last if my $savings = ($estimates[$l-1] - $estimates[$l]) / $estimates[$l-1] >= 0.10;
-	    warn "% savings for level $dev->{level} on $dev->{dev} are @{[int($savings * 100)]}%: ",
-		 "will use level ", $dev->{level} - 1, "\n";
-	    --$dev->{level};
-	}
+            last
+              if my $savings =
+                  ($estimates[$l - 1] - $estimates[$l]) / $estimates[$l - 1] >=
+                  0.10;
+            warn
+"% savings for level $dev->{level} on $dev->{dev} are @{[int($savings * 100)]}%: ",
+              "will use level ", $dev->{level} - 1, "\n";
+            --$dev->{level};
+        }
     }
 
     return @devs;
@@ -564,35 +579,37 @@
     my ($ftp, $keep) = @_;
     my @dumps;
     foreach ($ftp->ls) {
-	/^(?<date>.*)\.(?<level>\d+)$/ or next;
-	push @{$dumps[$+{level}]} => { file => $_, date => $+{date}, stamp => str2time($+{date})};
+        /^(?<date>.*)\.(?<level>\d+)$/ or next;
+        push @{ $dumps[$+{level}] } =>
+          { file => $_, date => $+{date}, stamp => str2time($+{date}) };
     }
 
-
     # sort the level 0 dumps by date and remove all but the last $keep
     # ones.
     # if we found level 0 dumps, we remove all level 1+ dumps older than
     # the oldest level 0 dump we'll remove
-    @{$dumps[0]} = sort { $a->{stamp} <=> $b->{stamp} } @{$dumps[0]};
+    @{ $dumps[0] } = sort { $a->{stamp} <=> $b->{stamp} } @{ $dumps[0] };
 
     ### @dumps
-    my @unlink = splice(@{$dumps[0]}, 0, -$keep);
+    my @unlink = splice(@{ $dumps[0] }, 0, -$keep);
 
     if ($dumps[1]) {
-	if (!@{$dumps[0]}) { push @unlink, @{@dumps[1..$#dumps]} }
-	else { push @unlink => grep { $_->{stamp} <= $dumps[0][0]{stamp} } @{@dumps[1..$#dumps]} }
+        if (!@{ $dumps[0] }) { push @unlink, @{ @dumps[1 .. $#dumps] } }
+        else {
+            push @unlink => grep { $_->{stamp} <= $dumps[0][0]{stamp} }
+              @{ @dumps[1 .. $#dumps] };
+        }
     }
 
     ### @unlink
 
     foreach (@unlink) {
-	say "DELETE: $_->{file}";
-	next if $opt_dry;
-	$ftp->delete($_->{file});
+        say "DELETE: $_->{file}";
+        next if $opt_dry;
+        $ftp->delete($_->{file});
     }
 }
 
-
 #/dev/vda1 0 Thu Apr 14 12:54:31 2011 +0200
 #/dev/vda1 1 Thu Apr 14 12:54:16 2011 +0200