|
1 #! /usr/bin/perl |
|
2 use strict; |
|
3 use warnings; |
|
4 |
|
5 use IO::File; |
|
6 use File::Basename; |
|
7 use Net::FTP; |
|
8 use Perl6::Slurp; |
|
9 use Getopt::Long; |
|
10 use Sys::Hostname; |
|
11 use Pod::Usage; |
|
12 use POSIX qw(strftime);; |
|
13 use if $ENV{DEBUG} => qw(Smart::Comments); |
|
14 |
|
15 $ENV{LC_ALL} = "C"; |
|
16 |
|
17 my $opt_level = 0; |
|
18 my $opt_today = strftime("%F", localtime); |
|
19 my @opt_debug = (); |
|
20 my $opt_verbose = 0; |
|
21 #my $opt_node = hostname; |
|
22 #my $opt_dir = "backups/$opt_node/daily"; |
|
23 |
|
24 # all configs are below |
|
25 my $CONFIG_DIR = "./py2.d"; |
|
26 my $NODE = hostname; |
|
27 |
|
28 sub get_configs($); |
|
29 sub get_candidates(); |
|
30 sub verbose(@); |
|
31 |
|
32 MAIN: { |
|
33 GetOptions( |
|
34 "l|level=i" => \$opt_level, |
|
35 "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] }, |
|
36 "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) }, |
|
37 "m|man" => sub { pod2usage(-exit => 0, -verbose => 3) }, |
|
38 "v|verbose" => \$opt_verbose, |
|
39 ) or pod2usage; |
|
40 |
|
41 my %cf = get_configs($CONFIG_DIR); |
|
42 my %default = %{$cf{DEFAULT}}; |
|
43 ### config: %cf |
|
44 |
|
45 my %dev = get_candidates(); |
|
46 ### current devices: %dev |
|
47 |
|
48 my $ftp = new FTP($default{FTP_HOST}, |
|
49 Passive => $default{FTP_PASSIVE}, |
|
50 Debug => @opt_debug ~~ /^ftp$/) or die $@; |
|
51 $ftp->login or die $ftp->message; |
|
52 $ftp->try(mkpath => $default{FTP_DIR}); |
|
53 $ftp->try(cwd => $default{FTP_DIR}); |
|
54 |
|
55 if ($opt_level == 0) { |
|
56 $ftp->try(mkpath => $opt_today); |
|
57 $ftp->try(cwd => $opt_today); |
|
58 } |
|
59 else { |
|
60 # find the last full backup |
|
61 my $last_full = (reverse sort grep /^\d{4}-\d{2}-\d{2}$/, $ftp->ls)[0]; |
|
62 die "no last full backup found in @{[$ftp->pwd]}\n" |
|
63 if not $last_full; |
|
64 $ftp->try(cwd => $last_full); |
|
65 } |
|
66 |
|
67 # now sitting inside the directory for the last full backup |
|
68 verbose "Now in @{[$ftp->pwd]}.\n"; |
|
69 |
|
70 # and now we can start doing something with our filesystems |
|
71 foreach my $dev (keys %dev) { |
|
72 my $file = basename($dev) . ".$level.gz.ssl"; |
|
73 my $label = "$NODE:" . basename($dev{$dev}); |
|
74 verbose "Working on $dev as $dev{$dev}, stored as $file\n"; |
|
75 $ENV{key} = $default{KEY}; |
|
76 my $dumper = open(my $dump, "-|") or do { |
|
77 my $head = <<__; |
|
78 #! /bin/bash |
|
79 echo "LEVEL $opt_level: $dev $dev{$dev}" |
|
80 read -p "sure to restore? (yes/no): " |
|
81 test "\$REPLY" = "yes" || exit |
|
82 exec dd if=\$0 bs=10k skip=1 | openssl enc -d -blowfish "\$@" | gzip -d | restore -rf- |
|
83 exit |
|
84 __ |
|
85 print $head, " " x (10240 - length($head) - 1), "\n"; |
|
86 exec "dump -$opt_level -L $label -f- -u $dev{$dev}" |
|
87 . "| gzip" |
|
88 . "| openssl enc -pass env:key -salt -blowfish"; |
|
89 die "Can't exec dumper\n"; |
|
90 }; |
|
91 $ftp->try(put => $dump, $file); |
|
92 verbose "Done.\n"; |
|
93 } |
|
94 |
|
95 } |
|
96 |
|
97 sub verbose(@) { |
|
98 return if not $opt_verbose; |
|
99 print @_; |
|
100 } |
|
101 |
|
102 sub get_candidates() { |
|
103 # return the list of backup candidates |
|
104 |
|
105 my %dev; |
|
106 |
|
107 foreach (slurp("/etc/fstab")) { |
|
108 my ($dev, $mp, $fstype, $options, $dump, $check) |
|
109 = split; |
|
110 next if not $dump; |
|
111 |
|
112 # $dev does not have to contain the real device |
|
113 my $rdev = $dev; |
|
114 if ($dev ~~ /^(LABEL|UUID)=/) { |
|
115 chomp($rdev = `blkid -c /dev/null -o device -t '$dev'`); |
|
116 } |
|
117 $dev{$dev} = $rdev; |
|
118 } |
|
119 |
|
120 return %dev; |
|
121 } |
|
122 |
|
123 sub get_configs($) { |
|
124 local $_; |
|
125 my %r; |
|
126 foreach (glob("$_[0]/*")) { |
|
127 my $f = new IO::File $_ or die "Can't open $_: $!\n"; |
|
128 my %h = map { split /\s*=\s*/, $_, 2 } grep {!/^\s*#/} <$f>; |
|
129 map { chomp } values %h; |
|
130 if (basename($_) eq "DEFAULT") { |
|
131 $r{DEFAULT} = \%h; |
|
132 next; |
|
133 } |
|
134 if (exists $h{DEV}) { |
|
135 $r{$h{DEV}} = \%h; |
|
136 next; |
|
137 } |
|
138 |
|
139 if (exists $h{MOUNT}) { |
|
140 $r{$h{MOUNT}} = \%h; |
|
141 next; |
|
142 } |
|
143 } |
|
144 return %r; |
|
145 } |
|
146 |
|
147 { package FTP; |
|
148 use strict; |
|
149 use warnings; |
|
150 use base qw(Net::FTP); |
|
151 |
|
152 sub new { |
|
153 my $class = shift; |
|
154 return bless Net::FTP->new(@_) => $class; |
|
155 } |
|
156 |
|
157 sub try { |
|
158 my $self = shift; |
|
159 my $func = shift; |
|
160 $self->$func(@_) |
|
161 or die "FTP $func failed: " . $self->message . "\n"; |
|
162 } |
|
163 |
|
164 sub mkpath { |
|
165 my $self = shift; |
|
166 my $current = $self->pwd(); |
|
167 foreach (split /\/+/, $_[0]) { |
|
168 next if $self->cwd($_); |
|
169 return undef if not $self->message ~~ /no such .*dir/i; |
|
170 return undef if not $self->SUPER::mkdir($_); |
|
171 return undef if not $self->cwd($_); |
|
172 } |
|
173 $self->cwd($current); |
|
174 } |
|
175 } |
|
176 |
|
177 __END__ |
|
178 |
|
179 =head1 NAME |
|
180 |
|
181 py2b - backup tool |
|
182 |
|
183 =head1 SYNOPSIS |
|
184 |
|
185 py2b [--level <level>] [options] |
|
186 |
|
187 =head1 OPTIONS |
|
188 |
|
189 =over |
|
190 |
|
191 =item B<-d>|B<--debug> [I<item>] |
|
192 |
|
193 Enables debugging for the specified items (comma separated). |
|
194 If no item is specified, just some debugging is done. |
|
195 |
|
196 Valid items are B<ftp> and currently nothing else. |
|
197 |
|
198 Even more debugging is shown using the DEBUG=1 environment setting. |
|
199 |
|
200 =item B<-l>|B<--level> I<level> |
|
201 |
|
202 The backup level. Level other than "0" needs a previous |
|
203 level 0 (full) backup. (default: 0) |
|
204 |
|
205 =item B<-v>|B<--verbose> |
|
206 |
|
207 Be verbose. (default: no) |
|
208 |
|
209 =back |
|
210 |
|
211 =head1 FILES |
|
212 |
|
213 The B<config> file should be mentioned. |
|
214 |
|
215 =cut |
|
216 |
|
217 # vim:sts=4 sw=4 aw ai sm: |