1package Brackup::File; 2# "everything is a file" 3# ... this class includes symlinks and directories 4 5use strict; 6use warnings; 7use Carp qw(croak); 8use File::stat (); 9use Fcntl qw(S_ISREG S_ISDIR S_ISLNK S_ISFIFO O_RDONLY); 10use Digest::SHA1; 11use String::Escape qw(printable); 12use Brackup::PositionedChunk; 13use Brackup::Chunker::Default; 14use Brackup::Chunker::MP3; 15 16sub new { 17 my ($class, %opts) = @_; 18 my $self = bless {}, $class; 19 20 $self->{root} = delete $opts{root}; 21 $self->{path} = delete $opts{path}; 22 $self->{stat} = delete $opts{stat}; # File::stat object 23 croak("Unknown options: " . join(', ', keys %opts)) if %opts; 24 25 die "No root object provided." unless $self->{root} && $self->{root}->isa("Brackup::Root"); 26 die "No path provided." unless defined($self->{path}); # note: permit "0" 27 $self->{path} =~ s!^\./!!; 28 29 return $self; 30} 31 32sub root { 33 my $self = shift; 34 return $self->{root}; 35} 36 37# returns File::stat object 38sub stat { 39 my $self = shift; 40 return $self->{stat} if $self->{stat}; 41 my $path = $self->fullpath; 42 my $stat = File::stat::lstat($path); 43 return $self->{stat} = $stat; 44} 45 46sub size { 47 my $self = shift; 48 return $self->stat->size; 49} 50 51sub is_dir { 52 my $self = shift; 53 return S_ISDIR($self->stat->mode); 54} 55 56sub is_link { 57 my $self = shift; 58 my $result = eval { S_ISLNK($self->stat->mode) }; 59 $result = -l $self->fullpath unless defined($result); 60 return $result; 61} 62 63sub is_file { 64 my $self = shift; 65 return S_ISREG($self->stat->mode); 66} 67 68sub is_fifo { 69 my $self = shift; 70 return S_ISFIFO($self->stat->mode); 71} 72 73# Returns file type like find's -type 74sub type { 75 my $self = shift; 76 return "f" if $self->is_file; 77 return "d" if $self->is_dir; 78 return "l" if $self->is_link; 79 return "p" if $self->is_fifo; 80 return ""; 81} 82 83sub fullpath { 84 my $self = shift; 85 return $self->{root}->path . "/" . $self->{path}; 86} 87 88# a scalar that hopefully uniquely represents a single version of a file in time. 89sub cachekey { 90 my $self = shift; 91 my $st = $self->stat; 92 return "[" . $self->{root}->name . "]" . $self->{path} . ":" . join(",", $st->ctime, $st->mtime, $st->size, $st->ino); 93} 94 95# Returns the appropriate FileChunker class for the provided file's 96# type. In most cases this FileChunker will be very dumb, just making 97# equal-sized chunks for, say, 5MB, but in specialized cases (like mp3 98# files), the chunks will be one (or two) small ones for the ID3v1/v2 99# chunks, and one big chunk for the audio bytes (which might be cut 100# into its own small chunks). This way the mp3 metadata can be 101# changed without needing to back up the entire file again ... just 102# the changed metadata. 103sub file_chunker { 104 my $self = shift; 105 if ($self->{path} =~ /\.mp3$/i && $self->{root}->smart_mp3_chunking) { 106 return "Brackup::Chunker::MP3"; 107 } 108 return "Brackup::Chunker::Default"; 109} 110 111sub chunks { 112 my $self = shift; 113 # memoized: 114 return @{ $self->{chunks} } if $self->{chunks}; 115 116 # non-files don't have chunks 117 if (!$self->is_file) { 118 $self->{chunks} = []; 119 return (); 120 } 121 122 # Get the appropriate FileChunker for this file type, 123 # then pass ourselves to it to get our chunks. 124 my @chunk_list = $self->file_chunker->chunks($self); 125 126 $self->{chunks} = \@chunk_list; 127 return @chunk_list; 128} 129 130sub full_digest { 131 my $self = shift; 132 return $self->{_full_digest} ||= $self->_calc_full_digest; 133} 134 135sub _calc_full_digest { 136 my $self = shift; 137 return "" unless $self->is_file; 138 139 my $cache = $self->{root}->digest_cache; 140 my $key = $self->cachekey; 141 142 my $dig = $cache->get($key); 143 return $dig if $dig; 144 145 # legacy migration thing... we used to more often store 146 # the chunk digests, not the file digests. so try that 147 # first... 148 if ($self->chunks == 1) { 149 my ($chunk) = $self->chunks; 150 $dig = $cache->get($chunk->cachekey); 151 } 152 153 unless ($dig) { 154 my $sha1 = Digest::SHA1->new; 155 my $path = $self->fullpath; 156 sysopen(my $fh, $path, O_RDONLY) or die "Failed to open $path: $!"; 157 binmode($fh); 158 $sha1->addfile($fh); 159 close($fh); 160 161 $dig = "sha1:" . $sha1->hexdigest; 162 } 163 164 $cache->set($key => $dig); 165 return $dig; 166} 167 168sub link_target { 169 my $self = shift; 170 return $self->{linktarget} if $self->{linktarget}; 171 return undef unless $self->is_link; 172 return $self->{linktarget} = readlink($self->fullpath); 173} 174 175sub path { 176 my $self = shift; 177 return $self->{path}; 178} 179 180sub as_string { 181 my $self = shift; 182 my $type = $self->type; 183 return "[" . $self->{root}->as_string . "] t=$type $self->{path}"; 184} 185 186sub mode { 187 my $self = shift; 188 return sprintf('%#o', $self->stat->mode & 0777); 189} 190 191sub uid { 192 my $self = shift; 193 return $self->stat->uid; 194} 195 196sub gid { 197 my $self = shift; 198 return $self->stat->gid; 199} 200 201sub as_rfc822 { 202 my ($self, $schunk_list, $backup) = @_; 203 my $ret = ""; 204 my $set = sub { 205 my ($key, $val) = @_; 206 return unless length $val; 207 $ret .= "$key: $val\n"; 208 }; 209 my $st = $self->stat; 210 211 $set->("Path", printable($self->{path})); 212 my $type = $self->type; 213 if ($self->is_file) { 214 my $size = $self->size; 215 $set->("Size", $size); 216 $set->("Digest", $self->full_digest) if $size; 217 } else { 218 $set->("Type", $type); 219 if ($self->is_link) { 220 $set->("Link", $self->link_target); 221 } 222 } 223 $set->("Chunks", join("\n ", map { $_->to_meta } @$schunk_list)); 224 225 unless ($self->is_link) { 226 $set->("Mtime", $st->mtime); 227 $set->("Atime", $st->atime) unless $self->root->noatime; 228 229 my $mode = $self->mode; 230 unless (($type eq "d" && $mode eq $backup->default_directory_mode) || 231 ($type eq "f" && $mode eq $backup->default_file_mode)) { 232 $set->("Mode", $mode); 233 } 234 } 235 236 my $uid = $self->uid; 237 unless ($uid eq $backup->default_uid) { 238 $set->("UID", $uid); 239 } 240 my $gid = $self->gid; 241 unless ($gid eq $backup->default_gid) { 242 $set->("GID", $gid); 243 } 244 245 return $ret . "\n"; 246} 247 2481; 249