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