--- a/ftbackup Wed Dec 23 00:03:02 2009 +0100
+++ b/ftbackup Wed Dec 23 00:04:13 2009 +0100
@@ -10,7 +10,7 @@
use Sys::Hostname;
use Time::Local;
use Pod::Usage;
-use POSIX qw(strftime);;
+use POSIX qw(strftime);
use English qw(-no_match_vars);
use 5.10.0;
use if $ENV{DEBUG} => qw(Smart::Comments);
@@ -22,16 +22,16 @@
my @CONFIGS = ("/etc/$ME", "$ENV{HOME}/.$ME", "$ME.conf");
my $NODE = hostname;
-my $NOW = time();
+my $NOW = time();
-my $opt_level = undef;
-my $opt_today = strftime("%F", localtime $NOW);
-my @opt_debug = ();
+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_config = "";
+my $opt_dry = 0;
+my $opt_force = 0;
+my $opt_label = "daily";
+my $opt_config = "";
sub get_configs(@);
sub get_candidates();
@@ -39,30 +39,29 @@
sub iso2epoch($);
our @AT_EXIT;
-END { $_->() foreach @AT_EXIT };
+END { $_->() foreach @AT_EXIT }
$SIG{INT} = sub { warn "Got signal INT\n"; exit 1 };
my %CONFIG = (
- FTP_DIR => "backup/<LABEL>/<NODE>",
+ FTP_DIR => "backup/<LABEL>/<NODE>",
FTP_PASSIVE => 1,
- FULL_CYCLE => 7, # not used yet
+ FULL_CYCLE => 7, # not used yet
);
MAIN: {
Getopt::Long::Configure("bundling");
GetOptions(
- "l|level=i" => \$opt_level,
- "L|label=s" => \$opt_label,
- "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] },
- "v|verbose" => \$opt_verbose,
- "dry" => \$opt_dry,
- "f|force" => \$opt_force,
- "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) },
- "m|man" => sub { pod2usage(-exit => 0, -verbose => 3) },
- "C|config=s" => sub { @CONFIGS = ($_[1]) },
+ "l|level=i" => \$opt_level,
+ "L|label=s" => \$opt_label,
+ "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] },
+ "v|verbose" => \$opt_verbose,
+ "dry" => \$opt_dry,
+ "f|force" => \$opt_force,
+ "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) },
+ "m|man" => sub { pod2usage(-exit => 0, -verbose => 3) },
+ "C|config=s" => sub { @CONFIGS = ($_[1]) },
) or pod2usage;
-
my %cf = (%CONFIG, get_configs(@CONFIGS));
$cf{FTP_DIR} =~ s/<NODE>/$NODE/g;
$cf{FTP_DIR} =~ s/<LABEL>/$opt_label/g;
@@ -72,100 +71,108 @@
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, "Need KEY (see config)." if not defined $cf{KEY};
die join "\n", @errors, "" if @errors;
my $ftp;
if (not @opt_debug ~~ /^output$/) {
- $ftp = new FTP($cf{FTP_HOST},
- Passive => $cf{FTP_PASSIVE},
- Debug => @opt_debug ~~ /^ftp$/) or die $@;
- $ftp->login or die $ftp->message;
- $ftp->home($ftp->try(pwd => ()));
- $ftp->try(binary => ());
- $ftp->try(mkpath => $cf{FTP_DIR});
- $ftp->try(cwd => $cf{FTP_DIR});
+ $ftp = new FTP(
+ $cf{FTP_HOST},
+ Passive => $cf{FTP_PASSIVE},
+ Debug => @opt_debug ~~ /^ftp$/
+ ) or die $@;
+ $ftp->login or die $ftp->message;
+ $ftp->home($ftp->try(pwd => ()));
+ $ftp->try(binary => ());
+ $ftp->try(mkpath => $cf{FTP_DIR});
+ $ftp->try(cwd => $cf{FTP_DIR});
}
### @dev
# and now we can start doing something with our filesystems
- DEVICE: foreach my $dev (@dev) {
- my $dir = $dev->{mountpoint};
- $dir =~ s/_/__/g;
- $dir =~ s/\//_/g;
- $dir = "$cf{FTP_DIR}/$dir";
+ DEVICE: foreach my $dev (@dev) {
+ my $dir = $dev->{mountpoint};
+ $dir =~ s/_/__/g;
+ $dir =~ s/\//_/g;
+ $dir = "$cf{FTP_DIR}/$dir";
- my @last;
- if ($ftp) {
- $ftp->home();
- $ftp->try(mkpath => $dir);
- $ftp->try(cwd => $dir);
+ my @last;
+ if ($ftp) {
+ $ftp->home();
+ $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
- # days, the intermediate dumps are level 1
- foreach (reverse sort $ftp->ls) {
- /^(?<date>.*)\.(?<level>\d+)$/;
- $last[$+{level}] = $+{date};
- last if $+{level} == 0;
- }
- }
+ # 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+)$/;
+ $last[$+{level}] = $+{date};
+ last if $+{level} == 0;
+ }
+ }
- if (not defined $opt_level) {
- $opt_level =
- ($NOW - iso2epoch $last[0])/86400 > $cf{FULL_CYCLE} ? 0 : 1;
- }
+ if (not defined $opt_level) {
+ $opt_level =
+ ($NOW - iso2epoch $last[0]) / 86400 > $cf{FULL_CYCLE} ? 0 : 1;
+ }
- my $file = strftime("%F_%R", localtime $NOW) . ".$opt_level";
- my $label = "$NODE:" . basename($dev->{rdev});
- verbose "\tdumping $dev->{dev} as $dev->{rdev} on $dev->{mountpoint} to $file\n";
- next if $opt_dry;
+ my $file = strftime("%F_%R", localtime $NOW) . ".$opt_level";
+ my $label = "$NODE:" . basename($dev->{rdev});
+ verbose
+"\tdumping $dev->{dev} as $dev->{rdev} on $dev->{mountpoint} to $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.*")};
+ ## 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
- my $snap = "$dev->{lvm}{path}-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
+ my $snap = "$dev->{lvm}{path}-0";
- verbose "Creating snapshot $snap\n";
- system($_ = "lvcreate -s -L 1G -n $snap $dev->{lvm}{path} >/dev/null");
- die "failed system command: $_\n" if $?;
+ verbose "Creating snapshot $snap\n";
+ system($_ =
+ "lvcreate -s -L 1G -n $snap $dev->{lvm}{path} >/dev/null");
+ die "failed system command: $_\n" if $?;
- $dev->{cleanup} = sub { system "lvdisplay $snap &>/dev/null"
- . " && lvremove -f $snap >/dev/null" };
- push @AT_EXIT, $dev->{cleanup};
-
- (my $device) = (grep /lv name/i, `lvdisplay $snap`)[0] =~ /(\S+)\s*$/;
+ $dev->{cleanup} = sub {
+ system "lvdisplay $snap &>/dev/null"
+ . " && lvremove -f $snap >/dev/null";
+ };
+ push @AT_EXIT, $dev->{cleanup};
- for (my $retries = 3; $retries; $retries--) {
- system($_ = "fsck -f @{[$opt_verbose ? '-C0' : '']} -y $device");
- last if not $?;
- warn "fsck on $device (using: $_) failed"
- . ($retries > 1 ? ", retrying…\n" : "")
- . "\n";
- }
+ (my $device) =
+ (grep /lv name/i, `lvdisplay $snap`)[0] =~ /(\S+)\s*$/;
- ($dev->{dump}) = $device;
+ for (my $retries = 3 ; $retries ; $retries--) {
+ system($_ =
+ "fsck -f @{[$opt_verbose ? '-C0' : '']} -y $device");
+ last if not $?;
+ warn "fsck on $device (using: $_) failed"
+ . ($retries > 1 ? ", retrying…\n" : "") . "\n";
+ }
- }
- else {
- $dev->{dump} = $dev->{rdev}
- }
+ ($dev->{dump}) = $device;
- ### $dev
+ }
+ else {
+ $dev->{dump} = $dev->{rdev};
+ }
- $ENV{key} = $cf{KEY};
- my $dumper = open(my $dump, "-|") or do {
- print <<__HEAD;
+ ### $dev
+
+ $ENV{key} = $cf{KEY};
+ my $dumper = open(my $dump, "-|") or do {
+ print <<__HEAD;
#! /bin/bash
LC_ALL=C
if test -t 1 || test "$1" ; then
@@ -193,70 +200,74 @@
### START
__HEAD
- exec "dump -$opt_level -L $label -f- -u -z6 $dev->{dump}"
- . "| openssl enc -pass env:key -salt -blowfish";
- die "Can't exec dumper\n";
- };
+ exec "dump -$opt_level -L $label -f- -u -z6 $dev->{dump}"
+ . "| openssl enc -pass env:key -salt -blowfish";
+ die "Can't exec dumper\n";
+ };
- if ($ftp) {
- $ftp->try(put => $dump, $file);
- }
- else {
- print while <$dump>;
- warn "STOPPED after the first dump\n";
- exit;
- }
- $dev->{cleanup}->() if $dev->{cleanup};
- verbose "Done.\n";
+ if ($ftp) {
+ $ftp->try(put => $dump, $file);
+ }
+ else {
+ print while <$dump>;
+ warn "STOPPED after the first dump\n";
+ exit;
+ }
+ $dev->{cleanup}->() if $dev->{cleanup};
+ verbose "Done.\n";
}
}
sub verbose(@) {
- return if not $opt_verbose;
+ return if not $opt_verbose;
print STDERR @_;
}
sub get_candidates() {
-# return the list of backup candidates
+
+ # return the list of backup candidates
my @dev;
# 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];
+ and $dev_mapper = (split)[0];
# find all non comment lines
foreach (grep !/^\s*#/, slurp("/etc/fstab")) {
- my ($dev, $mp, $fstype, $options, $dump, $check)
- = split;
- next if not $dump;
+ my ($dev, $mp, $fstype, $options, $dump, $check) = split;
+ next if not $dump;
+
+ # $dev does not have to contain the real device
+ my $rdev = $dev;
+ if ($dev ~~ /^(LABEL|UUID)=/) {
- # $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;
+ # 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 ($major, $minor) = ((stat _)[6] >> 8, (stat _)[6] & 0xff);
-
- # if it's LVM we gather more information (to support snapshots)
- my $lvm;
- if ($_ = (grep { /:$major:$minor\s*$/ } `lvdisplay -c`)[0] and /\s*(?<path>\S+?):/) {
- ($lvm->{path} = $+{path}) =~ s/^\/dev\///;
- }
+ # if it's LVM we gather more information (to support snapshots)
+ my $lvm;
+ if ($_ = (grep { /:$major:$minor\s*$/ } `lvdisplay -c`)[0]
+ and /\s*(?<path>\S+?):/)
+ {
+ ($lvm->{path} = $+{path}) =~ s/^\/dev\///;
+ }
- push @dev, {
- dev => $dev,
- rdev => $rdev,
- mountpoint => $mp,
- fstype => $fstype,
- lvm => $lvm,
- };
+ push @dev,
+ {
+ dev => $dev,
+ rdev => $rdev,
+ mountpoint => $mp,
+ fstype => $fstype,
+ lvm => $lvm,
+ };
}
return @dev;
@@ -265,67 +276,73 @@
sub get_configs(@) {
local $_;
my %r = ();
- foreach (grep {-f} map { (-d) ? glob("$_/*") : $_ } @_) {
+ foreach (grep { -f } map { (-d) ? glob("$_/*") : $_ } @_) {
- # check permission and ownership
- {
- my $p = (stat)[2] & 07777;
- my $u = (stat _)[4];
- die "$ME: $_ has wrong permissions: found @{[sprintf '%04o', $p]}, need 0600\n"
- if $p != 0600;
- die "$ME: owner of $_ ($u) is not the EUID ($EUID) of this process\n"
- if (stat _)[4] != $EUID;
+ # check permission and ownership
+ {
+ my $p = (stat)[2] & 07777;
+ my $u = (stat _)[4];
+ die
+"$ME: $_ has wrong permissions: found @{[sprintf '%04o', $p]}, need 0600\n"
+ if $p != 0600;
+ die
+ "$ME: owner of $_ ($u) is not the EUID ($EUID) of this process\n"
+ if (stat _)[4] != $EUID;
- # FIXME: should check the containing directories too!
- };
+ # FIXME: should check the containing directories too!
+ };
- my $f = new IO::File $_ or die "Can't open $_: $!\n";
- my %h = map { split /\s*=\s*/, $_, 2 } grep {!/^\s*#/ and /=/} <$f>;
- map { chomp } values %h;
- %r = (%r, %h);
+ my $f = new IO::File $_ or die "Can't open $_: $!\n";
+ my %h = map { split /\s*=\s*/, $_, 2 } grep { !/^\s*#/ and /=/ } <$f>;
+ map { chomp } values %h;
+ %r = (%r, %h);
}
return %r;
}
-{ package FTP;
- use strict;
- use warnings;
- use base qw(Net::FTP);
+{
- my %data;
+ package FTP;
+ use strict;
+ use warnings;
+ use base qw(Net::FTP);
+
+ my %data;
- sub new {
- my $class = shift;
- return bless Net::FTP->new(@_) => $class;
- }
+ sub new {
+ my $class = shift;
+ return bless Net::FTP->new(@_) => $class;
+ }
- sub try {
- my $self = shift;
- my $func = shift;
- $self->$func(@_)
- or die "FTP $func failed: " . $self->message . "\n";
- }
+ sub try {
+ my $self = shift;
+ my $func = shift;
+ $self->$func(@_)
+ or die "FTP $func failed: " . $self->message . "\n";
+ }
- sub mkpath {
- my $self = shift;
- my $current = $self->pwd();
- foreach (split /\/+/, $_[0]) {
- next if $self->cwd($_);
- return undef if not $self->message ~~ /no such .*dir/i;
- return undef if not $self->SUPER::mkdir($_);
- return undef if not $self->cwd($_);
+ sub mkpath {
+ my $self = shift;
+ my $current = $self->pwd();
+ foreach (split /\/+/, $_[0]) {
+ next if $self->cwd($_);
+ return undef if not $self->message ~~ /no such .*dir/i;
+ return undef if not $self->SUPER::mkdir($_);
+ return undef if not $self->cwd($_);
+ }
+ $self->cwd($current);
}
- $self->cwd($current);
- }
- sub home {
- my $self = shift;
- return $data{ref $self}{home} = shift if @_;
- $self->try(cwd => exists $data{ref $self}{home} ? $data{ref $self}{home} : "/");
- return $self->pwd();
- }
+ sub home {
+ my $self = shift;
+ return $data{ ref $self }{home} = shift if @_;
+ $self->try(cwd => exists $data{ ref $self }{home}
+ ? $data{ ref $self }{home}
+ : "/");
+ return $self->pwd();
+ }
- sub get_home { return $data{ref shift}{home} };
+ sub get_home { return $data{ ref shift }{home} }
}
sub iso2epoch($) {