← Back to branch summary

~ubuntu-branches/ubuntu/hardy/backuppc/hardy-security

« back to all changes in this revision

Viewing changes to bin/BackupPC_tarPCCopy

  • Committer: Bazaar Package Importer
  • Author(s): Steve Kowalik
  • Date: 2007-05-10 15:14:19 UTC
  • mfrom: (0.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070510151419-q6sqqtljkt428vph
Tags: 3.0.0-2ubuntu1
* Merge from Debian unstable.
* Remaining Ubuntu changes:
  - Use LSB functions in the init script, and make /var/run/backuppc if
    needed.
  - Remove dependancy on wwwconfig-common.
  - We like apache 2 more, so move it first to the alternatives list.
  - Bump libfile-rsyncp-perl and rsync from Suggests to Depends.
  - Remove stop script symlinks from rc0 and rc6.
* Ubuntu changes dropped:
  - Don't use wwwconfig-common in post{inst,rm}.
* Don't chown /var/run/backuppc in the postinst.
* Don't move /var/lib/backuppc/conf/* (and then delete) to /etc/backuppc
  in rules, upstream is shipping the config files in /etc/backuppc
  themselves.
* Unfuzzify debian/config.pl.diff.
* Munge Maintainer field as per spec.

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/BackupPC_tarPCCopy
 
1
#!/bin/perl
 
2
#============================================================= -*-perl-*-
 
3
#
 
4
# BackupPC_tarPCCopy: create a tar archive of the PC directory
 
5
# for copying the entire PC data directory.  The archive will
 
6
# contain hardlinks to the pool directory, which should be copied
 
7
# before BackupPC_tarPCCopy is run.
 
8
#
 
9
# DESCRIPTION
 
10
#  
 
11
#   Usage: BackupPC_tarPCCopy [options] files/directories...
 
12
#
 
13
#   Flags:
 
14
#       -c      don't cache inode data (reduces memory usage at the
 
15
#                                       expense of longer run time)
 
16
#
 
17
# AUTHOR
 
18
#   Craig Barratt  <cbarratt@users.sourceforge.net>
 
19
#
 
20
# COPYRIGHT
 
21
#   Copyright (C) 2005  Craig Barratt
 
22
#
 
23
#   This program is free software; you can redistribute it and/or modify
 
24
#   it under the terms of the GNU General Public License as published by
 
25
#   the Free Software Foundation; either version 2 of the License, or
 
26
#   (at your option) any later version.
 
27
#
 
28
#   This program is distributed in the hope that it will be useful,
 
29
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
 
30
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
31
#   GNU General Public License for more details.
 
32
#
 
33
#   You should have received a copy of the GNU General Public License
 
34
#   along with this program; if not, write to the Free Software
 
35
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
36
#
 
37
#========================================================================
 
38
#
 
39
# Version 3.0.0, released 28 Jan 2007.
 
40
#
 
41
# See http://backuppc.sourceforge.net.
 
42
#
 
43
#========================================================================
 
44
 
 
45
use strict;
 
46
no  utf8;
 
47
use lib "__INSTALLDIR__/lib";
 
48
use File::Find;
 
49
use File::Path;
 
50
use Getopt::Std;
 
51
 
 
52
use BackupPC::Lib;
 
53
use BackupPC::Attrib qw(:all);
 
54
use BackupPC::FileZIO;
 
55
use BackupPC::View;
 
56
 
 
57
use constant S_IFMT       => 0170000;   # type of file
 
58
 
 
59
die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
 
60
my $TopDir = $bpc->TopDir();
 
61
my $BinDir = $bpc->BinDir();
 
62
my %Conf   = $bpc->Conf();
 
63
 
 
64
my %opts;
 
65
 
 
66
if ( !getopts("c", \%opts) || @ARGV < 1 ) {
 
67
    print STDERR <<EOF;
 
68
usage: $0 [options] files/directories...
 
69
  Options:
 
70
     -c      don't cache inode data (reduces memory usage at the
 
71
                                     expense of longer run time)
 
72
EOF
 
73
    exit(1);
 
74
}
 
75
 
 
76
#
 
77
# This constant and the line of code below that uses it are borrowed
 
78
# from Archive::Tar.  Thanks to Calle Dybedahl and Stephen Zander.
 
79
# See www.cpan.org.
 
80
#
 
81
# Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
 
82
#                 Copyright 1998 Stephen Zander. All rights reserved.
 
83
#
 
84
my $tar_pack_header
 
85
    = 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
 
86
my $tar_header_length = 512;
 
87
 
 
88
my $BufSize    = 1048576;               # 1MB or 2^20
 
89
my $WriteBuf   = "";
 
90
my $WriteBufSz = ($opts{b} || 20) * $tar_header_length;
 
91
 
 
92
my(%UidCache, %GidCache);
 
93
 
 
94
my($ClientName, $ClientBackups, $ClientBkupNum, $ClientDirAttr, $ClientDir);
 
95
 
 
96
my $FileCnt    = 0;
 
97
my $HLinkCnt   = 0;
 
98
my $ByteCnt    = 0;        
 
99
my $DirCnt     = 0;
 
100
my $ErrorCnt   = 0;       
 
101
my $ClientBkupCompress = 1;
 
102
my $ClientBkupMangle   = 1;
 
103
 
 
104
my %Inode2Path;
 
105
 
 
106
#
 
107
# Write out all the requested files/directories
 
108
#
 
109
binmode(STDOUT);
 
110
my $fh = *STDOUT;
 
111
 
 
112
my $argCnt = 1;
 
113
my $argMax = @ARGV;
 
114
 
 
115
while ( @ARGV ) {
 
116
    my $path = shift(@ARGV);
 
117
 
 
118
    if ( $path !~ m{^\Q$TopDir/\E} ) {
 
119
        print STDERR "Argument $path must be an absolute path starting with $TopDir\n";
 
120
        exit(1);
 
121
    }
 
122
    if ( !-d $path ) {
 
123
        print STDERR "Argument $path does not exist\n";
 
124
        exit(1);
 
125
    }
 
126
 
 
127
    find({wanted => sub { archiveFile($fh) } }, $path);
 
128
 
 
129
    #
 
130
    # To avoid using too much memory for the inode cache,
 
131
    # remove it after each top-level directory is done.
 
132
    #
 
133
    %Inode2Path = ();
 
134
 
 
135
    #
 
136
    # Print some stats
 
137
    #
 
138
    print STDERR "Done $path ($argCnt of $argMax): $DirCnt dirs,"
 
139
               . " $FileCnt files, $HLinkCnt hardlinks\n";
 
140
 
 
141
    $FileCnt    = 0;
 
142
    $HLinkCnt   = 0;
 
143
    $ByteCnt    = 0;        
 
144
    $DirCnt     = 0;
 
145
 
 
146
    $argCnt++;
 
147
}
 
148
 
 
149
#
 
150
# Finish with two null 512 byte headers, and then round out a full
 
151
# block.
 
152
# 
 
153
my $data = "\0" x ($tar_header_length * 2);
 
154
TarWrite($fh, \$data);
 
155
TarWrite($fh, undef);
 
156
 
 
157
if ( $ErrorCnt ) {
 
158
    #
 
159
    # Got errors so exit with a non-zero status
 
160
    #
 
161
    print STDERR "Got $ErrorCnt warnings/errors\n";
 
162
    exit(1);
 
163
}
 
164
exit(0);
 
165
 
 
166
###########################################################################
 
167
# Subroutines
 
168
###########################################################################
 
169
 
 
170
sub archiveFile
 
171
{
 
172
    my($fh) = @_;
 
173
    my($hdr);
 
174
 
 
175
    my @s = stat($_);
 
176
 
 
177
    #
 
178
    # Default type - we'll update later if it is a symlink, hardlink etc
 
179
    #
 
180
    $hdr->{type}     = -d _ ? BPC_FTYPE_DIR
 
181
                     : -f _ ? BPC_FTYPE_FILE
 
182
                     : -1;
 
183
    $hdr->{fullPath} = $File::Find::name;
 
184
    $hdr->{inode}    = $s[1];
 
185
    $hdr->{nlink}    = $s[3];
 
186
    $hdr->{size}     = $s[7];
 
187
    $hdr->{devmajor} = $s[6] >> 8;
 
188
    $hdr->{devminor} = $s[6] & 0xff;
 
189
    $hdr->{uid}      = $s[4];
 
190
    $hdr->{gid}      = $s[5];
 
191
    $hdr->{mode}     = $s[2];
 
192
    $hdr->{mtime}    = $s[9];
 
193
    $hdr->{compress} = 1;
 
194
 
 
195
    if ( $hdr->{fullPath} !~ m{\Q$TopDir\E/pc/(.*)} ) {
 
196
        print STDERR "Can't extract TopDir ($TopDir) from"
 
197
                   . " $hdr->{fullPath}\n";
 
198
        $ErrorCnt++;
 
199
        return;
 
200
    }
 
201
    $hdr->{relPath}  = $1;
 
202
    if ( $hdr->{relPath} =~ m{(.*)/(.*)} ) {
 
203
        $hdr->{name} = $2;
 
204
    } else {
 
205
        $hdr->{name} = $hdr->{relPath};
 
206
    }
 
207
 
 
208
    if ( $hdr->{relPath} =~ m{(.*?)/} ) {
 
209
        my $clientName = $1;
 
210
        if ( $ClientName ne $clientName ) {
 
211
            $ClientName    = $clientName;
 
212
            $ClientBackups = [ $bpc->BackupInfoRead($ClientName) ];
 
213
            #print STDERR "Setting Client to $ClientName\n";
 
214
        }
 
215
        if ( $hdr->{relPath} =~ m{(.*?)/(\d+)/}
 
216
                 || $hdr->{relPath} =~ m{(.*?)/(\d+)$} ) {
 
217
            my $backupNum = $2;
 
218
            if ( $ClientBkupNum != $backupNum ) {
 
219
                my $i;
 
220
                $ClientBkupNum = $backupNum;
 
221
                # print STDERR "Setting ClientBkupNum to $ClientBkupNum\n";
 
222
                for ( $i = 0 ; $i < @$ClientBackups ; $i++ ) {
 
223
                    if ( $ClientBackups->[$i]{num} == $ClientBkupNum ) {
 
224
                        $ClientBkupCompress = $ClientBackups->[$i]{compress};
 
225
                        $ClientBkupMangle   = $ClientBackups->[$i]{mangle};
 
226
                        # print STDERR "Setting $ClientBkupNum compress to $ClientBkupCompress, mangle to $ClientBkupMangle\n";
 
227
                        last;
 
228
                    }
 
229
                }
 
230
            }
 
231
            $hdr->{compress} = $ClientBkupCompress;
 
232
            if ( $hdr->{type} == BPC_FTYPE_FILE && $hdr->{name} =~ /^f/ ) {
 
233
                (my $dir = $hdr->{fullPath}) =~ s{(.*)/.*}{$1};
 
234
                if ( $ClientDir ne $dir ) {
 
235
                    $ClientDir = $dir;
 
236
                    $ClientDirAttr = BackupPC::Attrib->new(
 
237
                                          { compress => $ClientBkupCompress }
 
238
                                     );
 
239
                    if ( -f $ClientDirAttr->fileName($dir)
 
240
                                && !$ClientDirAttr->read($dir) ) {
 
241
                        print STDERR "Can't read attrib file in $dir\n";
 
242
                        $ErrorCnt++;
 
243
                    }
 
244
                }
 
245
                my $name = $hdr->{name};
 
246
                $name = $bpc->fileNameUnmangle($name) if ( $ClientBkupMangle );
 
247
                my $attr = $ClientDirAttr->get($name);
 
248
                if ( defined($attr) ) {
 
249
                    $hdr->{type}     = $attr->{type};
 
250
                    $hdr->{realSize} = $attr->{size}
 
251
                                if ( $attr->{type} == BPC_FTYPE_FILE );
 
252
                }
 
253
                #print STDERR "$hdr->{fullPath} has type $hdr->{type} and real size $hdr->{realSize}\n";
 
254
            }
 
255
        }
 
256
    } else {
 
257
        $hdr->{compress} = 0;
 
258
        $hdr->{realSize} = $hdr->{size};
 
259
    }
 
260
 
 
261
    #print STDERR "$File::Find::name\n";
 
262
 
 
263
    TarWriteFile($hdr, $fh);
 
264
}
 
265
 
 
266
sub UidLookup
 
267
{
 
268
    my($uid) = @_;
 
269
 
 
270
    $UidCache{$uid} = (getpwuid($uid))[0] if ( !exists($UidCache{$uid}) );
 
271
    return $UidCache{$uid};
 
272
}
 
273
 
 
274
sub GidLookup
 
