diff -r c3c8a413c020 -r 1691a932eed1 py2b --- a/py2b Mon Oct 26 23:35:18 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,321 +0,0 @@ -#! /usr/bin/perl -use strict; -use warnings; - -use IO::File; -use File::Basename; -use Net::FTP; -use Perl6::Slurp; -use Getopt::Long; -use Sys::Hostname; -use Pod::Usage; -use POSIX qw(strftime);; -use English qw(-no_match_vars); -use 5.10.0; -use if $ENV{DEBUG} => qw(Smart::Comments); - -$ENV{LC_ALL} = "C"; - -my $ME = basename $0; - -my @CONFIGS = ("/etc/$ME", "$ENV{HOME}/.$ME", "$ME.conf"); - -my $NODE = hostname; -my $NOW = time(); - -my $opt_level = 0; -my $opt_today = strftime("%F", localtime $NOW); -my @opt_debug = (); -my $opt_verbose = 0; -my $opt_dry = 0; -my $opt_force = 0; - -sub get_configs(@); -sub get_candidates(); -sub verbose(@); - -our @AT_EXIT; -END { $_->() foreach @AT_EXIT }; -$SIG{INT} = sub { warn "Got signal INT\n"; exit 1 }; - -my %CONFIG = ( - FTP_DIR => "backup/daily/$NODE", - FTP_PASSIVE => 1, - FULL_CYCLE => 7, # not used -); - -MAIN: { - GetOptions( - "l|level=i" => \$opt_level, - "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] }, - "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) }, - "m|man" => sub { pod2usage(-exit => 0, -verbose => 3) }, - "v|verbose" => \$opt_verbose, - "dry" => \$opt_dry, - "f|force" => \$opt_force, - ) or pod2usage; - - my %cf = (%CONFIG, get_configs(@CONFIGS)); - my @dev = get_candidates(); - ### current candiates: @dev - - my $ftp = new FTP($cf{FTP_HOST}, - Passive => $cf{FTP_PASSIVE}, - Debug => @opt_debug ~~ /^ftp$/) or die $@; - $ftp->login or die $ftp->message; - $ftp->try(binary => ()); - $ftp->try(mkpath => $cf{FTP_DIR}); - $ftp->try(cwd => $cf{FTP_DIR}); - - given ($opt_level) { - when(0) { - $ftp->try(mkpath => $opt_today); - $ftp->try(cwd => $opt_today); - } - default { - # find the last full backup directory - my $last_full = (reverse sort grep /^\d{4}-\d{2}-\d{2}$/, $ftp->ls)[0]; - die "no last full backup found in @{[$ftp->pwd]}\n" - if not $last_full; - $ftp->try(cwd => $last_full); - } - } - - # now sitting inside the directory for the last full backup - verbose "Now in @{[$ftp->pwd]}.\n"; - - # and now we can start doing something with our filesystems - foreach my $dev (@dev) { - - my $file = basename($dev->{dev}) . "." - . strftime("%F_%R", localtime $NOW) - . ".$opt_level.ssl"; - my $label = "$NODE:" . basename($dev->{rdev}); - verbose "Working on $dev->{dev} as $dev->{rdev}, stored as $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 - 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 $?; - - $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*$/; - - system($_ = "fsck -f -C0 -y $device"); - warn "fsck on $device (using: $_) failed\n" if $?; - - ($dev->{dump}) = $device; - - } - else { - $dev->{dump} = $dev->{rdev} - } - - ### $dev - - $ENV{key} = $cf{KEY}; - my $dumper = open(my $dump, "-|") or do { - my $head = <<__; -#! /bin/bash -if test "\$1" = "--info"; then - cat <<___ -NODE : $NODE -DATE : $NOW @{[localtime $NOW]} -LEVEL : $opt_level -DEVICE : $dev->{dev} -REAL_DEVICE: $dev->{rdev} -MOUNTPOINT : $dev->{mountpoint} -FSTYPE : $dev->{fstype} -___ - exit 0 -fi -tail -c XXXXX \$0 | openssl enc -d -blowfish "\$@" -exit - -__ - # adjust the placeholder - $head =~ s/XXXXX/sprintf "% 5s", "+" . (length($head) +1)/e; - print $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"; - }; - - $ftp->try(put => $dump, $file); - $dev->{cleanup}->() if $dev->{cleanup}; - verbose "Done.\n"; - } - -} - -sub verbose(@) { - return if not $opt_verbose; - print @_; -} - -sub get_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]; - - foreach (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 = $dev; - if ($dev ~~ /^(LABEL|UUID)=/) { - chomp($rdev = `blkid -c /dev/null -o device -t '$dev'`); - } - $rdev = readlink $rdev while -l $rdev; - - # if it's LVM we gather more information (to support snapshots) - # FIXME: could have used `lvdisplay -c' - my $lvm; - if ((stat $rdev)[6] >> 8 == $dev_mapper) { - @{$lvm}{qw/vg lv/} = map { s/--/-/g; $_ } basename($rdev) =~ /(.+[^-])-([^-].+)/; - $lvm->{path} = "$lvm->{vg}/$lvm->{lv}"; - } - - push @dev, { - dev => $dev, - rdev => $rdev, - mountpoint => $mp, - fstype => $fstype, - lvm => $lvm, - }; - } - - return @dev; -} - -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! - }; - - 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); - - 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); - } -} - -__END__ - -=head1 NAME - -py2b - backup tool - -=head1 SYNOPSIS - - py2b [--level ] [options] - -=head1 OPTIONS - -=over - -=item B<-d>|B<--debug> [I] - -Enables debugging for the specified items (comma separated). -If no item is specified, just some debugging is done. - -Valid items are B and currently nothing else. - -Even more debugging is shown using the DEBUG=1 environment setting. - -=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<-l>|B<--level> I - -The backup level. Level other than "0" needs a previous -level 0 (full) backup. (default: 0) - -=item B<-v>|B<--verbose> - -Be verbose. (default: no) - -=back - -=head1 FILES - -The config files are searched in the following places: - - /etc/py2b - ~/.py2b - ./py2b.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. - -=cut - -# vim:sts=4 sw=4 aw ai sm: