8 use Perl6::Slurp; |
8 use Perl6::Slurp; |
9 use Getopt::Long; |
9 use Getopt::Long; |
10 use Sys::Hostname; |
10 use Sys::Hostname; |
11 use Pod::Usage; |
11 use Pod::Usage; |
12 use POSIX qw(strftime);; |
12 use POSIX qw(strftime);; |
|
13 use English qw(-no_match_vars); |
|
14 use 5.10.0; |
13 use if $ENV{DEBUG} => qw(Smart::Comments); |
15 use if $ENV{DEBUG} => qw(Smart::Comments); |
14 |
16 |
15 $ENV{LC_ALL} = "C"; |
17 $ENV{LC_ALL} = "C"; |
16 |
18 |
|
19 my $ME = basename $0; |
|
20 |
|
21 my @CONFIGS = ("/etc/$ME", "$ENV{HOME}/.$ME", "$ME.conf"); |
|
22 |
|
23 my $NODE = hostname; |
|
24 my $NOW = time(); |
|
25 |
17 my $opt_level = 0; |
26 my $opt_level = 0; |
18 my $opt_today = strftime("%F", localtime); |
27 my $opt_today = strftime("%F", localtime $NOW); |
19 my @opt_debug = (); |
28 my @opt_debug = (); |
20 my $opt_verbose = 0; |
29 my $opt_verbose = 0; |
21 my $opt_dry = 0; |
30 my $opt_dry = 0; |
22 #my $opt_node = hostname; |
31 my $opt_force = 0; |
23 #my $opt_dir = "backups/$opt_node/daily"; |
32 |
24 |
33 sub get_configs(@); |
25 # all configs are below |
|
26 my $CONFIG_DIR = "./py2.d"; |
|
27 my $NODE = hostname; |
|
28 |
|
29 sub get_configs($); |
|
30 sub get_candidates(); |
34 sub get_candidates(); |
31 sub verbose(@); |
35 sub verbose(@); |
32 |
36 |
33 our @AT_EXIT; |
37 our @AT_EXIT; |
34 END { $_->() foreach @AT_EXIT }; |
38 END { $_->() foreach @AT_EXIT }; |
35 $SIG{INT} = sub { warn "Got signal INT\n"; exit 1 }; |
39 $SIG{INT} = sub { warn "Got signal INT\n"; exit 1 }; |
|
40 |
|
41 my %CONFIG = ( |
|
42 FTP_DIR => "backup/daily/$NODE", |
|
43 FTP_PASSIVE => 1, |
|
44 FULL_CYCLE => 7, # not used |
|
45 ); |
36 |
46 |
37 MAIN: { |
47 MAIN: { |
38 GetOptions( |
48 GetOptions( |
39 "l|level=i" => \$opt_level, |
49 "l|level=i" => \$opt_level, |
40 "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] }, |
50 "d|debug:s" => sub { push @opt_debug, split /,/, $_[1] }, |
41 "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) }, |
51 "h|help" => sub { pod2usage(-exit => 0, -verbose => 1) }, |
42 "m|man" => sub { pod2usage(-exit => 0, -verbose => 3) }, |
52 "m|man" => sub { pod2usage(-exit => 0, -verbose => 3) }, |
43 "v|verbose" => \$opt_verbose, |
53 "v|verbose" => \$opt_verbose, |
44 "dry" => \$opt_dry, |
54 "dry" => \$opt_dry, |
|
55 "f|force" => \$opt_force, |
45 ) or pod2usage; |
56 ) or pod2usage; |
46 |
57 |
47 my %cf = get_configs($CONFIG_DIR); |
58 my %cf = (%CONFIG, get_configs(@CONFIGS)); |
48 my %default = %{$cf{DEFAULT}}; |
|
49 ### config: %cf |
|
50 |
|
51 my @dev = get_candidates(); |
59 my @dev = get_candidates(); |
52 ### current candiates: @dev |
60 ### current candiates: @dev |
53 |
61 |
54 my $ftp = new FTP($default{FTP_HOST}, |
62 my $ftp = new FTP($cf{FTP_HOST}, |
55 Passive => $default{FTP_PASSIVE}, |
63 Passive => $cf{FTP_PASSIVE}, |
56 Debug => @opt_debug ~~ /^ftp$/) or die $@; |
64 Debug => @opt_debug ~~ /^ftp$/) or die $@; |
57 $ftp->login or die $ftp->message; |
65 $ftp->login or die $ftp->message; |
58 $ftp->try(binary => ()); |
66 $ftp->try(binary => ()); |
59 $ftp->try(mkpath => $default{FTP_DIR}); |
67 $ftp->try(mkpath => $cf{FTP_DIR}); |
60 $ftp->try(cwd => $default{FTP_DIR}); |
68 $ftp->try(cwd => $cf{FTP_DIR}); |
61 |
69 |
62 if ($opt_level == 0) { |
70 given ($opt_level) { |
63 $ftp->try(mkpath => $opt_today); |
71 when(0) { |
64 $ftp->try(cwd => $opt_today); |
72 $ftp->try(mkpath => $opt_today); |
65 } |
73 $ftp->try(cwd => $opt_today); |
66 else { |
74 } |
67 # find the last full backup |
75 default { |
68 my $last_full = (reverse sort grep /^\d{4}-\d{2}-\d{2}$/, $ftp->ls)[0]; |
76 # find the last full backup directory |
69 die "no last full backup found in @{[$ftp->pwd]}\n" |
77 my $last_full = (reverse sort grep /^\d{4}-\d{2}-\d{2}$/, $ftp->ls)[0]; |
70 if not $last_full; |
78 die "no last full backup found in @{[$ftp->pwd]}\n" |
71 $ftp->try(cwd => $last_full); |
79 if not $last_full; |
|
80 $ftp->try(cwd => $last_full); |
|
81 } |
72 } |
82 } |
73 |
83 |
74 # now sitting inside the directory for the last full backup |
84 # now sitting inside the directory for the last full backup |
75 verbose "Now in @{[$ftp->pwd]}.\n"; |
85 verbose "Now in @{[$ftp->pwd]}.\n"; |
76 |
86 |
77 # and now we can start doing something with our filesystems |
87 # and now we can start doing something with our filesystems |
78 foreach my $dev (@dev) { |
88 foreach my $dev (@dev) { |
79 |
89 |
80 my $file = basename($dev->{dev}) . ".$opt_level.gz.ssl"; |
90 my $file = basename($dev->{dev}) . "." |
|
91 . strftime("%F_%R", localtime $NOW) |
|
92 . ".$opt_level.ssl"; |
81 my $label = "$NODE:" . basename($dev->{rdev}); |
93 my $label = "$NODE:" . basename($dev->{rdev}); |
82 verbose "Working on $dev->{dev} as $dev->{rdev}, stored as $file\n"; |
94 verbose "Working on $dev->{dev} as $dev->{rdev}, stored as $file\n"; |
|
95 next if $opt_dry; |
|
96 |
|
97 ## complain if there is already a full backup in this |
|
98 ## sequence |
|
99 ##die "level 0 dir should be empty\n" if @{$ftp->try(ls => "*.0.*")}; |
83 |
100 |
84 # For LVM do a snapshot, for regular partitions |
101 # For LVM do a snapshot, for regular partitions |
85 # do nothing. But anyway the device to dump is named in $dev->{dump} |
102 # do nothing. But anyway the device to dump is named in $dev->{dump} |
86 if ($dev->{lvm}) { |
103 if ($dev->{lvm}) { |
87 # we can do a snapshot |
104 # we can do a snapshot |
108 $dev->{dump} = $dev->{rdev} |
125 $dev->{dump} = $dev->{rdev} |
109 } |
126 } |
110 |
127 |
111 ### $dev |
128 ### $dev |
112 |
129 |
113 $ENV{key} = $default{KEY}; |
130 $ENV{key} = $cf{KEY}; |
114 my $dumper = open(my $dump, "-|") or do { |
131 my $dumper = open(my $dump, "-|") or do { |
115 my $head = <<__; |
132 my $head = <<__; |
116 #! /bin/bash |
133 #! /bin/bash |
117 echo "LEVEL $opt_level: $dev->{dev} $dev->{rdev} ($dev->{dump})" >&2 |
134 if test "\$1" = "--info"; then |
118 tail -c XXXX \$0 | openssl enc -d -blowfish "\$@" | gzip -d |
135 cat <<___ |
|
136 NODE : $NODE |
|
137 DATE : $NOW @{[localtime $NOW]} |
|
138 LEVEL : $opt_level |
|
139 DEVICE : $dev->{dev} |
|
140 REAL_DEVICE: $dev->{rdev} |
|
141 MOUNTPOINT : $dev->{mountpoint} |
|
142 FSTYPE : $dev->{fstype} |
|
143 ___ |
|
144 exit 0 |
|
145 fi |
|
146 tail -c XXXXX \$0 | openssl enc -d -blowfish "\$@" |
119 exit |
147 exit |
120 |
148 |
121 __ |
149 __ |
122 # adjust the placeholder |
150 # adjust the placeholder |
123 $head =~ s/XXXX/sprintf "% 4s", "+" . (length($head) +1)/e; |
151 $head =~ s/XXXXX/sprintf "% 5s", "+" . (length($head) +1)/e; |
124 print $head; |
152 print $head; |
125 exec "dump -$opt_level -L $label -f- -u $dev->{dump}" |
153 exec "dump -$opt_level -L $label -f- -u -z6 $dev->{dump}" |
126 . "| gzip" |
|
127 . "| openssl enc -pass env:key -salt -blowfish"; |
154 . "| openssl enc -pass env:key -salt -blowfish"; |
128 die "Can't exec dumper\n"; |
155 die "Can't exec dumper\n"; |
129 }; |
156 }; |
130 |
157 |
131 $ftp->try(put => $dump, $file); |
158 $ftp->try(put => $dump, $file); |
161 chomp($rdev = `blkid -c /dev/null -o device -t '$dev'`); |
188 chomp($rdev = `blkid -c /dev/null -o device -t '$dev'`); |
162 } |
189 } |
163 $rdev = readlink $rdev while -l $rdev; |
190 $rdev = readlink $rdev while -l $rdev; |
164 |
191 |
165 # if it's LVM we gather more information (to support snapshots) |
192 # if it's LVM we gather more information (to support snapshots) |
|
193 # FIXME: could have used `lvdisplay -c' |
166 my $lvm; |
194 my $lvm; |
167 if ((stat $rdev)[6] >> 8 == $dev_mapper) { |
195 if ((stat $rdev)[6] >> 8 == $dev_mapper) { |
168 @{$lvm}{qw/vg lv/} = map { s/--/-/g; $_ } basename($rdev) =~ /(.+[^-])-([^-].+)/; |
196 @{$lvm}{qw/vg lv/} = map { s/--/-/g; $_ } basename($rdev) =~ /(.+[^-])-([^-].+)/; |
169 $lvm->{path} = "$lvm->{vg}/$lvm->{lv}"; |
197 $lvm->{path} = "$lvm->{vg}/$lvm->{lv}"; |
170 } |
198 } |
171 |
199 |
172 push @dev, { |
200 push @dev, { |
173 dev => $dev, |
201 dev => $dev, |
174 rdev => $rdev, |
202 rdev => $rdev, |
175 mount_point => $mp, |
203 mountpoint => $mp, |
176 fstype => $fstype, |
204 fstype => $fstype, |
177 lvm => $lvm, |
205 lvm => $lvm, |
178 }; |
206 }; |
179 } |
207 } |
180 |
208 |
181 return @dev; |
209 return @dev; |
182 } |
210 } |
183 |
211 |
184 sub get_configs($) { |
212 sub get_configs(@) { |
185 local $_; |
213 local $_; |
186 my %r; |
214 my %r = (); |
187 foreach (glob("$_[0]/*")) { |
215 foreach (grep {-f} map { (-d) ? glob("$_/*") : $_ } @_) { |
|
216 |
|
217 # check permission and ownership |
|
218 { |
|
219 my $p = (stat)[2] & 07777; |
|
220 my $u = (stat _)[4]; |
|
221 die "$ME: $_ has wrong permissions: found @{[sprintf '%04o', $p]}, need 0600\n" |
|
222 if $p != 0600; |
|
223 die "$ME: owner of $_ ($u) is not the EUID ($EUID) of this process\n" |
|
224 if (stat _)[4] != $EUID; |
|
225 |
|
226 # FIXME: should check the containing directories too! |
|
227 }; |
|
228 |
188 my $f = new IO::File $_ or die "Can't open $_: $!\n"; |
229 my $f = new IO::File $_ or die "Can't open $_: $!\n"; |
189 my %h = map { split /\s*=\s*/, $_, 2 } grep {!/^\s*#/} <$f>; |
230 my %h = map { split /\s*=\s*/, $_, 2 } grep {!/^\s*#/ and /=/} <$f>; |
190 map { chomp } values %h; |
231 map { chomp } values %h; |
191 if (basename($_) eq "DEFAULT") { |
232 %r = (%r, %h); |
192 $r{DEFAULT} = \%h; |
|
193 next; |
|
194 } |
|
195 if (exists $h{DEV}) { |
|
196 $r{$h{DEV}} = \%h; |
|
197 next; |
|
198 } |
|
199 |
|
200 if (exists $h{MOUNT}) { |
|
201 $r{$h{MOUNT}} = \%h; |
|
202 next; |
|
203 } |
|
204 } |
233 } |
205 return %r; |
234 return %r; |
206 } |
235 } |
207 |
236 |
208 { package FTP; |
237 { package FTP; |