--- 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 <level>] [options]
-
-=head1 OPTIONS
-
-=over
-
-=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> 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<level>
-
-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: