/[BackupPC]/trunk/bin/BackupPC_tarExtract
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/bin/BackupPC_tarExtract

Parent Directory Parent Directory | Revision Log Revision Log


Revision 316 - (hide annotations)
Mon Jan 30 13:37:17 2006 UTC (18 years, 3 months ago) by dpavlin
File size: 17994 byte(s)
 r9152@llin:  dpavlin | 2006-01-30 14:11:45 +0100
 update to upstream 2.1.2

1 dpavlin 1 #!/bin/perl
2     #============================================================= -*-perl-*-
3     #
4     # BackupPC_tarExtract: extract data from a dump
5     #
6     # DESCRIPTION
7     #
8     # AUTHOR
9     # Craig Barratt <cbarratt@users.sourceforge.net>
10     #
11     # COPYRIGHT
12     # Copyright (C) 2001-2003 Craig Barratt
13     #
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.
18     #
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.
23     #
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
27     #
28     #========================================================================
29     #
30 dpavlin 316 # Version 2.1.2, released 5 Sep 2005.
31 dpavlin 1 #
32     # See http://backuppc.sourceforge.net.
33     #
34     #========================================================================
35    
36     use strict;
37     no utf8;
38     use lib "__INSTALLDIR__/lib";
39     use BackupPC::Lib;
40     use BackupPC::Attrib qw(:all);
41     use BackupPC::FileZIO;
42     use BackupPC::PoolWrite;
43     use File::Path;
44    
45     use constant S_IFMT => 0170000; # type of file
46    
47     die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
48     my $TopDir = $bpc->TopDir();
49     my $BinDir = $bpc->BinDir();
50     my %Conf = $bpc->Conf();
51    
52     if ( @ARGV != 3 ) {
53     print("usage: $0 <client> <shareName> <compressLevel>\n");
54     exit(1);
55     }
56     if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
57     print("$0: bad client name '$ARGV[0]'\n");
58     exit(1);
59     }
60     my $client = $1;
61     if ( $ARGV[1] !~ /^([\w\s\.\/\$-]+)$/ ) {
62     print("$0: bad share name '$ARGV[1]'\n");
63     exit(1);
64     }
65     my $ShareNameUM = $1;
66     my $ShareName = $bpc->fileNameEltMangle($ShareNameUM);
67     if ( $ARGV[2] !~ /^(\d+)$/ ) {
68     print("$0: bad compress level '$ARGV[2]'\n");
69     exit(1);
70     }
71     my $Compress = $1;
72     my $Abort = 0;
73     my $AbortReason;
74    
75     #
76     # Re-read config file, so we can include the PC-specific config
77     #
78     if ( defined(my $error = $bpc->ConfigRead($client)) ) {
79     print("BackupPC_tarExtract: Can't read PC's config file: $error\n");
80     exit(1);
81     }
82     %Conf = $bpc->Conf();
83    
84     #
85     # Catch various signals
86     #
87     $SIG{INT} = \&catch_signal;
88     $SIG{ALRM} = \&catch_signal;
89     $SIG{TERM} = \&catch_signal;
90     $SIG{PIPE} = \&catch_signal;
91     $SIG{STOP} = \&catch_signal;
92     $SIG{TSTP} = \&catch_signal;
93     $SIG{TTIN} = \&catch_signal;
94    
95     #
96     # This constant and the line of code below that uses it is borrowed
97     # from Archive::Tar. Thanks to Calle Dybedahl and Stephen Zander.
98     # See www.cpan.org.
99     #
100     # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
101     # Copyright 1998 Stephen Zander. All rights reserved.
102     #
103     my $tar_unpack_header
104     = 'Z100 A8 A8 A8 A12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
105     my $tar_header_length = 512;
106    
107     my $BufSize = 1048576; # 1MB or 2^20
108     my $MaxFiles = 20;
109     my $Errors = 0;
110     my $OutDir = "$TopDir/pc/$client/new";
111     my %Attrib = ();
112    
113     my $ExistFileCnt = 0;
114     my $ExistFileSize = 0;
115     my $ExistFileCompSize = 0;
116     my $TotalFileCnt = 0;
117     my $TotalFileSize = 0;
118     my $TarReadHdrCnt = 0;
119    
120     sub TarRead
121     {
122     my($fh, $totBytes) = @_;
123     my($numBytes, $newBytes, $data);
124    
125     $data = "\0" x $totBytes;
126     while ( $numBytes < $totBytes ) {
127     return if ( $Abort );
128     $newBytes = sysread($fh,
129     substr($data, $numBytes, $totBytes - $numBytes),
130     $totBytes - $numBytes);
131     if ( $newBytes <= 0 ) {
132     return if ( $TarReadHdrCnt == 1 ); # empty tar file ok
133     print("Unexpected end of tar archive (tot = $totBytes,"
134     . " num = $numBytes, posn = " . sysseek($fh, 0, 1) . ")\n");
135     $Abort = 1;
136     $AbortReason = "Unexpected end of tar archive";
137     $Errors++;
138     return;
139     }
140     $numBytes += $newBytes;
141     }
142     return $data;
143     }
144    
145     sub TarReadHeader
146     {
147     my($fh) = @_;
148    
149     $TarReadHdrCnt++;
150     return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
151     return;
152     }
153    
154     sub TarFlush
155     {
156     my($fh, $size) = @_;
157    
158     if ( $size % $tar_header_length ) {
159     TarRead($fh, $tar_header_length - ($size % $tar_header_length));
160     }
161     }
162    
163     sub TarReadFileInfo
164     {
165     my($fh) = @_;
166     my($head, $longName, $longLink);
167     my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
168     $linkname, $magic, $version, $uname, $gname, $devmajor,
169     $devminor, $prefix);
170    
171     while ( 1 ) {
172     $head = TarReadHeader($fh);
173     return if ( $Abort || $head eq ""
174     || $head eq "\0" x $tar_header_length );
175     ($name, # string
176     $mode, # octal number
177     $uid, # octal number
178     $gid, # octal number
179     $size, # octal number
180     $mtime, # octal number
181     $chksum, # octal number
182     $type, # character
183     $linkname, # string
184     $magic, # string
185     $version, # two bytes
186     $uname, # string
187     $gname, # string
188     $devmajor, # octal number
189     $devminor, # octal number
190     $prefix) = unpack($tar_unpack_header, $head);
191    
192     $mode = oct $mode;
193     $uid = oct $uid;
194     $gid = oct $gid;
195     if ( ord($size) == 128 ) {
196     #
197     # GNU tar extension: for >=8GB files the size is stored
198     # in big endian binary.
199     #
200     $size = 65536 * 65536 * unpack("N", substr($size, 4, 4))
201     + unpack("N", substr($size, 8, 4));
202     } else {
203     #
204     # We used to have a patch here for smbclient 2.2.x. For file
205     # sizes between 2 and 4GB it sent the wrong size. But since
206     # samba 3.0.0 has been released we no longer support this
207     # patch since valid files could have sizes that start with
208     # 6 or 7 in octal (eg: 6-8GB files).
209     #
210     # $size =~ s/^6/2/; # fix bug in smbclient for >=2GB files
211     # $size =~ s/^7/3/; # fix bug in smbclient for >=2GB files
212     #
213     # To avoid integer overflow in case we are in the 4GB - 8GB
214     # range, we do the conversion in two parts.
215     #
216     if ( $size =~ /([0-9]{9,})/ ) {
217     my $len = length($1);
218     $size = oct(substr($1, 0, $len - 8)) * (1 << 24)
219     + oct(substr($1, $len - 8));
220     } else {
221     $size = oct($size);
222     }
223     }
224     $mtime = oct $mtime;
225     $chksum = oct $chksum;
226     $devmajor = oct $devmajor;
227     $devminor = oct $devminor;
228     $name = "$prefix/$name" if $prefix;
229     $prefix = "";
230     substr ($head, 148, 8) = " ";
231     if (unpack ("%16C*", $head) != $chksum) {
232     print("$name: checksum error at "
233     . sysseek($fh, 0, 1) , "\n");
234     $Errors++;
235     }
236     if ( $type eq "L" ) {
237     $longName = TarRead($fh, $size) || return;
238     # remove trailing NULL
239     $longName = substr($longName, 0, $size - 1);
240     TarFlush($fh, $size);
241     next;
242     } elsif ( $type eq "K" ) {
243     $longLink = TarRead($fh, $size) || return;
244     # remove trailing NULL
245     $longLink = substr($longLink, 0, $size - 1);
246     TarFlush($fh, $size);
247     next;
248     }
249     printf("Got file '%s', mode 0%o, size %g, type %d\n",
250     $name, $mode, $size, $type) if ( $Conf{XferLogLevel} >= 3 );
251     $name = $longName if ( defined($longName) );
252     $linkname = $longLink if ( defined($longLink) );
253     $name =~ s{^\./+}{};
254     $name =~ s{/+$}{};
255     $name =~ s{//+}{/}g;
256     return {
257     name => $name,
258     mangleName => $bpc->fileNameMangle($name),
259     mode => $mode,
260     uid => $uid,
261     gid => $gid,
262     size => $size,
263     mtime => $mtime,
264     type => $type,
265     linkname => $linkname,
266     devmajor => $devmajor,
267     devminor => $devminor,
268     };
269     }
270     }
271    
272     sub TarReadFile
273     {
274     my($fh) = @_;
275     my $f = TarReadFileInfo($fh) || return;
276     my($dir, $file);
277    
278     if ( $f->{name} eq "" ) {
279     # top-level dir
280     $dir = "";
281     $file = $ShareNameUM;
282     } else {
283     ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1}; # unmangled file
284     if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
285     $dir = "$ShareName/$1";
286     } else {
287     $dir = $ShareName;
288     }
289     }
290     if ( !defined($Attrib{$dir}) ) {
291     foreach my $d ( keys(%Attrib) ) {
292     next if ( $dir =~ m{^\Q$d/} );
293     attributeWrite($d);
294     }
295     $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress });
296     if ( -f $Attrib{$dir}->fileName("$OutDir/$dir")
297     && !$Attrib{$dir}->read("$OutDir/$dir") ) {
298     printf("Unable to read attribute file %s\n",
299     $Attrib{$dir}->fileName("$OutDir/$dir"));
300     $Errors++;
301     }
302     }
303     if ( $f->{type} == BPC_FTYPE_DIR ) {
304     #
305     # Directory
306     #
307     logFileAction("create", $f) if ( $Conf{XferLogLevel} >= 1 );
308     mkpath("$OutDir/$ShareName/$f->{mangleName}", 0, 0777)
309     if ( !-d "$OutDir/$ShareName/$f->{mangleName}" );
310     } elsif ( $f->{type} == BPC_FTYPE_FILE ) {
311     #
312     # Regular file
313     #
314     my($nRead);
315     #print("Reading $f->{name}, $f->{size} bytes, type $f->{type}\n");
316 dpavlin 316 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
317 dpavlin 1 my $poolWrite = BackupPC::PoolWrite->new($bpc,
318     "$OutDir/$ShareName/$f->{mangleName}",
319     $f->{size}, $Compress);
320     while ( $nRead < $f->{size} ) {
321     my $thisRead = $f->{size} - $nRead < $BufSize
322     ? $f->{size} - $nRead : $BufSize;
323     my $data = TarRead($fh, $thisRead);
324     if ( $data eq "" ) {
325     if ( !$Abort ) {
326     print("Unexpected end of tar archive during read\n");
327     $AbortReason = "Unexpected end of tar archive";
328     $Errors++;
329     }
330     $poolWrite->abort;
331     $Abort = 1;
332     unlink("$OutDir/$ShareName/$f->{mangleName}");
333     print("Removing partial file $f->{name}\n");
334     return;
335     }
336     $poolWrite->write(\$data);
337     $nRead += $thisRead;
338     }
339     my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
340     $f->{size});
341     logFileAction($exist ? "pool" : "create", $f)
342     if ( $Conf{XferLogLevel} >= 1 );
343     TarFlush($fh, $f->{size});
344     } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
345     #
346     # Hardlink to another file. GNU tar is clever about files
347     # that are hardlinks to each other. The first link will be
348     # sent as a regular file. The additional links will be sent
349     # as this type. We store the hardlink just like a symlink:
350     # the link name (path of the linked-to file) is stored in
351     # a plain file.
352     #
353     $f->{size} = length($f->{linkname});
354 dpavlin 316 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
355 dpavlin 1 my $poolWrite = BackupPC::PoolWrite->new($bpc,
356     "$OutDir/$ShareName/$f->{mangleName}",
357     $f->{size}, $Compress);
358     $poolWrite->write(\$f->{linkname});
359     my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
360     $f->{size});
361     logFileAction($exist ? "pool" : "create", $f)
362     if ( $Conf{XferLogLevel} >= 1 );
363     } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
364     #
365     # Symbolic link: write the value of the link to a plain file,
366     # that we pool as usual (ie: we don't create a symlink).
367     # The attributes remember the original file type.
368     # We also change the size to reflect the size of the link
369     # contents.
370     #
371     $f->{size} = length($f->{linkname});
372 dpavlin 316 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
373 dpavlin 1 my $poolWrite = BackupPC::PoolWrite->new($bpc,
374     "$OutDir/$ShareName/$f->{mangleName}",
375     $f->{size}, $Compress);
376     $poolWrite->write(\$f->{linkname});
377     my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
378     $f->{size});
379     logFileAction($exist ? "pool" : "create", $f)
380     if ( $Conf{XferLogLevel} >= 1 );
381     } elsif ( $f->{type} == BPC_FTYPE_CHARDEV
382     || $f->{type} == BPC_FTYPE_BLOCKDEV
383     || $f->{type} == BPC_FTYPE_FIFO ) {
384     #
385     # Special files: for char and block special we write the
386     # major and minor numbers to a plain file, that we pool
387     # as usual. For a pipe file we create an empty file.
388     # The attributes remember the original file type.
389     #
390     my $data;
391     if ( $f->{type} == BPC_FTYPE_FIFO ) {
392     $data = "";
393     } else {
394     $data = "$f->{devmajor},$f->{devminor}";
395     }
396 dpavlin 316 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
397 dpavlin 1 my $poolWrite = BackupPC::PoolWrite->new($bpc,
398     "$OutDir/$ShareName/$f->{mangleName}",
399     length($data), $Compress);
400     $poolWrite->write(\$data);
401     $f->{size} = length($data);
402     my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
403     length($data));
404     logFileAction($exist ? "pool" : "create", $f)
405     if ( $Conf{XferLogLevel} >= 1 );
406     } else {
407     print("Got unknown type $f->{type} for $f->{name}\n");
408     $Errors++;
409     }
410     $Attrib{$dir}->set($file, {
411     type => $f->{type},
412     mode => $f->{mode},
413     uid => $f->{uid},
414     gid => $f->{gid},
415     size => $f->{size},
416     mtime => $f->{mtime},
417     });
418     return 1;
419     }
420    
421     sub attributeWrite
422     {
423     my($d) = @_;
424     my($poolWrite);
425    
426     return if ( !defined($Attrib{$d}) );
427     if ( $Attrib{$d}->fileCount ) {
428     my $data = $Attrib{$d}->writeData;
429     my $fileName = $Attrib{$d}->fileName("$OutDir/$d");
430     my $poolWrite = BackupPC::PoolWrite->new($bpc, $fileName,
431     length($data), $Compress);
432     $poolWrite->write(\$data);
433     processClose($poolWrite, $Attrib{$d}->fileName($d), length($data), 1);
434     }
435     delete($Attrib{$d});
436     }
437    
438     sub processClose
439     {
440     my($poolWrite, $fileName, $origSize, $noStats) = @_;
441     my($exists, $digest, $outSize, $errs) = $poolWrite->close;
442    
443     if ( @$errs ) {
444     print(join("", @$errs));
445     $Errors += @$errs;
446     }
447     if ( !$noStats ) {
448     $TotalFileCnt++;
449     $TotalFileSize += $origSize;
450     }
451     if ( $exists ) {
452     if ( !$noStats ) {
453     $ExistFileCnt++;
454     $ExistFileSize += $origSize;
455     $ExistFileCompSize += $outSize;
456     }
457     } elsif ( $outSize > 0 ) {
458     print(NEW_FILES "$digest $origSize $fileName\n");
459     }
460     return $exists && $origSize > 0;
461     }
462    
463     #
464     # Generate a log file message for a completed file
465     #
466     sub logFileAction
467     {
468     my($action, $f) = @_;
469     my $owner = "$f->{uid}/$f->{gid}";
470     my $name = $f->{name};
471     $name = "." if ( $name eq "" );
472     my $type = (("", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s"))
473     [($f->{mode} & S_IFMT) >> 12];
474     $type = "h" if ( $f->{type} == BPC_FTYPE_HARDLINK );
475    
476     printf(" %-6s %1s%4o %9s %11.0f %s\n",
477     $action,
478     $type,
479     $f->{mode} & 07777,
480     $owner,
481     $f->{size},
482     $name);
483     }
484    
485 dpavlin 316 #
486     # Create the parent directory of $file if necessary
487     #
488     sub pathCreate
489     {
490     my($dir, $fullPath, $file, $f) = @_;
491    
492     #
493     # Get parent directory of each of $dir and $fullPath
494     #
495     $dir =~ s{/[^/]*$}{};
496     $fullPath =~ s{/[^/]*$}{};
497     return if ( -d $fullPath );
498     mkpath($fullPath, 0, 0777);
499     $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress })
500     if ( !defined($Attrib{$dir}) );
501     $Attrib{$dir}->set($file, {
502     type => BPC_FTYPE_DIR,
503     mode => 0755,
504     uid => $f->{uid},
505     gid => $f->{gid},
506     size => 0,
507     mtime => 0,
508     });
509     }
510    
511 dpavlin 1 sub catch_signal
512     {
513     my $sigName = shift;
514    
515     #
516     # The first time we receive a signal we try to gracefully
517     # abort the backup. This allows us to keep a partial dump
518     # with the in-progress file deleted and attribute caches
519     # flushed to disk etc.
520     #
521     print("BackupPC_tarExtract: got signal $sigName\n");
522     if ( !$Abort ) {
523     $Abort++;
524     $AbortReason = "received signal $sigName";
525     return;
526     }
527    
528     #
529     # This is a second signal: time to clean up.
530     #
531     print("BackupPC_tarExtract: quitting on second signal $sigName\n");
532     close(NEW_FILES);
533     exit(1)
534     }
535    
536     mkpath("$OutDir/$ShareName", 0, 0777);
537     open(NEW_FILES, ">>", "$TopDir/pc/$client/NewFileList")
538     || die("can't open $TopDir/pc/$client/NewFileList");
539     binmode(NEW_FILES);
540     binmode(STDIN);
541     1 while ( !$Abort && TarReadFile(*STDIN) );
542     1 while ( !$Abort && sysread(STDIN, my $discard, 1024) );
543    
544     #
545     # Flush out remaining attributes.
546     #
547     foreach my $d ( keys(%Attrib) ) {
548     attributeWrite($d);
549     }
550     close(NEW_FILES);
551    
552     if ( $Abort ) {
553     print("BackupPC_tarExtact aborting ($AbortReason)\n");
554     }
555    
556     #
557     # Report results to BackupPC_dump
558     #
559     print("Done: $Errors errors, $ExistFileCnt filesExist,"
560     . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
561     . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26