2 #============================================================= -*-perl-*-
4 # BackupPC_tarExtract: extract data from a dump
9 # Craig Barratt <cbarratt@users.sourceforge.net>
12 # Copyright (C) 2001-2003 Craig Barratt
14 # This program is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either version 2 of the License, or
17 # (at your option) any later version.
19 # This program is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28 #========================================================================
30 # Version 2.1.0_CVS, released 3 Jul 2003.
32 # See http://backuppc.sourceforge.net.
34 #========================================================================
38 use lib "/usr/local/BackupPC/lib";
40 use BackupPC::Attrib qw(:all);
41 use BackupPC::FileZIO;
42 use BackupPC::PoolWrite;
45 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
46 my $TopDir = $bpc->TopDir();
47 my $BinDir = $bpc->BinDir();
48 my %Conf = $bpc->Conf();
51 print("usage: $0 <host> <shareName> <compressLevel>\n");
54 if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
55 print("$0: bad host name '$ARGV[0]'\n");
59 if ( $ARGV[1] !~ /^([\w\s\.\/\$-]+)$/ ) {
60 print("$0: bad share name '$ARGV[1]'\n");
64 my $ShareName = $bpc->fileNameEltMangle($ShareNameUM);
65 if ( $ARGV[2] !~ /^(\d+)$/ ) {
66 print("$0: bad compress level '$ARGV[2]'\n");
72 # This constant and the line of code below that uses it is borrowed
73 # from Archive::Tar. Thanks to Calle Dybedahl and Stephen Zander.
76 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
77 # Copyright 1998 Stephen Zander. All rights reserved.
80 = 'Z100 A8 A8 A8 A12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
81 my $tar_header_length = 512;
83 my $BufSize = 1048576; # 1MB or 2^20
86 my $OutDir = "$TopDir/pc/$host/new";
90 my $ExistFileSize = 0;
91 my $ExistFileCompSize = 0;
93 my $TotalFileSize = 0;
97 my($fh, $totBytes) = @_;
98 my($numBytes, $newBytes, $data);
100 $data = "\0" x $totBytes;
101 while ( $numBytes < $totBytes ) {
102 $newBytes = sysread($fh,
103 substr($data, $numBytes, $totBytes - $numBytes),
104 $totBytes - $numBytes);
105 if ( $newBytes <= 0 ) {
106 print(STDERR "Unexpected end of tar archive (tot = $totBytes,"
107 . " num = $numBytes, posn = " . sysseek($fh, 0, 1) . ")\n");
111 $numBytes += $newBytes;
120 return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
128 if ( $size % $tar_header_length ) {
129 TarRead($fh, $tar_header_length - ($size % $tar_header_length));
136 my($head, $longName, $longLink);
137 my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
138 $linkname, $magic, $version, $uname, $gname, $devmajor,
142 $head = TarReadHeader($fh);
143 return if ( $head eq "" || $head eq "\0" x $tar_header_length );
145 $mode, # octal number
148 $size, # octal number
149 $mtime, # octal number
150 $chksum, # octal number
154 $version, # two bytes
157 $devmajor, # octal number
158 $devminor, # octal number
159 $prefix) = unpack($tar_unpack_header, $head);
164 $size =~ s/^6/2/; # fix bug in smbclient for >=2GB files
165 $size =~ s/^7/3/; # fix bug in smbclient for >=2GB files
168 $chksum = oct $chksum;
169 $devmajor = oct $devmajor;
170 $devminor = oct $devminor;
171 $name = "$prefix/$name" if $prefix;
173 substr ($head, 148, 8) = " ";
174 if (unpack ("%16C*", $head) != $chksum) {
175 print(STDERR "$name: checksum error at "
176 . sysseek($fh, 0, 1) , "\n");
179 if ( $type eq "L" ) {
180 $longName = TarRead($fh, $size) || return;
181 # remove trailing NULL
182 $longName = substr($longName, 0, $size - 1);
183 TarFlush($fh, $size);
185 } elsif ( $type eq "K" ) {
186 $longLink = TarRead($fh, $size) || return;
187 # remove trailing NULL
188 $longLink = substr($longLink, 0, $size - 1);
189 TarFlush($fh, $size);
192 $name = $longName if ( defined($longName) );
193 $linkname = $longLink if ( defined($longLink) );
199 mangleName => $bpc->fileNameMangle($name),
206 linkname => $linkname,
207 devmajor => $devmajor,
208 devminor => $devminor,
216 my $f = TarReadFileInfo($fh) || return;
219 if ( $f->{name} eq "" ) {
222 $file = $ShareNameUM;
224 ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1}; # unmangled file
225 if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
226 $dir = "$ShareName/$1";
231 if ( !defined($Attrib{$dir}) ) {
232 foreach my $d ( keys(%Attrib) ) {
233 next if ( $dir =~ m{^\Q$d/} );
236 $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress });
237 if ( -f $Attrib{$dir}->fileName("$OutDir/$dir")
238 && !$Attrib{$dir}->read("$OutDir/$dir") ) {
239 printf(STDERR "Unable to read attribute file %s\n",
240 $Attrib{$dir}->fileName("$OutDir/$dir"));
244 if ( $f->{type} == BPC_FTYPE_DIR ) {
248 mkpath("$OutDir/$ShareName/$f->{mangleName}", 0, 0777)
249 if ( !-d "$OutDir/$ShareName/$f->{mangleName}" );
250 } elsif ( $f->{type} == BPC_FTYPE_FILE ) {
255 #print("Reading $f->{name}, $f->{size} bytes, type $f->{type}\n");
256 my $poolWrite = BackupPC::PoolWrite->new($bpc,
257 "$OutDir/$ShareName/$f->{mangleName}",
258 $f->{size}, $Compress);
259 while ( $nRead < $f->{size} ) {
260 my $thisRead = $f->{size} - $nRead < $BufSize
261 ? $f->{size} - $nRead : $BufSize;
262 my $data = TarRead($fh, $thisRead);
264 print(STDERR "Unexpected end of tar archive during read\n");
268 $poolWrite->write(\$data);
271 processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
272 TarFlush($fh, $f->{size});
273 } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
275 # Hardlink to another file. GNU tar is clever about files
276 # that are hardlinks to each other. The first link will be
277 # sent as a regular file. The additional links will be sent
278 # as this type. We store the hardlink just like a symlink:
279 # the link name (path of the linked-to file) is stored in
282 $f->{size} = length($f->{linkname});
283 my $poolWrite = BackupPC::PoolWrite->new($bpc,
284 "$OutDir/$ShareName/$f->{mangleName}",
285 $f->{size}, $Compress);
286 $poolWrite->write(\$f->{linkname});
287 processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
288 } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
290 # Symbolic link: write the value of the link to a plain file,
291 # that we pool as usual (ie: we don't create a symlink).
292 # The attributes remember the original file type.
293 # We also change the size to reflect the size of the link
296 $f->{size} = length($f->{linkname});
297 my $poolWrite = BackupPC::PoolWrite->new($bpc,
298 "$OutDir/$ShareName/$f->{mangleName}",
299 $f->{size}, $Compress);
300 $poolWrite->write(\$f->{linkname});
301 processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
302 } elsif ( $f->{type} == BPC_FTYPE_CHARDEV
303 || $f->{type} == BPC_FTYPE_BLOCKDEV
304 || $f->{type} == BPC_FTYPE_FIFO ) {
306 # Special files: for char and block special we write the
307 # major and minor numbers to a plain file, that we pool
308 # as usual. For a pipe file we create an empty file.
309 # The attributes remember the original file type.
312 if ( $f->{type} == BPC_FTYPE_FIFO ) {
315 $data = "$f->{devmajor},$f->{devminor}";
317 my $poolWrite = BackupPC::PoolWrite->new($bpc,
318 "$OutDir/$ShareName/$f->{mangleName}",
319 length($data), $Compress);
320 $poolWrite->write(\$data);
321 $f->{size} = length($data);
322 processClose($poolWrite, "$ShareName/$f->{mangleName}", length($data));
324 print("Got unknown type $f->{type} for $f->{name}\n");
327 $Attrib{$dir}->set($file, {
333 mtime => $f->{mtime},
343 return if ( !defined($Attrib{$d}) );
344 if ( $Attrib{$d}->fileCount ) {
345 my $data = $Attrib{$d}->writeData;
346 my $fileName = $Attrib{$d}->fileName("$OutDir/$d");
347 my $poolWrite = BackupPC::PoolWrite->new($bpc, $fileName,
348 length($data), $Compress);
349 $poolWrite->write(\$data);
350 processClose($poolWrite, $Attrib{$d}->fileName($d), length($data));
357 my($poolWrite, $fileName, $origSize) = @_;
358 my($exists, $digest, $outSize, $errs) = $poolWrite->close;
361 print(STDERR join("", @$errs));
365 $TotalFileSize += $origSize;
368 $ExistFileSize += $origSize;
369 $ExistFileCompSize += $outSize;
370 } elsif ( $outSize > 0 ) {
371 print(NEW_FILES "$digest $origSize $fileName\n");
375 mkpath("$OutDir/$ShareName", 0, 0777);
376 open(NEW_FILES, ">>", "$TopDir/pc/$host/NewFileList")
377 || die("can't open $TopDir/pc/$host/NewFileList");
380 1 while ( TarReadFile(*STDIN) );
381 1 while ( sysread(STDIN, my $discard, 1024) );
384 # Flush out remaining attributes.
386 foreach my $d ( keys(%Attrib) ) {
392 # Report results to BackupPC_dump
394 print("Done: $Errors errors, $ExistFileCnt filesExist,"
395 . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
396 . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");