--- a/.hgignore Tue Apr 26 22:58:00 2011 +0200
+++ b/.hgignore Tue Apr 26 23:39:08 2011 +0200
@@ -1,9 +1,7 @@
syntax: glob
ftbackup.conf
debian/*
-ftbackup.8
debian/files
-Makefile
.version
_build/
blib/
--- a/.perltidyrc Tue Apr 26 22:58:00 2011 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,2 +0,0 @@
---paren-tightness=2
---square-bracket-tightness=2
--- a/Build.PL Tue Apr 26 22:58:00 2011 +0200
+++ b/Build.PL Tue Apr 26 23:39:08 2011 +0200
@@ -4,13 +4,12 @@
Module::Build->new(
dist_name => "ftbackup",
- dist_version => "0.7",
+ dist_version => "0.8",
requires => {
perl => "5.10.0",
- "Perl6::Slurp" => 0,
"Net::FTP" => 0,
"Date::Parse" => 0,
},
- script_files => [glob("sbin/*")],
+ script_files => [glob("bin/*")],
)->create_build_script();
--- a/MANIFEST Tue Apr 26 22:58:00 2011 +0200
+++ b/MANIFEST Tue Apr 26 23:39:08 2011 +0200
@@ -1,5 +1,5 @@
-.perltidyrc
-sbin/ftbackup
+bin/.perltidyrc
+bin/ftbackup
build-stamp
configure
configure-stamp
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/.perltidyrc Tue Apr 26 23:39:08 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/ftbackup Tue Apr 26 23:39:08 2011 +0200
@@ -0,0 +1,645 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+
+use File::Basename;
+use Net::FTP;
+use Getopt::Long;
+use Sys::Hostname;
+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);
+
+$ENV{LC_ALL} = "C";
+
+my $ME = basename $0;
+my $VERSION = '<VERSION>';
+
+my @CONFIGS = ("/etc/$ME.conf", "$ENV{HOME}/.$ME.conf", "$ME.conf");
+
+my $HOSTNAME = hostname;
+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_dumpdates = "/var/lib/dumpdates";
+
+sub slurp($);
+sub get_configs(@);
+sub get_candidates();
+sub verbose(@);
+sub update_devnames($$$);
+sub get_history(@);
+sub calculate_level($@);
+sub real_device($);
+sub get_estimate($$);
+sub devno($);
+
+our @AT_EXIT;
+END { $_->() foreach @AT_EXIT }
+$SIG{INT} = sub { warn "Got signal INT\n"; exit 1 };
+
+my %CONFIG = (
+ FTP_DIR => "backup/<LABEL>/<HOSTNAME>",
+ FTP_PASSIVE => 1,
+ FULL_CYCLE => 7,
+ COMPRESSION_LEVEL => 6,
+);
+
+
+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,
+ "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) },
+ "C|config=s" => sub { @CONFIGS = ($_[1]) },
+ "V|version" => sub { print "$ME: $VERSION\n"; exit 0 },
+ "D|dumpdates=s" => \$opt_dumpdates,
+ ) or pod2usage;
+
+ my %cf = (%CONFIG, get_configs(@CONFIGS));
+ $cf{FTP_DIR} =~ s/<HOSTNAME>/$HOSTNAME/g;
+ $cf{FTP_DIR} =~ s/<LABEL>/$opt_label/g;
+
+ # get the backup candiates -> all file systems from /etc/fstab
+ # with a dump frequence > 0
+ my @devs = get_candidates();
+
+ ### %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." if system("command -v dump >/dev/null");
+ die "$ME: pre-flight check failed:\n\t",
+ join("\n\t" => @errors), "\n" if @errors;
+
+ my $ftp;
+
+ if (not "output" ~~ \@opt_debug) {
+ $ftp = new FTP(
+ $cf{FTP_HOST},
+ Passive => $cf{FTP_PASSIVE},
+ Debug => "ftp" ~~ \@opt_debug,
+ ) 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});
+ }
+
+ # get_history the situation - we rely on $opt_dumpdates
+ @devs = get_history(@devs);
+ @devs = calculate_level($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 "\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}";
+ }
+
+
+ exit;
+ }
+
+ # and now we can start doing something with our filesystems
+ DEVICE: foreach my $dev (@devs) {
+ 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);
+
+ #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+)$/ or next;
+ $last[$+{level}] = $+{date};
+ last if $+{level} == 0;
+ }
+ }
+
+ # 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("%FT%R.$dev->{level}", localtime $NOW);
+ my $label = basename($dev->{rdev});
+ verbose "> $dev->{dev} ($dev->{rdev}\@$dev->{mountpoint}) to @{[$ftp->pwd]}/$file\n";
+ next if $opt_dry;
+
+ # 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: check the snapshot name is not used already
+ my $snap = "$dev->{lvm}{path}-snap.0";
+
+ 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*$/;
+
+ 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";
+ }
+
+ ($dev->{dump}) = $device;
+
+ }
+ else {
+ $dev->{dump} = $dev->{rdev};
+ }
+
+ ### $dev
+
+ $ENV{key} = $cf{KEY};
+ my $dumper = open(my $dump, "-|") or do {
+ print <<__HEAD;
+#! /bin/bash
+LC_ALL=C
+if test -t 1; then
+ cat <<___
+HOSTNAME : $HOSTNAME
+DATE : $NOW @{[scalar localtime $NOW]}
+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
+# lines:
+# sh <THIS SCRIPT> | restore -rf -
+# sh <(ftpipe <URL>) -pass file:/dev/tty | restore -rf -
+___
+ exit 0
+fi
+while read; do
+ test "\$REPLY" = "### START" \\
+ && exec openssl enc -d -blowfish "\$@"
+done <"\$0"
+
+### START
+__HEAD
+
+
+ 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";
+ };
+
+ 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";
+
+ update_devnames($opt_dumpdates, $dev->{dump} => $dev->{rdev})
+ if $opt_dumpdates;
+ }
+
+}
+
+sub verbose(@) {
+ return if not $opt_verbose;
+ print STDERR @_;
+}
+
+sub get_candidates() {
+
+ # return the list of backup candidates
+
+ my @devs;
+
+ # later we need the major of the device mapper
+ 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")) {
+ my ($dev, $mp, $fstype, $options, $dump, $check) = split;
+ next if not $dump;
+
+ # $dev does not have to contain the real device
+ my $rdev = real_device($dev);
+ my ($major, $minor) = devno($rdev);
+
+ # 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 @devs,
+ {
+ dev => $dev,
+ rdev => $rdev,
+ mountpoint => $mp,
+ fstype => $fstype,
+ lvm => $lvm,
+ devno => "$major:$minor",
+ };
+ }
+
+ return @devs;
+}
+
+sub get_configs(@) {
+ local $_;
+ my %r = ();
+ 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;
+
+ # FIXME: should check the containing directories too!
+ };
+
+ 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);
+ }
+ return %r;
+}
+
+{
+
+ 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 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($_);
+ }
+ $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 get_home { return $data{ ref shift }{home} }
+}
+
+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($) {
+ stat shift or return wantarray ? () : undef;
+ my @mm = ((stat _)[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 get_history(@) {
+ 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 get_estimate($$) {
+ my ($dev, $level) = @_;
+ warn "% estimating $dev->{rdev} at level $level\n";
+ chomp(my $_ = `dump -S -$level $dev->{rdev}`);
+ return $_;
+}
+
+sub calculate_level($@) {
+ 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 }
+
+ # 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};
+ }
+ }
+
+ return @devs;
+}
+
+sub slurp($) {
+ my $f = shift;
+ open(my $fh, "<", $f) or die "Can't open $f: $!\n";
+ return <$fh>;
+}
+
+#/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
+
+ftbackup - ftp backup tool
+
+=head1 SYNOPSIS
+
+ ftbackup [--level <level>] [options]
+
+=head1 DESCRIPTION
+
+The B<ftbackup> tools saves the partitions (file systems) marked in
+F</etc/fstab> to an FTP host. It uses dump(8) for generating the backup
+and openssl(1) for encrypting the data stream (and thus the written
+files).
+
+=head1 OPTIONS
+
+=over
+
+=item B<-D>|B<--dumpdates> I<file>
+
+Update the I<file> as dumpdates file. (default: /var/lib/dumpdates)
+
+=item B<-d>|B<--debug> [I<item>]
+
+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>, B<devices> and currently nothing else.
+
+=over
+
+=item B<ftp>
+
+This switches on debugging of the used L<Net::FTP> module.
+
+=item B<output>
+
+The output is not sent via FTP but to stdout. Beware!
+
+=back
+
+Even more debugging is shown using the DEBUG=1 environment setting.
+
+=item B<--clean> [I<days>]
+
+Cleanup older backups we do not need (that is: incremental backups with
+no previous full backup. If I<days> are given, then all full backups older than
+the number of I<days> are removed (and all incremental backups based on these
+full backups). (default: 0 and not implemented)
+
+=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 and not implemented)
+
+=item B<-i>|B<--info>
+
+Just output information about the last backups and exit. (default: off)
+
+=item B<-l>|B<--level> I<level>
+
+The backup level. Level other than "0" needs a previous
+level 0 (full) backup. If not specified, it is choosen automagically.
+(default: undef)
+
+=item B<-L>|B<--label> I<label>
+
+The label for the backup. (default: daily)
+
+=item B<-v>|B<--verbose>
+
+Be verbose. (default: no)
+
+=back
+
+=head1 FILES
+
+=head2 Configuration
+
+The config files are searched in the following places:
+
+ /etc/ftbackup.conf
+ ~/.ftbackup.conf
+ ./ftbackup.conf
+
+If the location is a directory, all (not hidden) files in this directory are
+considered to be config, if the location a file itself, this is considered to
+be a config file. The config files have to be mode 0600 and they have to be
+owned by the EUID running the process.
+
+The config file may contain the following items (listed with their built in defaults)
+
+ KEY = <no default>
+ FTP_HOST = <no default>
+ FTP_DIR = "backup/<LABEL>/<HOSTNAME>"
+ FTP_PASSIVE = 1
+ FULL_CYCLE = 7
+ COMPRESSION_LEVEL = 6
+
+=head2 F<.netrc>
+
+You may miss the login information for the FTP server. Currently we rely on a valid
+F<~/.netrc> entry. An example line of the F<~/.netrc>:
+
+ machine ... login ... password ...
+
+=cut
+
+# vim:sts=4 sw=4 aw ai sm:
--- a/sbin/ftbackup Tue Apr 26 22:58:00 2011 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,639 +0,0 @@
-#! /usr/bin/perl
-
-use 5.010;
-use strict;
-use warnings;
-
-use File::Basename;
-use Net::FTP;
-use Perl6::Slurp;
-use Getopt::Long;
-use Sys::Hostname;
-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);
-
-$ENV{LC_ALL} = "C";
-
-my $ME = basename $0;
-my $VERSION = '<VERSION>';
-
-my @CONFIGS = ("/etc/$ME.conf", "$ENV{HOME}/.$ME.conf", "$ME.conf");
-
-my $HOSTNAME = hostname;
-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_dumpdates = "/var/lib/dumpdates";
-
-sub get_configs(@);
-sub get_candidates();
-sub verbose(@);
-sub update_devnames($$$);
-sub get_history(@);
-sub calculate_level($@);
-sub real_device($);
-sub get_estimate($$);
-sub devno($);
-
-our @AT_EXIT;
-END { $_->() foreach @AT_EXIT }
-$SIG{INT} = sub { warn "Got signal INT\n"; exit 1 };
-
-my %CONFIG = (
- FTP_DIR => "backup/<LABEL>/<HOSTNAME>",
- FTP_PASSIVE => 1,
- FULL_CYCLE => 7,
- COMPRESSION_LEVEL => 6,
-);
-
-
-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,
- "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) },
- "C|config=s" => sub { @CONFIGS = ($_[1]) },
- "V|version" => sub { print "$ME: $VERSION\n"; exit 0 },
- "D|dumpdates=s" => \$opt_dumpdates,
- ) or pod2usage;
-
- my %cf = (%CONFIG, get_configs(@CONFIGS));
- $cf{FTP_DIR} =~ s/<HOSTNAME>/$HOSTNAME/g;
- $cf{FTP_DIR} =~ s/<LABEL>/$opt_label/g;
-
- # get the backup candiates -> all file systems from /etc/fstab
- # with a dump frequence > 0
- my @devs = get_candidates();
-
- ### %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." if system("command -v dump >/dev/null");
- die "$ME: pre-flight check failed:\n\t",
- join("\n\t" => @errors), "\n" if @errors;
-
- my $ftp;
-
- if (not "output" ~~ \@opt_debug) {
- $ftp = new FTP(
- $cf{FTP_HOST},
- Passive => $cf{FTP_PASSIVE},
- Debug => "ftp" ~~ \@opt_debug,
- ) 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});
- }
-
- # get_history the situation - we rely on $opt_dumpdates
- @devs = get_history(@devs);
- @devs = calculate_level($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 "\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}";
- }
-
-
- exit;
- }
-
- # and now we can start doing something with our filesystems
- DEVICE: foreach my $dev (@devs) {
- 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);
-
- #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+)$/ or next;
- $last[$+{level}] = $+{date};
- last if $+{level} == 0;
- }
- }
-
- # 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("%FT%R.$dev->{level}", localtime $NOW);
- my $label = basename($dev->{rdev});
- verbose "> $dev->{dev} ($dev->{rdev}\@$dev->{mountpoint}) to @{[$ftp->pwd]}/$file\n";
- next if $opt_dry;
-
- # 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: check the snapshot name is not used already
- my $snap = "$dev->{lvm}{path}-snap.0";
-
- 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*$/;
-
- 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";
- }
-
- ($dev->{dump}) = $device;
-
- }
- else {
- $dev->{dump} = $dev->{rdev};
- }
-
- ### $dev
-
- $ENV{key} = $cf{KEY};
- my $dumper = open(my $dump, "-|") or do {
- print <<__HEAD;
-#! /bin/bash
-LC_ALL=C
-if test -t 1; then
- cat <<___
-HOSTNAME : $HOSTNAME
-DATE : $NOW @{[scalar localtime $NOW]}
-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
-# lines:
-# sh <THIS SCRIPT> | restore -rf -
-# sh <(ftpipe <URL>) -pass file:/dev/tty | restore -rf -
-___
- exit 0
-fi
-while read; do
- test "\$REPLY" = "### START" \\
- && exec openssl enc -d -blowfish "\$@"
-done <"\$0"
-
-### START
-__HEAD
-
-
- 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";
- };
-
- 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";
-
- update_devnames($opt_dumpdates, $dev->{dump} => $dev->{rdev})
- if $opt_dumpdates;
- }
-
-}
-
-sub verbose(@) {
- return if not $opt_verbose;
- print STDERR @_;
-}
-
-sub get_candidates() {
-
- # return the list of backup candidates
-
- my @devs;
-
- # later we need the major of the device mapper
- 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")) {
- my ($dev, $mp, $fstype, $options, $dump, $check) = split;
- next if not $dump;
-
- # $dev does not have to contain the real device
- my $rdev = real_device($dev);
- my ($major, $minor) = devno($rdev);
-
- # 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 @devs,
- {
- dev => $dev,
- rdev => $rdev,
- mountpoint => $mp,
- fstype => $fstype,
- lvm => $lvm,
- devno => "$major:$minor",
- };
- }
-
- return @devs;
-}
-
-sub get_configs(@) {
- local $_;
- my %r = ();
- 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;
-
- # FIXME: should check the containing directories too!
- };
-
- 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);
- }
- return %r;
-}
-
-{
-
- 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 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($_);
- }
- $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 get_home { return $data{ ref shift }{home} }
-}
-
-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($) {
- stat shift or return wantarray ? () : undef;
- my @mm = ((stat _)[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 get_history(@) {
- 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 get_estimate($$) {
- my ($dev, $level) = @_;
- warn "% estimating $dev->{rdev} at level $level\n";
- chomp(my $_ = `dump -S -$level $dev->{rdev}`);
- return $_;
-}
-
-sub calculate_level($@) {
- 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 }
-
- # 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};
- }
- }
-
- 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
-
-ftbackup - ftp backup tool
-
-=head1 SYNOPSIS
-
- ftbackup [--level <level>] [options]
-
-=head1 DESCRIPTION
-
-The B<ftbackup> tools saves the partitions (file systems) marked in
-F</etc/fstab> to an FTP host. It uses dump(8) for generating the backup
-and openssl(1) for encrypting the data stream (and thus the written
-files).
-
-=head1 OPTIONS
-
-=over
-
-=item B<-D>|B<--dumpdates> I<file>
-
-Update the I<file> as dumpdates file. (default: /var/lib/dumpdates)
-
-=item B<-d>|B<--debug> [I<item>]
-
-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>, B<devices> and currently nothing else.
-
-=over
-
-=item B<ftp>
-
-This switches on debugging of the used L<Net::FTP> module.
-
-=item B<output>
-
-The output is not sent via FTP but to stdout. Beware!
-
-=back
-
-Even more debugging is shown using the DEBUG=1 environment setting.
-
-=item B<--clean> [I<days>]
-
-Cleanup older backups we do not need (that is: incremental backups with
-no previous full backup. If I<days> are given, then all full backups older than
-the number of I<days> are removed (and all incremental backups based on these
-full backups). (default: 0 and not implemented)
-
-=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 and not implemented)
-
-=item B<-i>|B<--info>
-
-Just output information about the last backups and exit. (default: off)
-
-=item B<-l>|B<--level> I<level>
-
-The backup level. Level other than "0" needs a previous
-level 0 (full) backup. If not specified, it is choosen automagically.
-(default: undef)
-
-=item B<-L>|B<--label> I<label>
-
-The label for the backup. (default: daily)
-
-=item B<-v>|B<--verbose>
-
-Be verbose. (default: no)
-
-=back
-
-=head1 FILES
-
-=head2 Configuration
-
-The config files are searched in the following places:
-
- /etc/ftbackup.conf
- ~/.ftbackup.conf
- ./ftbackup.conf
-
-If the location is a directory, all (not hidden) files in this directory are
-considered to be config, if the location a file itself, this is considered to
-be a config file. The config files have to be mode 0600 and they have to be
-owned by the EUID running the process.
-
-The config file may contain the following items (listed with their built in defaults)
-
- KEY = <no default>
- FTP_HOST = <no default>
- FTP_DIR = "backup/<LABEL>/<HOSTNAME>"
- FTP_PASSIVE = 1
- FULL_CYCLE = 7
- COMPRESSION_LEVEL = 6
-
-=head2 F<.netrc>
-
-You may miss the login information for the FTP server. Currently we rely on a valid
-F<~/.netrc> entry. An example line of the F<~/.netrc>:
-
- machine ... login ... password ...
-
-=cut
-
-# vim:sts=4 sw=4 aw ai sm: