7f539154463b11c7b6bb2fddd1626837248bd1e6
[BackupPC.git] / bin / BackupPC_tarExtract
1 #!/bin/perl -T
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  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.0.0_CVS, released 18 Jan 2003.
31 #
32 # See http://backuppc.sourceforge.net.
33 #
34 #========================================================================
35
36 use strict;
37 use lib "/usr/local/BackupPC/lib";
38 use BackupPC::Lib;
39 use BackupPC::Attrib qw(:all);
40 use BackupPC::FileZIO;
41 use BackupPC::PoolWrite;
42 use File::Path;
43
44 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
45 my $TopDir = $bpc->TopDir();
46 my $BinDir = $bpc->BinDir();
47 my %Conf   = $bpc->Conf();
48
49 if ( @ARGV != 3 ) {
50     print("usage: $0 <host> <shareName> <compressLevel>\n");
51     exit(1);
52 }
53 if ( $ARGV[0] !~ /^([\w\.-\s]+)$/ ) {
54     print("$0: bad host name '$ARGV[0]'\n");
55     exit(1);
56 }
57 my $host = $1;
58 if ( $ARGV[1] !~ /^([\w\s\.\/\$-]+)$/ ) {
59     print("$0: bad share name '$ARGV[1]'\n");
60     exit(1);
61 }
62 my $ShareNameUM = $1;
63 my $ShareName = $bpc->fileNameEltMangle($ShareNameUM);
64 if ( $ARGV[2] !~ /^(\d+)$/ ) {
65     print("$0: bad compress level '$ARGV[2]'\n");
66     exit(1);
67 }
68 my $Compress = $1;
69
70 #
71 # This constant and the line of code below that uses it is borrowed
72 # from Archive::Tar.  Thanks to Calle Dybedahl and Stephen Zander.
73 # See www.cpan.org.
74 #
75 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
76 #                 Copyright 1998 Stephen Zander. All rights reserved.
77 #
78 my $tar_unpack_header
79     = 'Z100 A8 A8 A8 A12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
80 my $tar_header_length = 512;
81
82 my $BufSize  = 1048576;     # 1MB or 2^20
83 my $MaxFiles = 20;
84 my $Errors   = 0;
85 my $OutDir   = "$TopDir/pc/$host/new";
86 my %Attrib   = ();
87
88 my $ExistFileCnt      = 0;
89 my $ExistFileSize     = 0;
90 my $ExistFileCompSize = 0;
91 my $TotalFileCnt      = 0;
92 my $TotalFileSize     = 0;
93
94 sub TarRead
95 {
96     my($fh, $totBytes) = @_;
97     my($numBytes, $newBytes, $data);
98
99     $data = "\0" x $totBytes;
100     while ( $numBytes < $totBytes ) {
101         $newBytes = sysread($fh,
102                         substr($data, $numBytes, $totBytes - $numBytes),
103                         $totBytes - $numBytes);
104         if ( $newBytes <= 0 ) {
105             print(STDERR "Unexpected end of tar archive (tot = $totBytes,"
106                    . " num = $numBytes, posn = " . sysseek($fh, 0, 1) . ")\n");
107             $Errors++;
108             return;
109         }
110         $numBytes += $newBytes;
111     }
112     return $data;
113 }
114
115 sub TarReadHeader
116 {
117     my($fh) = @_;
118
119     return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
120     return;
121 }
122
123 sub TarFlush
124 {
125     my($fh, $size) = @_;
126
127     if ( $size % $tar_header_length ) {
128         TarRead($fh, $tar_header_length - ($size % $tar_header_length));
129     }
130 }
131
132 sub TarReadFileInfo
133 {
134     my($fh) = @_;
135     my($head, $longName, $longLink);
136     my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
137        $linkname, $magic, $version, $uname, $gname, $devmajor,
138        $devminor, $prefix);
139
140     while ( 1 ) {
141         $head = TarReadHeader($fh);
142         return if ( $head eq "" || $head eq "\0" x $tar_header_length );
143         ($name,         # string
144             $mode,      # octal number
145             $uid,       # octal number
146             $gid,       # octal number
147             $size,      # octal number
148             $mtime,     # octal number
149             $chksum,    # octal number
150             $type,      # character
151             $linkname,  # string
152             $magic,     # string
153             $version,   # two bytes
154             $uname,     # string
155             $gname,     # string
156             $devmajor,  # octal number
157             $devminor,  # octal number
158             $prefix) = unpack($tar_unpack_header, $head);
159
160         $mode     = oct $mode;
161         $uid      = oct $uid;
162         $gid      = oct $gid;
163         $size     =~ s/^6/2/;       # fix bug in smbclient for >=2GB files
164         $size     =~ s/^7/3/;       # fix bug in smbclient for >=2GB files
165         $size     = oct $size;
166         $mtime    = oct $mtime;
167         $chksum   = oct $chksum;
168         $devmajor = oct $devmajor;
169         $devminor = oct $devminor;
170         $name     = "$prefix/$name" if $prefix;
171         $prefix   = "";
172         substr ($head, 148, 8) = "        ";
173         if (unpack ("%16C*", $head) != $chksum) {
174            print(STDERR "$name: checksum error at "
175                         . sysseek($fh, 0, 1) , "\n");
176            $Errors++;
177         }
178         if ( $type eq "L" ) {
179             $longName = TarRead($fh, $size) || return;
180             # remove trailing NULL
181             $longName = substr($longName, 0, $size - 1);
182             TarFlush($fh, $size);
183             next;
184         } elsif ( $type eq "K" ) {
185             $longLink = TarRead($fh, $size) || return;
186             # remove trailing NULL
187             $longLink = substr($longLink, 0, $size - 1);
188             TarFlush($fh, $size);
189             next;
190         }
191         $name     = $longName if ( defined($longName) );
192         $linkname = $longLink if ( defined($longLink) );
193         $name     =~ s{^\./+}{};
194         $name     =~ s{/+$}{};
195         $name     =~ s{//+}{/}g;
196         return {
197             name       => $name,
198             mangleName => $bpc->fileNameMangle($name),
199             mode       => $mode,
200             uid        => $uid,
201             gid        => $gid,
202             size       => $size,
203             mtime      => $mtime,
204             type       => $type,
205             linkname   => $linkname,
206             devmajor   => $devmajor,
207             devminor   => $devminor,
208         };
209     }
210 }
211
212 sub TarReadFile
213 {
214     my($fh) = @_;
215     my $f = TarReadFileInfo($fh) || return;
216     my($dir, $file);
217
218     if ( $f->{name} eq "" ) {
219         # top-level dir
220         $dir = "";
221         $file = $ShareNameUM;
222     } else {
223         ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1};         # unmangled file
224         if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
225             $dir = "$ShareName/$1";
226         } else {
227             $dir = $ShareName;
228         }
229     }
230     if ( !defined($Attrib{$dir}) ) {
231         foreach my $d ( keys(%Attrib) ) {
232             next if ( $dir =~ m{^\Q$d/} );
233             attributeWrite($d);
234         }
235         $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress });
236         if ( -f $Attrib{$dir}->fileName("$OutDir/$dir")
237                     && !$Attrib{$dir}->read("$OutDir/$dir") ) {
238             printf(STDERR "Unable to read attribute file %s\n",
239                                 $Attrib{$dir}->fileName("$OutDir/$dir"));
240             $Errors++;
241         }
242     }
243     if ( $f->{type} == BPC_FTYPE_DIR ) {
244         #
245         # Directory
246         #
247         mkpath("$OutDir/$ShareName/$f->{mangleName}", 0, 0777)
248                             if ( !-d "$OutDir/$ShareName/$f->{mangleName}" );
249     } elsif ( $f->{type} == BPC_FTYPE_FILE ) {
250         #
251         # Regular file
252         #
253         my($nRead);
254         #print("Reading $f->{name}, $f->{size} bytes, type $f->{type}\n");
255         my $poolWrite = BackupPC::PoolWrite->new($bpc,
256                                          "$OutDir/$ShareName/$f->{mangleName}",
257                                          $f->{size}, $Compress);
258         while ( $nRead < $f->{size} ) {
259             my $thisRead = $f->{size} - $nRead < $BufSize
260                                 ? $f->{size} - $nRead : $BufSize;
261             my $data = TarRead($fh, $thisRead);
262             if ( $data eq "" ) {
263                 print(STDERR "Unexpected end of tar archive during read\n");
264                 $Errors++;
265                 return;
266             }
267             $poolWrite->write(\$data);
268             $nRead += $thisRead;
269         }
270         processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
271         TarFlush($fh, $f->{size});
272     } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
273         #
274         # Hardlink to another file.  GNU tar is clever about files
275         # that are hardlinks to each other.  The first link will be
276         # sent as a regular file.  The additional links will be sent
277         # as this type.  We store the hardlink just like a symlink:
278         # the link name (path of the linked-to file) is stored in
279         # a plain file.
280         #
281         $f->{size} = length($f->{linkname});
282         my $poolWrite = BackupPC::PoolWrite->new($bpc,
283                                          "$OutDir/$ShareName/$f->{mangleName}",
284                                          $f->{size}, $Compress);
285         $poolWrite->write(\$f->{linkname});
286         processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
287     } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
288         #
289         # Symbolic link: write the value of the link to a plain file,
290         # that we pool as usual (ie: we don't create a symlink).
291         # The attributes remember the original file type.
292         # We also change the size to reflect the size of the link
293         # contents.
294         #
295         $f->{size} = length($f->{linkname});
296         my $poolWrite = BackupPC::PoolWrite->new($bpc,
297                                          "$OutDir/$ShareName/$f->{mangleName}",
298                                          $f->{size}, $Compress);
299         $poolWrite->write(\$f->{linkname});
300         processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
301     } elsif ( $f->{type} == BPC_FTYPE_CHARDEV
302            || $f->{type} == BPC_FTYPE_BLOCKDEV
303            || $f->{type} == BPC_FTYPE_FIFO ) {
304         #
305         # Special files: for char and block special we write the
306         # major and minor numbers to a plain file, that we pool
307         # as usual.  For a pipe file we create an empty file.
308         # The attributes remember the original file type.
309         #
310         my $data;
311         if ( $f->{type} == BPC_FTYPE_FIFO ) {
312             $data = "";
313         } else {
314             $data = "$f->{devmajor},$f->{devminor}";
315         }
316         my $poolWrite = BackupPC::PoolWrite->new($bpc,
317                                          "$OutDir/$ShareName/$f->{mangleName}",
318                                          length($data), $Compress);
319         $poolWrite->write(\$data);
320         $f->{size} = length($data);
321         processClose($poolWrite, "$ShareName/$f->{mangleName}", length($data));
322     } else {
323         print("Got unknown type $f->{type} for $f->{name}\n");
324         $Errors++;
325     }
326     $Attrib{$dir}->set($file, {
327                             type  => $f->{type},
328                             mode  => $f->{mode},
329                             uid   => $f->{uid},
330                             gid   => $f->{gid},
331                             size  => $f->{size},
332                             mtime => $f->{mtime},
333                        });
334     return 1;
335 }
336
337 sub attributeWrite
338 {
339     my($d) = @_;
340     my($poolWrite);
341
342     return if ( !defined($Attrib{$d}) );
343     if ( $Attrib{$d}->fileCount ) {
344         my $data = $Attrib{$d}->writeData;
345         my $fileName = $Attrib{$d}->fileName("$OutDir/$d");
346         my $poolWrite = BackupPC::PoolWrite->new($bpc, $fileName,
347                                          length($data), $Compress);
348         $poolWrite->write(\$data);
349         processClose($poolWrite, $Attrib{$d}->fileName($d), length($data));
350     }
351     delete($Attrib{$d});
352 }
353
354 sub processClose
355 {
356     my($poolWrite, $fileName, $origSize) = @_;
357     my($exists, $digest, $outSize, $errs) = $poolWrite->close;
358
359     if ( @$errs ) {
360         print(STDERR join("", @$errs));
361         $Errors += @$errs;
362     }
363     $TotalFileCnt++;
364     $TotalFileSize += $origSize;
365     if ( $exists ) {
366         $ExistFileCnt++;
367         $ExistFileSize     += $origSize;
368         $ExistFileCompSize += $outSize;
369     } elsif ( $outSize > 0 ) {
370         print(NEW_FILES "$digest $origSize $fileName\n");
371     }
372 }
373
374 mkpath("$OutDir/$ShareName", 0, 0777);
375 open(NEW_FILES, ">>", "$TopDir/pc/$host/NewFileList")
376                  || die("can't open $TopDir/pc/$host/NewFileList");
377 1 while ( TarReadFile(*STDIN) );
378 1 while ( sysread(STDIN, my $discard, 1024) );
379
380 #
381 # Flush out remaining attributes.
382 #
383 foreach my $d ( keys(%Attrib) ) {
384     attributeWrite($d);
385 }
386 close(NEW_FILES);
387
388 #
389 # Report results to BackupPC_dump
390 #
391 print("Done: $Errors errors, $ExistFileCnt filesExist,"
392     . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
393     . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");