| OLD | NEW |
| 1 package Brackup::Root; | 1 package Brackup::Root; |
| 2 use strict; | 2 use strict; |
| 3 use warnings; | 3 use warnings; |
| 4 use Carp qw(croak); | 4 use Carp qw(croak); |
| 5 use File::Find; | 5 use File::Find; |
| 6 use Brackup::DigestCache; | 6 use Brackup::DigestCache; |
| 7 use Brackup::Util qw(tempfile); | 7 use Brackup::Util qw(tempfile); |
| 8 use IPC::Open2; | 8 use IPC::Open2; |
| 9 use Symbol; | 9 use Symbol; |
| 10 | 10 |
| 11 sub new { | 11 sub new { |
| 12 my ($class, $conf) = @_; | 12 my ($class, $conf) = @_; |
| 13 my $self = bless {}, $class; | 13 my $self = bless {}, $class; |
| 14 | 14 |
| 15 ($self->{name}) = $conf->name =~ m/^SOURCE:(.+)$/ | 15 ($self->{name}) = $conf->name =~ m/^SOURCE:(.+)$/ |
| 16 or die "No backup-root name provided."; | 16 or die "No backup-root name provided."; |
| 17 die "Backup-root name must be only a-z, A-Z, 0-9, and _." unless $self->{nam
e} =~ /^\w+/; | 17 die "Backup-root name must be only a-z, A-Z, 0-9, and _." unless $self->{nam
e} =~ /^\w+/; |
| 18 | 18 |
| 19 $self->{dir} = $conf->path_value('path'); | 19 $self->{dir} = $conf->path_value('path'); |
| 20 $self->{gpg_path} = $conf->value('gpg_path') || "gpg"; | 20 $self->{gpg_path} = $conf->value('gpg_path') || "gpg"; |
| 21 $self->{gpg_rcpt} = $conf->value('gpg_recipient'); | 21 $self->{gpg_rcpt} = $conf->value('gpg_recipient'); |
| 22 $self->{chunk_size} = $conf->byte_value('chunk_size'); | 22 $self->{chunk_size} = $conf->byte_value('chunk_size'); |
| 23 $self->{ignore} = []; | 23 $self->{ignore} = []; |
| 24 $self->{accept} = []; |
| 24 | 25 |
| 25 $self->{smart_mp3_chunking} = $conf->bool_value('smart_mp3_chunking'); | 26 $self->{smart_mp3_chunking} = $conf->bool_value('smart_mp3_chunking'); |
| 26 | 27 |
| 27 $self->{merge_files_under} = $conf->byte_value('merge_files_under'); | 28 $self->{merge_files_under} = $conf->byte_value('merge_files_under'); |
| 28 $self->{max_composite_size} = $conf->byte_value('max_composite_chunk_size')
|| 2**20; | 29 $self->{max_composite_size} = $conf->byte_value('max_composite_chunk_size')
|| 2**20; |
| 29 | 30 |
| 30 die "'max_composite_chunk_size' must be greater than 'merge_files_under'\n"
unless | 31 die "'max_composite_chunk_size' must be greater than 'merge_files_under'\n"
unless |
| 31 $self->{max_composite_size} > $self->{merge_files_under}; | 32 $self->{max_composite_size} > $self->{merge_files_under}; |
| 32 | 33 |
| 33 $self->{gpg_args} = []; # TODO: let user set this. for now, not possible | 34 $self->{gpg_args} = []; # TODO: let user set this. for now, not possible |
| 34 | 35 |
| 35 $self->{digcache} = Brackup::DigestCache->new($self, $conf); | 36 $self->{digcache} = Brackup::DigestCache->new($self, $conf); |
| 36 $self->{digcache_file} = $self->{digcache}->backing_file; # may be empty, i
f digest cache doesn't use a file | 37 $self->{digcache_file} = $self->{digcache}->backing_file; # may be empty, i
f digest cache doesn't use a file |
| 37 | 38 |
| 38 $self->{noatime} = $conf->value('noatime'); | 39 $self->{noatime} = $conf->value('noatime'); |
| 39 return $self; | 40 return $self; |
| 40 } | 41 } |
| 41 | 42 |
| 42 sub merge_files_under { $_[0]{merge_files_under} } | 43 sub merge_files_under { $_[0]{merge_files_under} } |
| 43 sub max_composite_size { $_[0]{max_composite_size} } | 44 sub max_composite_size { $_[0]{max_composite_size} } |
| 44 sub smart_mp3_chunking { $_[0]{smart_mp3_chunking} } | 45 sub smart_mp3_chunking { $_[0]{smart_mp3_chunking} } |
| 45 | 46 |
| 46 sub gpg_path { | 47 sub gpg_path { |
| 47 my $self = shift; | 48 my $self = shift; |
| 48 return $self->{gpg_path}; | 49 return $self->{gpg_path}; |
| 49 } | 50 } |
| 50 | 51 |
| 51 sub gpg_args { | 52 sub gpg_args { |
| 52 my $self = shift; | 53 my $self = shift; |
| 53 return @{ $self->{gpg_args} }; | 54 return @{ $self->{gpg_args} }; |
| 54 } | 55 } |
| 55 | 56 |
| 56 sub gpg_rcpt { | 57 sub gpg_rcpt { |
| 57 my $self = shift; | 58 my $self = shift; |
| 58 return $self->{gpg_rcpt}; | 59 return $self->{gpg_rcpt}; |
| 59 } | 60 } |
| 60 | 61 |
| 61 # returns Brackup::DigestCache object | 62 # returns Brackup::DigestCache object |
| 62 sub digest_cache { | 63 sub digest_cache { |
| 63 my $self = shift; | 64 my $self = shift; |
| 64 return $self->{digcache}; | 65 return $self->{digcache}; |
| 65 } | 66 } |
| 66 | 67 |
| 67 sub chunk_size { | 68 sub chunk_size { |
| 68 my $self = shift; | 69 my $self = shift; |
| 69 return $self->{chunk_size} || (64 * 2**20); # default to 64MB | 70 return $self->{chunk_size} || (64 * 2**20); # default to 64MB |
| 70 } | 71 } |
| 71 | 72 |
| 72 sub publicname { | 73 sub publicname { |
| 73 # FIXME: let users define the public (obscured) name of their roots. s/porn
/media/, etc. | 74 # FIXME: let users define the public (obscured) name of their roots. s/porn
/media/, etc. |
| 74 # because their metafile key names (which contain the root) aren't encrypted
. | 75 # because their metafile key names (which contain the root) aren't encrypted
. |
| 75 return $_[0]{name}; | 76 return $_[0]{name}; |
| 76 } | 77 } |
| 77 | 78 |
| 78 sub name { | 79 sub name { |
| 79 return $_[0]{name}; | 80 return $_[0]{name}; |
| 80 } | 81 } |
| 81 | 82 |
| 82 sub ignore { | 83 sub ignore { |
| 83 my ($self, $pattern) = @_; | 84 my ($self, $pattern) = @_; |
| 84 push @{ $self->{ignore} }, $pattern; | 85 push @{ $self->{ignore} }, $pattern; |
| 86 } |
| 87 |
| 88 sub accept { |
| 89 my ($self, $pattern) = @_; |
| 90 push @{ $self->{accept} }, $pattern; |
| 85 } | 91 } |
| 86 | 92 |
| 87 sub path { | 93 sub path { |
| 88 return $_[0]{dir}; | 94 return $_[0]{dir}; |
| 89 } | 95 } |
| 90 | 96 |
| 91 sub noatime { | 97 sub noatime { |
| 92 return $_[0]{noatime}; | 98 return $_[0]{noatime}; |
| 93 } | 99 } |
| 94 | 100 |
| 95 sub foreach_file { | 101 sub foreach_file { |
| 96 my ($self, $cb) = @_; | 102 my ($self, $cb) = @_; |
| 97 | 103 |
| 98 chdir $self->{dir} or die "Failed to chdir to $self->{dir}"; | 104 chdir $self->{dir} or die "Failed to chdir to $self->{dir}"; |
| 99 | 105 |
| 100 my %statcache; # file -> statobj | 106 my %statcache; # file -> statobj |
| 101 | 107 |
| 102 find({ | 108 find({ |
| 103 no_chdir => 1, | 109 no_chdir => 1, |
| 104 preprocess => sub { | 110 preprocess => sub { |
| 105 my $dir = $File::Find::dir; | 111 my $dir = $File::Find::dir; |
| 106 my @good_dentries; | 112 my @good_dentries; |
| 107 DENTRY: | 113 DENTRY: |
| 108 foreach my $dentry (@_) { | 114 foreach my $dentry (@_) { |
| 109 next if $dentry eq "." || $dentry eq ".."; | 115 next if $dentry eq "." || $dentry eq ".."; |
| 110 | 116 |
| 111 my $path = "$dir/$dentry"; | 117 my $path = "$dir/$dentry"; |
| 112 $path =~ s!^\./!!; | 118 $path =~ s!^\./!!; |
| 113 | 119 |
| 114 # skip the digest database file. not sure if this is smart or n
ot. | 120 # skip the digest database file. not sure if this is smart or n
ot. |
| 115 # for now it'd be kinda nice to have, but it's re-creatable from | 121 # for now it'd be kinda nice to have, but it's re-creatable from |
| 116 # the backup meta files later, so let's skip it. | 122 # the backup meta files later, so let's skip it. |
| 117 next if $path eq $self->{digcache_file}; | 123 next if $path eq $self->{digcache_file}; |
| 118 | 124 |
| 119 # gpg seems to barf on files ending in whitespace, blowing | 125 # gpg seems to barf on files ending in whitespace, blowing |
| 120 # stuff up, so we just skip them instead... | 126 # stuff up, so we just skip them instead... |
| 121 if ($path =~ /\s+$/) { | 127 if ($path =~ /\s+$/) { |
| 122 warn "Skipping file ending in whitespace: <$path>\n"; | 128 warn "Skipping file ending in whitespace: <$path>\n"; |
| 123 next; | 129 next; |
| 124 } | 130 } |
| 125 | 131 |
| 126 my $statobj = File::stat::lstat($path); | 132 my $statobj = File::stat::lstat($path); |
| 127 my $is_dir = -d _; | 133 my $is_dir = -d _; |
| 128 | 134 |
| 129 foreach my $pattern (@{ $self->{ignore} }) { | 135 foreach my $pattern (@{ $self->{ignore} }) { |
| 130 next DENTRY if $path =~ /$pattern/; | 136 next DENTRY if $path =~ /$pattern/; |
| 131 next DENTRY if $is_dir && "$path/" =~ /$pattern/; | 137 next DENTRY if $is_dir && "$path/" =~ /$pattern/; |
| 132 } | 138 } |
| 133 | 139 |
| 140 |
| 141 if( @{ $self->{accept} } ) { |
| 142 |
| 143 foreach my $pattern (@{ $self->{accept} }) { |
| 144 if( $path =~ /$pattern/ ) { |
| 145 $statcache{$path} = $statobj; |
| 146 push @good_dentries, $dentry; |
| 147 next DENTRY; |
| 148 } |
| 149 |
| 150 if( $is_dir && "$path/" =~ /$pattern/ ) { |
| 151 $statcache{$path} = $statobj; |
| 152 push @good_dentries, $dentry; |
| 153 next DENTRY; |
| 154 } |
| 155 } |
| 156 |
| 157 next DENTRY; |
| 158 } |
| 159 |
| 134 $statcache{$path} = $statobj; | 160 $statcache{$path} = $statobj; |
| 135 push @good_dentries, $dentry; | 161 push @good_dentries, $dentry; |
| 136 } | 162 } |
| 137 | 163 |
| 138 # to let it recurse into the good directories we didn't | 164 # to let it recurse into the good directories we didn't |
| 139 # already throw away: | 165 # already throw away: |
| 140 return sort @good_dentries; | 166 return sort @good_dentries; |
| 141 }, | 167 }, |
| 142 | 168 |
| 143 wanted => sub { | 169 wanted => sub { |
| 144 my $path = $_; | 170 my $path = $_; |
| 145 $path =~ s!^\./!!; | 171 $path =~ s!^\./!!; |
| 146 | 172 |
| 147 my $stat_obj = delete $statcache{$path}; | 173 my $stat_obj = delete $statcache{$path}; |
| 148 my $file = Brackup::File->new(root => $self, | 174 my $file = Brackup::File->new(root => $self, |
| 149 path => $path, | 175 path => $path, |
| 150 stat => $stat_obj, | 176 stat => $stat_obj, |
| 151 ); | 177 ); |
| 152 $cb->($file); | 178 $cb->($file); |
| 153 }, | 179 }, |
| 154 }, "."); | 180 }, "."); |
| 155 } | 181 } |
| 156 | 182 |
| 157 sub as_string { | 183 sub as_string { |
| 158 my $self = shift; | 184 my $self = shift; |
| 159 return $self->{name} . "($self->{dir})"; | 185 return $self->{name} . "($self->{dir})"; |
| 160 } | 186 } |
| 161 | 187 |
| 162 sub du_stats { | 188 sub du_stats { |
| 163 my $self = shift; | 189 my $self = shift; |
| 164 | 190 |
| 165 my $show_all = $ENV{BRACKUP_DU_ALL}; | 191 my $show_all = $ENV{BRACKUP_DU_ALL}; |
| 166 my @dir_stack; | 192 my @dir_stack; |
| 167 my %dir_size; | 193 my %dir_size; |
| 168 my $pop_dir = sub { | 194 my $pop_dir = sub { |
| 169 my $dir = pop @dir_stack; | 195 my $dir = pop @dir_stack; |
| 170 printf("%-20d%s\n", $dir_size{$dir} || 0, $dir); | 196 printf("%-20d%s\n", $dir_size{$dir} || 0, $dir); |
| 171 delete $dir_size{$dir}; | 197 delete $dir_size{$dir}; |
| 172 }; | 198 }; |
| 173 my $start_dir = sub { | 199 my $start_dir = sub { |
| 174 my $dir = shift; | 200 my $dir = shift; |
| 175 unless ($dir eq ".") { | 201 unless ($dir eq ".") { |
| 176 my @parts = (".", split(m!/!, $dir)); | 202 my @parts = (".", split(m!/!, $dir)); |
| 177 while (@dir_stack >= @parts) { | 203 while (@dir_stack >= @parts) { |
| 178 $pop_dir->(); | 204 $pop_dir->(); |
| 179 } | 205 } |
| 180 } | 206 } |
| 181 push @dir_stack, $dir; | 207 push @dir_stack, $dir; |
| 182 }; | 208 }; |
| 183 $self->foreach_file(sub { | 209 $self->foreach_file(sub { |
| (...skipping 82 matching lines...) Show 10 above Show 10 below |
| 266 | 292 |
| 267 =over | 293 =over |
| 268 | 294 |
| 269 =item B<path> | 295 =item B<path> |
| 270 | 296 |
| 271 The directory to backup (recursively) | 297 The directory to backup (recursively) |
| 272 | 298 |
| 273 =item B<gpg_recipient> | 299 =item B<gpg_recipient> |
| 274 | 300 |
| 275 The public key signature to encrypt data with. See L<Brackup::Manual::Overview/
"Using encryption">. | 301 The public key signature to encrypt data with. See L<Brackup::Manual::Overview/
"Using encryption">. |
| 276 | 302 |
| 277 =item B<chunk_size> | 303 =item B<chunk_size> |
| 278 | 304 |
| 279 In units of bytes, kB, MB, etc. The max size of a chunk to be stored | 305 In units of bytes, kB, MB, etc. The max size of a chunk to be stored |
| 280 on the target. Files over this size are cut up into chunks of this | 306 on the target. Files over this size are cut up into chunks of this |
| 281 size or smaller. The default is 64 MB if not specified. | 307 size or smaller. The default is 64 MB if not specified. |
| 282 | 308 |
| 283 =item B<ignore> | 309 =item B<ignore> |
| 284 | 310 |
| 285 Perl5 regular expression of files not to backup. You may have multiple ignore l
ines. | 311 Perl5 regular expression of files not to backup. You may have multiple ignore l
ines. |
| 286 | 312 |
| 287 =item B<noatime> | 313 =item B<noatime> |
| 288 | 314 |
| 289 If true, don't backup access times. They're kinda useless anyway, and | 315 If true, don't backup access times. They're kinda useless anyway, and |
| 290 just make the *.brackup metafiles larger. | 316 just make the *.brackup metafiles larger. |
| 291 | 317 |
| 292 =item B<merge_files_under> | 318 =item B<merge_files_under> |
| 293 | 319 |
| 294 In units of bytes, kB, MB, etc. If files are under this size. By | 320 In units of bytes, kB, MB, etc. If files are under this size. By |
| 295 default this feature is off (value 0), purely because it's new, but 1 | 321 default this feature is off (value 0), purely because it's new, but 1 |
| 296 kB is a recommended size, and will probably be the default in the | 322 kB is a recommended size, and will probably be the default in the |
| 297 future. Set it to 0 to explicitly disable. | 323 future. Set it to 0 to explicitly disable. |
| 298 | 324 |
| 299 =item B<max_composite_chunk_size> | 325 =item B<max_composite_chunk_size> |
| 300 | 326 |
| 301 In units of bytes, kB, MB, etc. The maximum size of a composite | 327 In units of bytes, kB, MB, etc. The maximum size of a composite |
| 302 chunk, holding lots of little files. If this is too big, you'll waste | 328 chunk, holding lots of little files. If this is too big, you'll waste |
| 303 more space with future iterative backups updating files locked into | 329 more space with future iterative backups updating files locked into |
| 304 this chunk with unchanged chunks. | 330 this chunk with unchanged chunks. |
| 305 | 331 |
| 306 Recommended, and default value, is 1 MB. | 332 Recommended, and default value, is 1 MB. |
| 307 | 333 |
| 308 =item B<smart_mp3_chunking> | 334 =item B<smart_mp3_chunking> |
| 309 | 335 |
| 310 Boolean parameter. Set to one of {on,yes,true,1} to make mp3 files | 336 Boolean parameter. Set to one of {on,yes,true,1} to make mp3 files |
| 311 chunked along their metadata boundaries. If a file has both ID3v1 and | 337 chunked along their metadata boundaries. If a file has both ID3v1 and |
| 312 ID3v2 chunks, the file will be cut into three parts: two little ones | 338 ID3v2 chunks, the file will be cut into three parts: two little ones |
| 313 for the ID3 tags, and one big one for the music bytes. | 339 for the ID3 tags, and one big one for the music bytes. |
| 314 | 340 |
| 315 =back | 341 =back |
| OLD | NEW |