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