275
{
 
276
    my($gid) = @_;
 
277
 
 
278
    $GidCache{$gid} = (getgrgid($gid))[0] if ( !exists($GidCache{$gid}) );
 
279
    return $GidCache{$gid};
 
280
}
 
281
 
 
282
sub TarWrite
 
283
{
 
284
    my($fh, $dataRef) = @_;
 
285
 
 
286
    if ( !defined($dataRef) ) {
 
287
        #
 
288
        # do flush by padding to a full $WriteBufSz
 
289
        #
 
290
        my $data = "\0" x ($WriteBufSz - length($WriteBuf));
 
291
        $dataRef = \$data;
 
292
    }
 
293
    if ( length($WriteBuf) + length($$dataRef) < $WriteBufSz ) {
 
294
        #
 
295
        # just buffer and return
 
296
        #
 
297
        $WriteBuf .= $$dataRef;
 
298
        return;
 
299
    }
 
300
    my $done = $WriteBufSz - length($WriteBuf);
 
301
    if ( (my $n = syswrite($fh, $WriteBuf . substr($$dataRef, 0, $done)))
 
302
                                != $WriteBufSz ) {
 
303
        print(STDERR "Unable to write to output file ($!) ($n vs $WriteBufSz)\n");
 
304
        exit(1);
 
305
    }
 
306
    while ( $done + $WriteBufSz <= length($$dataRef) ) {
 
307
        if ( (my $n = syswrite($fh, substr($$dataRef, $done, $WriteBufSz)))
 
308
                            != $WriteBufSz ) {
 
309
            print(STDERR "Unable to write to output file ($!) ($n v $WriteBufSz)\n");
 
310
            exit(1);
 
311
        }
 
312
        $done += $WriteBufSz;
 
313
    }
 
314
    $WriteBuf = substr($$dataRef, $done);
 
315
}
 
316
 
 
317
sub TarWritePad
 
318
{
 
319
    my($fh, $size) = @_;
 
320
 
 
321
    if ( $size % $tar_header_length ) {
 
322
        my $data = "\0" x ($tar_header_length - ($size % $tar_header_length));
 
323
        TarWrite($fh, \$data);
 
324
    }
 
325
}
 
326
 
 
327
sub TarWriteHeader
 
328
{
 
329
    my($fh, $hdr) = @_;
 
330
 
 
331
    $hdr->{uname} = UidLookup($hdr->{uid}) if ( !defined($hdr->{uname}) );
 
332
    $hdr->{gname} = GidLookup($hdr->{gid}) if ( !defined($hdr->{gname}) );
 
333
    my $devmajor = defined($hdr->{devmajor}) ? sprintf("%07o", $hdr->{devmajor})
 
334
                                             : "";
 
335
    my $devminor = defined($hdr->{devminor}) ? sprintf("%07o", $hdr->{devminor})
 
336
                                             : "";
 
337
    my $sizeStr;
 
338
    if ( $hdr->{size} >= 2 * 65536 * 65536 ) {
 
339
        #
 
340
        # GNU extension for files >= 8GB: send size in big-endian binary
 
341
        #
 
342
        $sizeStr = pack("c4 N N", 0x80, 0, 0, 0,
 
343
                                  $hdr->{size} / (65536 * 65536),
 
344
                                  $hdr->{size} % (65536 * 65536));
 
345
    } elsif ( $hdr->{size} >= 1 * 65536 * 65536 ) {
 
346
        #
 
347
        # sprintf octal only handles up to 2^32 - 1
 
348
        #
 
349
        $sizeStr = sprintf("%03o", $hdr->{size} / (1 << 24))
 
350
                 . sprintf("%08o", $hdr->{size} % (1 << 24));
 
351
    } else {
 
352
        $sizeStr = sprintf("%011o", $hdr->{size});
 
353
    }
 
354
    my $data = pack($tar_pack_header,
 
355
                     substr($hdr->{name}, 0, 99),
 
356
                     sprintf("%07o", $hdr->{mode}),
 
357
                     sprintf("%07o", $hdr->{uid}),
 
358
                     sprintf("%07o", $hdr->{gid}),
 
359
                     $sizeStr,
 
360
                     sprintf("%011o", $hdr->{mtime}),
 
361
                     "",        #checksum field - space padded by pack("A8")
 
362
                     $hdr->{type},
 
363
                     substr($hdr->{linkname}, 0, 99),
 
364
                     $hdr->{magic} || 'ustar ',
 
365
                     $hdr->{version} || ' ',
 
366
                     $hdr->{uname},
 
367
                     $hdr->{gname},
 
368
                     $devmajor,
 
369
                     $devminor,
 
370
                     ""         # prefix is empty
 
371
                 );
 
372
    substr($data, 148, 7) = sprintf("%06o\0", unpack("%16C*",$data));
 
373
    TarWrite($fh, \$data);
 
374
}
 
375
 
 
376
sub TarWriteFileInfo
 
377
{
 
378
    my($fh, $hdr) = @_;
 
379
 
 
380
    #
 
381
    # Handle long link names (symbolic links)
 
382
    #
 
383
    if ( length($hdr->{linkname}) > 99 ) {
 
384
        my %h;
 
385
        my $data = $hdr->{linkname} . "\0";
 
386
        $h{name} = "././\@LongLink";
 
387
        $h{type} = "K";
 
388
        $h{size} = length($data);
 
389
        TarWriteHeader($fh, \%h);
 
390
        TarWrite($fh, \$data);
 
391
        TarWritePad($fh, length($data));
 
392
    }
 
393
    #
 
394
    # Handle long file names
 
395
    #
 
396
    if ( length($hdr->{name}) > 99 ) {
 
397
        my %h;
 
398
        my $data = $hdr->{name} . "\0";
 
399
        $h{name} = "././\@LongLink";
 
400
        $h{type} = "L";
 
401
        $h{size} = length($data);
 
402
        TarWriteHeader($fh, \%h);
 
403
        TarWrite($fh, \$data);
 
404
        TarWritePad($fh, length($data));
 
405
    }
 
406
    TarWriteHeader($fh, $hdr);
 
407
}
 
408
 
 
409
my $Attr;
 
410
my $AttrDir;
 
411
 
 
412
sub TarWriteFile
 
413
{
 
414
    my($hdr, $fh) = @_;
 
415
 
 
416
    my $tarPath = $hdr->{relPath};
 
417
 
 
418
    $tarPath =~ s{//+}{/}g;
 
419
    $tarPath = "./" . $tarPath if ( $tarPath !~ /^\.\// );
 
420
    $tarPath =~ s{//+}{/}g;
 
421
    $hdr->{name} = $tarPath;
 
422
 
 
423
    if ( $hdr->{type} == BPC_FTYPE_DIR ) {
 
424
        #
 
425
        # Directory: just write the header
 
426
        #
 
427
        $hdr->{name} .= "/" if ( $hdr->{name} !~ m{/$} );
 
428
        TarWriteFileInfo($fh, $hdr);
 
429
        $DirCnt++;
 
430
    } elsif ( $hdr->{type} == BPC_FTYPE_FILE
 
431
            || $hdr->{type} == BPC_FTYPE_HARDLINK
 
432
            || $hdr->{type} == BPC_FTYPE_SYMLINK
 
433
            || $hdr->{type} == BPC_FTYPE_CHARDEV
 
434
            || $hdr->{type} == BPC_FTYPE_BLOCKDEV
 
435
            || $hdr->{type} == BPC_FTYPE_FIFO
 
436
            || $hdr->{type} == BPC_FTYPE_SOCKET ) {
 
437
        #
 
438
        # Underlying file is a regular file: write the header and file
 
439
        #
 
440
        my($data, $dataMD5, $size, $linkName);
 
441
 
 
442
        if ( defined($Inode2Path{$hdr->{inode}}) ) {
 
443
            $linkName = $Inode2Path{$hdr->{inode}};
 
444
            #print STDERR "Got cache hit for $linkName\n";
 
445
        } else {
 
446
            my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0,
 
447
                                            $hdr->{compress});
 
448
            if ( !defined($f) ) {
 
449
                print(STDERR "Unable to open file $hdr->{fullPath}\n");
 
450
                $ErrorCnt++;
 
451
                return;
 
452
            }
 
453
            #
 
454
            # Try to find the hardlink it points to by computing
 
455
            # the pool file digest.
 
456
            #
 
457
            $f->read(\$dataMD5, $BufSize);
 
458
            if ( !defined($hdr->{realSize}) ) {
 
459
                #
 
460
                # Need to get the real size
 
461
                #
 
462
                $size = length($dataMD5);
 
463
                while ( $f->read(\$data, $BufSize) > 0 ) {
 
464
                    $size += length($data);
 
465
                }
 
466
                $hdr->{realSize} = $size;
 
467
            }
 
468
            $f->close();
 
469
            my $md5 = Digest::MD5->new;
 
470
            my $len = length($dataMD5);
 
471
            if ( $hdr->{realSize} < 1048576
 
472
                        && length($dataMD5) != $hdr->{realSize} ) {
 
473
                print(STDERR "File $hdr->{fullPath} has bad size"
 
474
                            . " (expect $hdr->{realSize}, got $len)\n");
 
475
            } else {
 
476
                my $digest = $bpc->Buffer2MD5($md5, $hdr->{realSize},
 
477
                                              \$dataMD5);
 
478
                my $path = $bpc->MD52Path($digest, $hdr->{compress});
 
479
                my $i = -1;
 
480
 
 
481
                # print(STDERR "Looking up $hdr->{fullPath} at $path\n");
 
482
                while ( 1 ) {
 
483
                    my $testPath = $path;
 
484
                    $testPath .= "_$i" if ( $i >= 0 );
 
485
                    last if ( !-f $testPath );
 
486
                    my $inode = (stat(_))[1];
 
487
                    if ( $inode == $hdr->{inode} ) {
 
488
                        #
 
489
                        # Found it!  Just emit a tar hardlink
 
490
                        #
 
491
                        $testPath =~ s{\Q$TopDir\E}{..};
 
492
                        $linkName = $testPath;
 
493
                        last;
 
494
                    }
 
495
                    $i++;
 
496
                }
 
497
            }
 
498
        }
 
499
        if ( defined($linkName) ) {
 
500
            $hdr->{type}     = BPC_FTYPE_HARDLINK;
 
501
            $hdr->{linkname} = $linkName;
 
502
            TarWriteFileInfo($fh, $hdr);
 
503
            $HLinkCnt++;
 
504
            #print STDERR "$hdr->{relPath} matches $testPath\n";
 
505
            if ( !$opts{c} && $hdr->{nlink} > 2 ) {
 
506
                #
 
507
                # add it to the cache if there are more
 
508
                # than 2 links (pool + current file),
 
509
                # since there are more to go
 
510
                #
 
511
                $Inode2Path{$hdr->{inode}} = $linkName;
 
512
            }
 
513
            return;
 
514
        }
 
515
        $size = 0;
 
516
        if ( $hdr->{nlink} > 1 ) {
 
517
            print STDERR "Can't find $hdr->{relPath} in pool, will copy file\n";
 
518
            $ErrorCnt++;
 
519
        }
 
520
        $hdr->{type} = BPC_FTYPE_FILE;
 
521
 
 
522
        my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0, 0);
 
523
        if ( !defined($f) ) {
 
524
            print(STDERR "Unable to open file $hdr->{fullPath}\n");
 
525
            $ErrorCnt++;
 
526
            return;
 
527
        }
 
528
        TarWriteFileInfo($fh, $hdr);
 
529
        while ( $f->read(\$data, $BufSize) > 0 ) {
 
530
            if ( $size + length($data) > $hdr->{size} ) {
 
531
                print(STDERR "Error: truncating $hdr->{fullPath} to"
 
532
                           . " $hdr->{size} bytes\n");
 
533
                $data = substr($data, 0, $hdr->{size} - $size);
 
534
                $ErrorCnt++;
 
535
            }
 
536
            TarWrite($fh, \$data);
 
537
            $size += length($data);
 
538
        }
 
539
        $f->close;
 
540
        if ( $size != $hdr->{size} ) {
 
541
            print(STDERR "Error: padding $hdr->{fullPath} to $hdr->{size}"
 
542
                       . " bytes from $size bytes\n");
 
543
            $ErrorCnt++;
 
544
            while ( $size < $hdr->{size} ) {
 
545
                my $len = $hdr->{size} - $size;
 
546
                $len = $BufSize if ( $len > $BufSize );
 
547
                $data = "\0" x $len;
 
548
                TarWrite($fh, \$data);
 
549
                $size += $len;
 
550
            }
 
551
        }
 
552
        TarWritePad($fh, $size);
 
553
        $FileCnt++;
 
554
        $ByteCnt += $size;
 
555
    } else {
 
556
        print(STDERR "Got unknown type $hdr->{type} for $hdr->{name}\n");
 
557
        $ErrorCnt++;
 
558
    }
 
559
}