32044f6d05bd2fdd5e729fc9f305462153509596
[BackupPC.git] / bin / BackupPC_tarExtract
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 # Version 2.1.0, released 20 Jun 2004.
31 #
32 # See http://backuppc.sourceforge.net.
33 #
34 #========================================================================
35
36 use strict;
37 no  utf8;
38 use lib "/usr/local/BackupPC/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         pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
317         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         pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
355         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         pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
373         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         pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $file, $f);
397         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 #
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 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");