1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 

     7 use File::Basename;

     8 use Net::FTP;

     9 use Perl6::Slurp;

    10 use Getopt::Long;

    11 use Sys::Hostname;

    12 use Pod::Usage;

    13 use POSIX qw(strftime);

    14 use Date::Parse qw(str2time);

    15 use Cwd qw(realpath);

    16 use English qw(-no_match_vars);

    17 use if $ENV{DEBUG} => qw(Smart::Comments);

    18 

    19 $ENV{LC_ALL} = "C";

    20 

    21 my $ME = basename $0;

    22 my $VERSION = '<VERSION>';

    23 

    24 my @CONFIGS = ("/etc/$ME.conf", "$ENV{HOME}/.$ME.conf", "$ME.conf");

    25 

    26 my $HOSTNAME = hostname;

    27 my $NOW  = time();

    28 

    29 my $opt_level   = undef;

    30 my $opt_today   = strftime("%F", localtime $NOW);

    31 my @opt_debug   = ();

    32 my $opt_verbose = 0;

    33 my $opt_dry     = 0;

    34 my $opt_force   = 0;

    35 my $opt_label   = "daily";

    36 my $opt_info    = 0;

    37 my $opt_config  = "";

    38 my $opt_dumpdates = "/var/lib/dumpdates";

    39 

    40 sub get_configs(@);

    41 sub get_candidates();

    42 sub verbose(@);

    43 sub update_devnames($$$);

    44 sub get_history(@);

    45 sub calculate_level($@);

    46 sub real_device($);

    47 sub get_estimate($$);

    48 sub devno($);

    49 

    50 our @AT_EXIT;

    51 END { $_->() foreach @AT_EXIT }

    52 $SIG{INT} = sub { warn "Got signal INT\n"; exit 1 };

    53 

    54 my %CONFIG = (

    55     FTP_DIR     => "backup/<LABEL>/<HOSTNAME>",

    56     FTP_PASSIVE => 1,

    57     FULL_CYCLE  => 7,

    58     COMPRESSION_LEVEL => 6,

    59 );

    60 

    61 

    62 MAIN: {

    63 

    64     Getopt::Long::Configure("bundling");

    65     GetOptions(

    66         "l|level=i" => \$opt_level,

    67         "L|label=s" => \$opt_label,

    68         "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] },

    69         "v|verbose" => \$opt_verbose,

    70 	"i|info"    => \$opt_info,

    71         "dry"       => sub { $opt_dry = 1; $opt_verbose = 1 },

    72         #"f|force"   => \$opt_force,

    73         "h|help"    => sub { pod2usage(-exit => 0, -verbose => 1) },

    74         "m|man"     => sub { pod2usage(-exit => 0, -verbose => 3) },

    75         "C|config=s" => sub { @CONFIGS = ($_[1]) },

    76 	"V|version" => sub { print "$ME: $VERSION\n"; exit 0 },

    77 	"D|dumpdates=s" => \$opt_dumpdates,

    78     ) or pod2usage;

    79 

    80     my %cf = (%CONFIG, get_configs(@CONFIGS));

    81     $cf{FTP_DIR} =~ s/<HOSTNAME>/$HOSTNAME/g;

    82     $cf{FTP_DIR} =~ s/<LABEL>/$opt_label/g;

    83 

    84     # get the backup candiates -> all file systems from /etc/fstab

    85     # with a dump frequence > 0

    86     my @devs = get_candidates();

    87 

    88     ### %cf

    89     ### @devs

    90 

    91 

    92     verbose +(map { "candidate: $_->{dev} as $_->{rdev}\n" } @devs), "\n";

    93 

    94     my @errors = ();

    95     push @errors, "Need FTP_HOST (see config)." if not defined $cf{FTP_HOST};

    96     push @errors, "Need KEY (see config)."      if not defined $cf{KEY};

    97     push @errors, "Command `dump' not found."   if system("command -v dump >/dev/null");

    98     die "$ME: pre-flight check failed:\n\t", 

    99 	join("\n\t" => @errors), "\n" if @errors;

   100 

   101     my $ftp;

   102 

   103     if (not "output" ~~ \@opt_debug) {

   104         $ftp = new FTP(

   105             $cf{FTP_HOST},

   106             Passive => $cf{FTP_PASSIVE},

   107             Debug   => "ftp" ~~ \@opt_debug,

   108         ) or die $@;

   109         $ftp->login or die $ftp->message;

   110         $ftp->home($ftp->try(pwd => ()));

   111         $ftp->try(binary => ());

   112         $ftp->try(mkpath => $cf{FTP_DIR});

   113         $ftp->try(cwd    => $cf{FTP_DIR});

   114     }

   115 

   116     # get_history the situation - we rely on $opt_dumpdates

   117     @devs = get_history(@devs);

   118     @devs = calculate_level($cf{FULL_CYCLE}, @devs);

   119 

   120     ### @devs

   121 

   122     if ($opt_info) {

   123 	my $lr = (reverse sort { $a <=> $b } map { length $_->{rdev} } @devs)[0];

   124 	my $ld = (reverse sort { $a <=> $b } map { length $_->{dev} } @devs)[0];

   125 	my $ln = (reverse sort { $a <=> $b } map { length $_->{devno} } @devs)[0];

   126 

   127 	my %l;

   128 	foreach my $dev (@devs) {

   129 	    $l{$dev} = sprintf "%*s (%*s %*s)", -$ld => $dev->{dev},

   130 				       -$lr => $dev->{rdev},

   131 				       -$ln => $dev->{devno};

   132 	}

   133 

   134 	say "\ncurrent situation\n",

   135 	      "------------------";

   136 	foreach my $dev (@devs) {

   137 	    if (!$dev->{last}) { say "$l{$dev}: never" } 

   138 	    else {

   139 		for (my $i = 0; $i < @{$dev->{last}}; $i++) {

   140 		    say "$l{$dev}: $i ", defined($dev->{last}[$i]) ? scalar localtime($dev->{last}[$i]) : "-";

   141 		}

   142 	    }

   143 	}

   144 

   145 	say "\nplan for next dump\n", 

   146 	      "------------------";

   147 	foreach my $dev (@devs) {

   148 	    say "$l{$dev}: level $dev->{level}";

   149 	}

   150 

   151 

   152 	exit;

   153     }

   154 

   155     # and now we can start doing something with our filesystems

   156   DEVICE: foreach my $dev (@devs) {

   157         my $dir = $dev->{mountpoint};

   158         $dir =~ s/_/__/g;

   159         $dir =~ s/\//_/g;

   160         $dir = "$cf{FTP_DIR}/$dir";

   161 

   162         my @last;

   163         if ($ftp) {

   164             $ftp->home();

   165             $ftp->try(mkpath => $dir);

   166             $ftp->try(cwd    => $dir);

   167 

   168             #verbose "Now in @{[$ftp->pwd]}.\n" if $ftp;

   169 

   170             # examine the situation and decide about the level

   171             # FIXME: currently we simply run a full dump every FULL_CYCLE

   172             # days, the intermediate dumps are level 1

   173             foreach (reverse sort $ftp->ls) {

   174                 /^(?<date>.*)\.(?<level>\d+)$/ or next;

   175                 $last[$+{level}] = $+{date};

   176                 last if $+{level} == 0;

   177             }

   178         }

   179 

   180 	# for safety we check if there is really a full dump not older than xxx days

   181         if ($dev->{level} > 0) {

   182 	    if (!@last) {

   183 		$dev->{level} = 0;

   184 		warn "adjusted backup level to 0, last full backup missing\n";

   185 	    } elsif ($NOW - str2time($last[0]) > ($cf{FULL_CYCLE} * 86_400)) {

   186 		$dev->{level} = 0;

   187 		warn sprintf "adjusted backup level to 0, last full backup is %.1f days old\n",

   188 		    ($NOW - str2time $last[0])/86_400;

   189 	    }

   190         }

   191 

   192         my $file = strftime("%FT%R.$dev->{level}", localtime $NOW);

   193         my $label = basename($dev->{rdev});

   194         verbose "> $dev->{dev} ($dev->{rdev}\@$dev->{mountpoint}) to @{[$ftp->pwd]}/$file\n";

   195         next if $opt_dry;

   196 

   197         # For LVM do a snapshot, for regular partitions

   198         # do nothing. But anyway the device to dump is named in $dev->{dump}

   199         if ($dev->{lvm}) {

   200 

   201             # we can do a snapshot

   202             # FIXME: check the snapshot name is not used already

   203             my $snap = "$dev->{lvm}{path}-snap.0";

   204 

   205             verbose "Creating snapshot $snap\n";

   206             system($_ =

   207                   "lvcreate -s -L 1G -n $snap $dev->{lvm}{path} >/dev/null");

   208             die "failed system command: $_\n" if $?;

   209 

   210             $dev->{cleanup} = sub {

   211                 system "lvdisplay $snap &>/dev/null"

   212                   . " && lvremove -f $snap >/dev/null";

   213             };

   214             push @AT_EXIT, $dev->{cleanup};

   215 

   216             (my $device) =

   217               (grep /lv name/i, `lvdisplay $snap`)[0] =~ /(\S+)\s*$/;

   218 

   219             for (my $retries = 3 ; $retries ; $retries--) {

   220                 system($_ =

   221                       "fsck -f @{[$opt_verbose ? '-C0' : '']} -y $device");

   222                 last if not $?;

   223                 warn "fsck on $device (using: $_) failed"

   224                   . ($retries > 1 ? ", retrying…\n" : "") . "\n";

   225             }

   226 

   227             ($dev->{dump}) = $device;

   228 

   229         }

   230         else {

   231             $dev->{dump} = $dev->{rdev};

   232         }

   233 

   234         ### $dev

   235 

   236         $ENV{key} = $cf{KEY};

   237         my $dumper = open(my $dump, "-|") or do {

   238             print <<__HEAD;

   239 #! /bin/bash

   240 LC_ALL=C

   241 if test -t 1; then

   242     cat <<___

   243 HOSTNAME   : $HOSTNAME

   244 DATE       : $NOW @{[scalar localtime $NOW]}

   245 LEVEL      : $dev->{level}

   246 DEVICE     : $dev->{dev}

   247 REAL_DEVICE: $dev->{rdev}

   248 MOUNTPOINT : $dev->{mountpoint}

   249 FSTYPE     : $dev->{fstype}

   250 DEVICE_NO  : $dev->{devno}

   251 

   252 # For recovery pass everything following the first

   253 # ^### START to "recover -rf -". Or do one of the following

   254 # lines:

   255 #   sh <THIS SCRIPT> | restore -rf -

   256 #   sh <(ftpipe <URL>) -pass file:/dev/tty | restore -rf -

   257 ___

   258     exit 0

   259 fi

   260 while read; do

   261     test "\$REPLY" = "### START" \\

   262 	&& exec openssl enc -d -blowfish "\$@"

   263 done <"\$0"

   264 

   265 ### START

   266 __HEAD

   267 

   268 

   269 	    update_devnames($opt_dumpdates, $dev->{rdev} => $dev->{dump})

   270 		    if $opt_dumpdates;

   271 

   272             exec "dump -$dev->{level} -L $label -f- -u -z$cf{COMPRESSION_LEVEL} $dev->{dump}"

   273               . "| openssl enc -pass env:key -salt -blowfish";

   274             die "Can't exec dumper\n";

   275         };

   276 

   277         if ($ftp) {

   278             $ftp->try(put => $dump, $file);

   279         }

   280         else {

   281             print while <$dump>;

   282             warn "STOPPED after the first dump\n";

   283             exit;

   284         }

   285         $dev->{cleanup}->() if $dev->{cleanup};

   286         verbose "Done.\n";

   287 

   288 	update_devnames($opt_dumpdates, $dev->{dump} => $dev->{rdev})

   289 		if $opt_dumpdates;

   290     }

   291 

   292 }

   293 

   294 sub verbose(@) {

   295     return if not $opt_verbose;

   296     print STDERR @_;

   297 }

   298 

   299 sub get_candidates() {

   300 

   301     # return the list of backup candidates

   302 

   303     my @devs;

   304 

   305     # later we need the major of the device mapper

   306     my $dev_mapper = (grep /device.mapper/, slurp("/proc/devices"))[0];

   307     $dev_mapper = (split " " => $dev_mapper)[0] if defined $dev_mapper;

   308 

   309     # find all non comment lines

   310     foreach (grep !/^\s*#/, slurp("/etc/fstab")) {

   311         my ($dev, $mp, $fstype, $options, $dump, $check) = split;

   312         next if not $dump;

   313 

   314         # $dev does not have to contain the real device

   315         my $rdev = real_device($dev);

   316 	my ($major, $minor) = devno($rdev);

   317 

   318         # if it's LVM we gather more information (to support snapshots)

   319         my $lvm;

   320         if ($_ = (grep { /:$major:$minor\s*$/ } `lvdisplay -c`)[0]

   321             and /\s*(?<path>\S+?):/)

   322         {

   323             ($lvm->{path} = $+{path}) =~ s/^\/dev\///;

   324         }

   325 

   326         push @devs,

   327           {

   328             dev        => $dev,

   329             rdev       => $rdev,

   330             mountpoint => $mp,

   331             fstype     => $fstype,

   332             lvm        => $lvm,

   333             devno      => "$major:$minor",

   334           };

   335     }

   336 

   337     return @devs;

   338 }

   339 

   340 sub get_configs(@) {

   341     local $_;

   342     my %r = ();

   343     foreach (grep { -f } map { (-d) ? glob("$_/*") : $_ } @_) {

   344 

   345         # check permission and ownership

   346         {

   347             my $p = (stat)[2] & 07777;

   348             my $u = (stat _)[4];

   349             die

   350 "$ME: $_ has wrong permissions: found @{[sprintf '%04o', $p]}, need 0600\n"

   351               if $p != 0600;

   352             die

   353               "$ME: owner of $_ ($u) is not the EUID ($EUID) of this process\n"

   354               if (stat _)[4] != $EUID;

   355 

   356             # FIXME: should check the containing directories too!

   357         };

   358 

   359 	open(my $f, $_) or die "Can't open $_: $!\n";

   360         my %h = map { split /\s*=\s*/, $_, 2 } grep { !/^\s*#/ and /=/ } <$f>;

   361         map { chomp } values %h;

   362         %r = (%r, %h);

   363     }

   364     return %r;

   365 }

   366 

   367 {

   368 

   369     package FTP;

   370     use strict;

   371     use warnings;

   372     use base qw(Net::FTP);

   373 

   374     my %data;

   375 

   376     sub new {

   377         my $class = shift;

   378         return bless Net::FTP->new(@_) => $class;

   379     }

   380 

   381     sub try {

   382         my $self = shift;

   383         my $func = shift;

   384         $self->$func(@_)

   385           or die "FTP $func failed: " . $self->message . "\n";

   386     }

   387 

   388     sub mkpath {

   389         my $self    = shift;

   390         my $current = $self->pwd();

   391         foreach (split /\/+/, $_[0]) {

   392             next if $self->cwd($_);

   393             return undef if not $self->message ~~ /no such .*dir/i;

   394             return undef if not $self->SUPER::mkdir($_);

   395             return undef if not $self->cwd($_);

   396         }

   397         $self->cwd($current);

   398     }

   399 

   400     sub home {

   401         my $self = shift;

   402         return $data{ ref $self }{home} = shift if @_;

   403         $self->try(cwd => exists $data{ ref $self }{home}

   404             ? $data{ ref $self }{home}

   405             : "/");

   406         return $self->pwd();

   407     }

   408 

   409     sub get_home { return $data{ ref shift }{home} }

   410 }

   411 

   412 sub update_devnames($$$) {

   413 	my ($file, $from, $to) = @_;

   414 	open(my $f, "+>>", $file) or die "Can't open $file: $!\n";

   415 	seek($f, 0, 0);

   416 	my $_ = join "", <$f>;

   417 	s/^$from\s/$to /mg;

   418 	truncate($f, 0);

   419 	# fix the dumpdates

   420 	print $f $_;		

   421 	close($f);

   422 }

   423 

   424 sub real_device($) {

   425     my $dev = shift;

   426 

   427     if ($dev ~~ /^(LABEL|UUID)=/) {

   428 	# NOTE: dump is able to handle LABEL=... too, but I think

   429 	# it's more easy for recovery to know the real device

   430 	chomp($dev = `blkid -c /dev/null -o device -t '$dev'`);

   431     }

   432     $dev = realpath($dev);

   433 }

   434 

   435 sub devno($) {

   436     my @mm = ((stat shift)[6] >> 8, (stat _)[6] & 0xff);

   437     return wantarray ? @mm : "$mm[0]:$mm[1]";

   438 }

   439 

   440 

   441 # put the last dump information (level and date) into

   442 # the device structure - information is obtained from $opt_dumpdates

   443 sub get_history(@) {

   444     my @devs = @_;

   445     my %dd;

   446 

   447     open(my $dd, "+>>", $opt_dumpdates);

   448     seek($dd, 0, 0);

   449     while (<$dd>) {

   450 	my ($dev, $level, $date) = /^(\S+)\s+(\d+)\s+(.{30})/

   451 	    or die "Can't parse $opt_dumpdates: `$_'\n";

   452 	my $rdev = real_device($dev);

   453 	my $devno = devno($rdev);

   454 

   455 	push @{$dd{$rdev}} => {

   456 	    dev => $dev,

   457 	    rdev => real_device($dev),

   458 	    level => $level,

   459 	    date => str2time($date),

   460 	    devno => scalar(devno(real_device($dev))),

   461 	}

   462     }

   463     close($dd);

   464 

   465     foreach my $dev (@devs) {

   466 	my $dd = $dd{$dev->{rdev}};

   467 

   468 	if (!$dd) {

   469 	    $dev->{last} = undef;

   470 	    next;

   471 	}

   472 

   473 	foreach my $dump (@$dd) {

   474 	    $dev->{last}[$dump->{level}] = $dump->{date};

   475 	}

   476     }

   477 

   478     ### @devs

   479     return @devs;

   480 }

   481 

   482 sub get_estimate($$) {

   483     my ($dev, $level) = @_;

   484     warn "% estimating $dev->{rdev} at level $level\n";

   485     chomp(my $_ = `dump -S -$level $dev->{rdev}`);

   486     return $_;

   487 }

   488 

   489 sub calculate_level($@) {

   490     my ($cycle, @devs) = @_;

   491 

   492     foreach my $dev (@devs) {

   493 	if (defined $opt_level) {

   494 	    $dev->{level} = $opt_level;

   495 	} 

   496 	elsif (!$dev->{last}

   497 	    or not $dev->{last}[0]

   498 	    or $NOW - $dev->{last}[0] > ($cycle * 86_400)) {

   499 	    $dev->{level} = 0;

   500 	} 

   501 	else { $dev->{level} = 1 }

   502 

   503 	# now we'll see if the level really saves space compared

   504 	# with the next lower level

   505 	my @estimates;

   506 	while (my $l = $dev->{level} > 0) {

   507 	    $estimates[$l] //= get_estimate($dev, $l);

   508 	    $estimates[$l - 1] //= get_estimate($dev, $l - 1);

   509 

   510 	    last if my $savings = ($estimates[$l-1] - $estimates[$l]) / $estimates[$l-1] >= 0.10;

   511 	    warn "% savings for level $dev->{level} on $dev->{dev} are @{[int($savings * 100)]}% ",

   512 		 "will use level ", $dev->{level} - 1, "\n";

   513 	    --$dev->{level};

   514 	}

   515     }

   516 

   517     return @devs;

   518 }

   519 

   520 #/dev/vda1 0 Thu Apr 14 12:54:31 2011 +0200

   521 #/dev/vda1 1 Thu Apr 14 12:54:16 2011 +0200

   522 

   523 __END__

   524 

   525 =head1 NAME

   526 

   527 ftbackup - ftp backup tool

   528 

   529 =head1 SYNOPSIS

   530 

   531     ftbackup [--level <level>] [options]

   532 

   533 =head1 DESCRIPTION

   534 

   535 The B<ftbackup> tools saves the partitions (file systems) marked in

   536 F</etc/fstab> to an FTP host. It uses dump(8) for generating the backup

   537 and openssl(1) for encrypting the data stream (and thus the written

   538 files).

   539 

   540 =head1 OPTIONS

   541 

   542 =over

   543 

   544 =item B<-D>|B<--dumpdates> I<file>

   545 

   546 Update the I<file> as dumpdates file. (default: /var/lib/dumpdates)

   547 

   548 =item B<-d>|B<--debug> [I<item>]

   549 

   550 Enables debugging for the specified items (comma separated).

   551 If no item is specified, just some debugging is done.

   552 

   553 Valid items are B<ftp>, B<output>, B<devices> and currently nothing else.

   554 

   555 =over

   556 

   557 =item B<ftp>

   558 

   559 This switches on debugging of the used L<Net::FTP> module.

   560 

   561 =item B<output>

   562 

   563 The output is not sent via FTP but to stdout. Beware!

   564 

   565 =back

   566 

   567 Even more debugging is shown using the DEBUG=1 environment setting.

   568 

   569 =item B<--clean> [I<days>]

   570 

   571 Cleanup older backups we do not need (that is: incremental backups with

   572 no previous full backup. If I<days> are given, then all full backups older than

   573 the number of I<days> are removed (and all incremental backups based on these

   574 full backups). (default: 0 and not implemented)

   575 

   576 =item B<--dry>

   577 

   578 Dry run, no real backup is done, this option implies B<--verbose>. (default: off)

   579 

   580 =item B<-f>|B<--force>

   581 

   582 Use more power (e.g. overwrite a previous level backup and remove all

   583 invalidated other backups). (default: 0 and not implemented)

   584 

   585 =item B<-i>|B<--info>

   586 

   587 Just output information about the last backups and exit. (default: off)

   588 

   589 =item B<-l>|B<--level> I<level>

   590 

   591 The backup level. Level other than "0" needs a previous

   592 level 0 (full) backup. If not specified, it is choosen automagically.

   593 (default: undef)

   594 

   595 =item B<-L>|B<--label> I<label>

   596 

   597 The label for the backup. (default: daily)

   598 

   599 =item B<-v>|B<--verbose>

   600 

   601 Be verbose. (default: no)

   602 

   603 =back

   604 

   605 =head1 FILES

   606 

   607 =head2 Configuration

   608 

   609 The config files are searched in the following places:

   610 

   611     /etc/ftbackup.conf

   612     ~/.ftbackup.conf

   613     ./ftbackup.conf

   614 

   615 If the location is a directory, all (not hidden) files in this directory are

   616 considered to be config, if the location a file itself, this is considered to

   617 be a config file. The config files have to be mode 0600 and they have to be 

   618 owned by the EUID running the process.

   619 

   620 The config file may contain the following items (listed with their built in defaults)

   621 

   622     KEY		= <no default>

   623     FTP_HOST	= <no default>

   624     FTP_DIR	= "backup/<LABEL>/<HOSTNAME>"

   625     FTP_PASSIVE = 1

   626     FULL_CYCLE	= 7

   627     COMPRESSION_LEVEL = 6

   628 

   629 =head2 F<.netrc>

   630 

   631 You may miss the login information for the FTP server. Currently we rely on a valid

   632 F<~/.netrc> entry. An example line of the F<~/.netrc>:

   633 

   634     machine ... login ... password ...

   635 

   636 =cut

   637 

   638 # vim:sts=4 sw=4 aw ai sm: