# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1261523053 -3600
# Node ID e40e33b52d0bb07d75e606bf5ed09488f7d9ad5d
# Parent  31219f14734785809356bc882c2381b54f05f1a9
[perltidy]

diff -r 31219f147347 -r e40e33b52d0b .perltidyrc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.perltidyrc	Wed Dec 23 00:04:13 2009 +0100
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
diff -r 31219f147347 -r e40e33b52d0b ftbackup
--- 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($) {