1 #============================================================= -*-perl-*-
3 # BackupPC::Attrib package
7 # This library defines a BackupPC::Attrib class for maintaining
8 # file attribute data. One object instance stores attributes for
9 # all the files in a single directory.
12 # Craig Barratt <cbarratt@users.sourceforge.net>
15 # Copyright (C) 2001-2003 Craig Barratt
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU General Public License for more details.
27 # You should have received a copy of the GNU General Public License
28 # along with this program; if not, write to the Free Software
29 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
31 #========================================================================
33 # Version 2.1.0beta1, released 9 Apr 2004.
35 # See http://backuppc.sourceforge.net.
37 #========================================================================
39 package BackupPC::Attrib;
45 use BackupPC::FileZIO;
48 use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
51 # These must match the file types used by tar
53 use constant BPC_FTYPE_FILE => 0;
54 use constant BPC_FTYPE_HARDLINK => 1;
55 use constant BPC_FTYPE_SYMLINK => 2;
56 use constant BPC_FTYPE_CHARDEV => 3;
57 use constant BPC_FTYPE_BLOCKDEV => 4;
58 use constant BPC_FTYPE_DIR => 5;
59 use constant BPC_FTYPE_FIFO => 6;
60 use constant BPC_FTYPE_SOCKET => 8;
61 use constant BPC_FTYPE_UNKNOWN => 9;
62 use constant BPC_FTYPE_DELETED => 10;
78 # The indexes in this list must match the numbers above
95 # Type of attribute file. This is saved as a magic number at the
96 # start of the file. Later there might be other types.
98 use constant BPC_ATTRIB_TYPE_UNIX => 0x17555555;
100 my @ATTRIB_TYPES = qw(
114 'all' => [ @EXPORT_OK ],
118 # These fields are packed using the "w" pack format (variable length
119 # base 128). We use two values to store up to 64 bit size: sizeDiv4GB
120 # is size / 4GB and sizeMod4GB is size % 4GB (although perl can
121 # only represent around 2^52, the size of an IEEE double mantissa).
123 my @FldsUnixW = qw(type mode uid gid sizeDiv4GB sizeMod4GB);
126 # These fields are packed using the "N" pack format (32 bit integer)
128 my @FldsUnixN = qw(mtime);
132 my($class, $options) = @_;
135 type => BPC_ATTRIB_TYPE_UNIX,
144 my($a, $fileName, $attrib) = @_;
146 if ( !defined($attrib) ) {
147 delete($a->{files}{$fileName});
149 $a->{files}{$fileName} = $attrib;
155 my($a, $fileName) = @_;
156 return $a->{files}{$fileName} if ( defined($fileName) );
163 return "?" if ( $type < 0 || $type >= @FileType2Text );
164 return $FileType2Text[$type];
171 return scalar(keys(%{$a->{files}}));
176 my($a, $fileName) = @_;
177 if ( defined($fileName) ) {
178 delete($a->{files}{$fileName});
185 # Given the directory, return the full path of the attribute file.
189 my($a, $dir, $file) = @_;
191 $file = "attrib" if ( !defined($file) );
197 my($a, $dir, $file) = @_;
200 $file = $a->fileName($dir, $file);
201 my $fd = BackupPC::FileZIO->open($file, 0, $a->{compress});
203 $a->{_errStr} = "Can't open $file";
206 $fd->read(\$data, 65536);
207 if ( length($data) < 4 ) {
208 $a->{_errStr} = "Can't read magic number from $file";
212 (my $magic, $data) = unpack("N a*", $data);
213 if ( $magic != $a->{type} ) {
214 $a->{_errStr} = sprintf("Wrong magic number in $file"
215 . " (got 0x%x, expected 0x%x)",
220 while ( length($data) ) {
222 if ( length($data) < 4 ) {
223 $fd->read(\$newData, 65536);
225 if ( length($data) < 4 ) {
226 $a->{_errStr} = "Can't read file length from $file";
231 (my $len, $data) = unpack("w a*", $data);
232 if ( length($data) < $len ) {
233 $fd->read(\$newData, $len + 65536);
235 if ( length($data) < $len ) {
236 $a->{_errStr} = "Can't read file name (length $len)"
242 (my $fileName, $data) = unpack("a$len a*", $data);
243 my $nFldsW = @FldsUnixW;
244 my $nFldsN = @FldsUnixN;
245 if ( length($data) < 5 * $nFldsW + 4 * $nFldsN ) {
246 $fd->read(\$newData, 65536);
250 @{$a->{files}{$fileName}}{@FldsUnixW},
251 @{$a->{files}{$fileName}}{@FldsUnixN},
253 ) = unpack("w$nFldsW N$nFldsN a*", $data);
254 if ( $a->{files}{$fileName}{$FldsUnixN[-1]} eq "" ) {
255 $a->{_errStr} = "Can't read attributes for $fileName"
261 # Convert the two 32 bit size values into a single size
263 $a->{files}{$fileName}{size} = $a->{files}{$fileName}{sizeMod4GB}
264 + $a->{files}{$fileName}{sizeDiv4GB} * 4096 * 1024 * 1024;
276 $data = pack("N", BPC_ATTRIB_TYPE_UNIX);
277 foreach my $file ( sort(keys(%{$a->{files}})) ) {
278 my $nFldsW = @FldsUnixW;
279 my $nFldsN = @FldsUnixN;
281 # Convert the size into two 32 bit size values.
283 $a->{files}{$file}{sizeMod4GB}
284 = $a->{files}{$file}{size} % (4096 * 1024 * 1024);
285 $a->{files}{$file}{sizeDiv4GB}
286 = int($a->{files}{$file}{size} / (4096 * 1024 * 1024));
287 $data .= pack("w a* w$nFldsW N$nFldsN", length($file), $file,
288 @{$a->{files}{$file}}{@FldsUnixW},
289 @{$a->{files}{$file}}{@FldsUnixN},
297 my($a, $dir, $file) = @_;
298 my($data) = $a->writeData;
300 $file = $a->fileName($dir, $file);
301 mkpath($dir, 0, 0777) if ( !-d $dir );
302 my $fd = BackupPC::FileZIO->open($file, 1, $a->{compress});
304 $a->{_errStr} = "Can't open/write to $file";
307 if ( $fd->write(\$data) != length($data) ) {
308 $a->{_errStr} = "Can't write to $file";
321 foreach my $f ( keys(%{$a2->{files}}) ) {
322 next if ( defined($a1->{files}{$f}) );
323 $a1->{files}{$f} = $a2->{files}{$f};
331 return $a->{_errStr};