"Fossies" - the Fresh Open Source Software Archive 
Member "BackupPC-4.4.0/bin/BackupPC_tarCreate" (20 Jun 2020, 23859 Bytes) of package /linux/privat/BackupPC-4.4.0.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
See also the latest
Fossies "Diffs" side-by-side code changes report for "BackupPC_tarCreate":
4.3.2_vs_4.4.0.
1 #!/usr/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_tarCreate: create a tar archive of an existing dump
5 # for restore on a client.
6 #
7 # DESCRIPTION
8 #
9 # Usage: BackupPC_tarCreate [options] files/directories...
10 #
11 # Flags:
12 # Required options:
13 #
14 # -h host Host from which the tar archive is created.
15 # -n dumpNum Dump number from which the tar archive is created.
16 # A negative number means relative to the end (eg -1
17 # means the most recent dump, -2 2nd most recent etc).
18 # -s shareName Share name from which the tar archive is created,
19 # or "*" to mean all shares.
20 #
21 # Other options:
22 # -t print summary totals
23 # -r pathRemove path prefix that will be replaced with pathAdd
24 # -p pathAdd new path prefix
25 # -b BLOCKS output write buffer size in 512-byte blocks (default 20; same as tar)
26 # -w readBufSz buffer size for reading files (default 1048576 = 1MB)
27 # -e charset charset for encoding file names (default: value of
28 # $Conf{ClientCharset} when backup was done)
29 # -l just print a file listing; don't generate an archive
30 # -L just print a detailed file listing; don't generate an archive
31 # -m run even if a backup on this host is running
32 # (specifically, don't take the server host mutex)
33 #
34 # The -h, -n and -s options specify which dump is used to generate
35 # the tar archive. The -r and -p options can be used to relocate
36 # the paths in the tar archive so extracted files can be placed
37 # in a location different from their original location.
38 #
39 # AUTHOR
40 # Craig Barratt <cbarratt@users.sourceforge.net>
41 #
42 # COPYRIGHT
43 # Copyright (C) 2001-2020 Craig Barratt
44 #
45 # This program is free software: you can redistribute it and/or modify
46 # it under the terms of the GNU General Public License as published by
47 # the Free Software Foundation, either version 3 of the License, or
48 # (at your option) any later version.
49 #
50 # This program is distributed in the hope that it will be useful,
51 # but WITHOUT ANY WARRANTY; without even the implied warranty of
52 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
53 # GNU General Public License for more details.
54 #
55 # You should have received a copy of the GNU General Public License
56 # along with this program. If not, see <http://www.gnu.org/licenses/>.
57 #
58 #========================================================================
59 #
60 # Version 4.4.0, released 20 Jun 2020.
61 #
62 # See http://backuppc.sourceforge.net.
63 #
64 #========================================================================
65
66 use strict;
67 no utf8;
68
69 use lib "__INSTALLDIR__/lib";
70 use File::Path;
71 use Getopt::Std;
72 use Encode qw/from_to/;
73 use Data::Dumper;
74
75 use BackupPC::Lib;
76 use BackupPC::XS qw( :all );
77 use BackupPC::View;
78
79 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
80 my %Conf = $bpc->Conf();
81
82 my %opts;
83
84 if ( !getopts("Lltme:h:n:p:r:s:b:w:", \%opts) || @ARGV < 1 ) {
85 print STDERR <<EOF;
86 usage: $0 [options] files/directories...
87 Required options:
88 -h host host from which the tar archive is created
89 -n dumpNum dump number from which the tar archive is created
90 A negative number means relative to the end (eg -1
91 means the most recent dump, -2 2nd most recent etc).
92 -s shareName share name from which the tar archive is created,
93 or "*" to mean all shares
94
95 Other options:
96 -t print summary totals
97 -r pathRemove path prefix that will be replaced with pathAdd
98 -p pathAdd new path prefix
99 -b BLOCKS output write buffer size in 512-byte blocks (default 20; same as tar)
100 -w readBufSz buffer size for reading files (default 1048576 = 1MB)
101 -e charset charset for encoding file names (default: value of
102 \$Conf{ClientCharset} when backup was done)
103 -l just print a file listing; don't generate an archive
104 -L just print a detailed file listing; don't generate an archive
105 -m force running even if a backup on this host is running
106 (specifically, don't take the server host mutex)
107 EOF
108 exit(1);
109 }
110
111 my $Host;
112 if ( $opts{h} !~ m{(^|/)\.\.(/|$)} && $opts{h} =~ /^([\w@.\s-]+)$/ ) {
113 $Host = $1;
114 } else {
115 print(STDERR "$0: bad host name '$opts{h}'\n");
116 exit(1);
117 }
118
119 if ( $opts{n} !~ /^(-?\d+)$/ ) {
120 print(STDERR "$0: bad dump number '$opts{n}'\n");
121 exit(1);
122 }
123 if ( !$opts{m}
124 && !defined($bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}))
125 && (my $status = $bpc->ServerMesg("hostMutex $Host 1 BackupPC_tarCreate")) =~ /fail/ ) {
126 print(STDERR "$0: $status (use -m option to force running)\n");
127 exit(1);
128 }
129
130 my $Num = $opts{n};
131
132 my @Backups = $bpc->BackupInfoRead($Host);
133 my $FileCnt = 0;
134 my $ByteCnt = 0;
135 my $DirCnt = 0;
136 my $SpecialCnt = 0;
137 my $ErrorCnt = 0;
138
139 my $i;
140
141 $Num = $Backups[@Backups + $Num]{num} if ( -@Backups <= $Num && $Num < 0 );
142 for ( $i = 0 ; $i < @Backups ; $i++ ) {
143 last if ( $Backups[$i]{num} == $Num );
144 }
145 if ( $i >= @Backups ) {
146 print(STDERR "$0: bad backup number $Num for host $Host\n");
147 exit(1);
148 }
149
150 my $Charset = $Backups[$i]{charset};
151 $Charset = $opts{e} if ( $opts{e} ne "" );
152 my $PreV4 = ($Backups[$i]{version} eq "" || $Backups[$i]{version} =~ /^[23]\./) ? 1 : 0;
153
154 my $PathRemove = $1 if ( $opts{r} =~ /(.+)/ );
155 my $PathAdd = $1 if ( $opts{p} =~ /(.+)/ );
156 if ( $opts{s} =~ m{(^|/)\.\.(/|$)} ) {
157 print(STDERR "$0: bad share name '$opts{s}'\n");
158 exit(1);
159 }
160
161 our $ShareName = $opts{s};
162 our $view = BackupPC::View->new($bpc, $Host, \@Backups);
163
164 #
165 # This constant and the line of code below that uses it are borrowed
166 # from Archive::Tar. Thanks to Calle Dybedahl and Stephen Zander.
167 # See www.cpan.org.
168 #
169 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
170 # Copyright 1998 Stephen Zander. All rights reserved.
171 #
172 my $tar_pack_header = 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
173 my $tar_unpack_header = 'Z100 A8 A8 A8 a12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
174 my $tar_header_length = 512;
175
176 my $BufSize = $opts{w} || 1048576; # 1MB or 2^20
177 my $WriteBuf = "";
178 my $WriteBufSz = ($opts{b} || 20) * $tar_header_length;
179
180 my(%UidCache, %GidCache);
181 my(%HardLinkExtraFiles, @HardLinks, %Inode2File);
182
183 #
184 # Write out all the requested files/directories
185 #
186 binmode(STDOUT);
187 my $fh = *STDOUT;
188 if ( $ShareName eq "*" ) {
189 my $PathRemoveOrig = $PathRemove;
190 my $PathAddOrig = $PathAdd;
191 foreach $ShareName ( $view->shareList($Num) ) {
192 #print(STDERR "Doing share ($ShareName)\n");
193 $PathRemove = "/" if ( !defined($PathRemoveOrig) );
194 ($PathAdd = "/$ShareName/$PathAddOrig") =~ s{//+}{/}g;
195 foreach my $dir ( @ARGV ) {
196 archiveWrite($fh, $dir);
197 }
198 archiveWriteHardLinks($fh);
199 }
200 } else {
201 foreach my $dir ( @ARGV ) {
202 archiveWrite($fh, $dir);
203 }
204 archiveWriteHardLinks($fh);
205 }
206
207 if ( !$opts{l} && !$opts{L} ) {
208 #
209 # Finish with two null 512 byte headers, and then round out a full
210 # block.
211 #
212 my $data = "\0" x ($tar_header_length * 2);
213 TarWrite($fh, \$data);
214 TarWrite($fh, undef);
215 }
216
217 #
218 # print out totals if requested
219 #
220 if ( $opts{t} ) {
221 print STDERR "Done: $FileCnt files, $ByteCnt bytes, $DirCnt dirs,", " $SpecialCnt specials, $ErrorCnt errors\n";
222 }
223 if ( $ErrorCnt && !$FileCnt && !$DirCnt ) {
224 #
225 # Got errors, with no files or directories; exit with non-zero
226 # status
227 #
228 exit(1);
229 }
230 exit(0);
231
232 ###########################################################################
233 # Subroutines
234 ###########################################################################
235
236 sub archiveWrite
237 {
238 my($fh, $dir, $tarPathOverride) = @_;
239
240 if ( $dir =~ m{(^|/)\.\.(/|$)} ) {
241 print(STDERR "$0: bad directory '$dir'\n");
242 $ErrorCnt++;
243 return;
244 }
245 $dir = "/" if ( $dir eq "." );
246 #print(STDERR "calling find with $Num, $ShareName, $dir\n");
247 if ( $view->find($Num, $ShareName, $dir, 0, \&TarWriteFile, $fh, $tarPathOverride) < 0 ) {
248 print(STDERR "$0: bad share or directory '$ShareName/$dir'\n");
249 $ErrorCnt++;
250 return;
251 }
252 }
253
254 #
255 # Write out any hardlinks (if any); only for <= 3.x backups.
256 #
257 sub archiveWriteHardLinks
258 {
259 my($fh) = @_;
260
261 return if ( !$PreV4 );
262 foreach my $hdr ( @HardLinks ) {
263 $hdr->{size} = 0;
264 my $name = $hdr->{linkname};
265 $name =~ s{^\./}{/};
266 if ( defined($HardLinkExtraFiles{$name}) ) {
267 $hdr->{linkname} = $HardLinkExtraFiles{$name};
268 }
269 if ( defined($PathRemove)
270 && substr($hdr->{linkname}, 0, length($PathRemove) + 1) eq ".$PathRemove" ) {
271 substr($hdr->{linkname}, 0, length($PathRemove) + 1) = ".$PathAdd";
272 }
273 TarWriteFileInfo($fh, $hdr);
274 }
275 @HardLinks = ();
276 %HardLinkExtraFiles = ();
277 }
278
279 sub UidLookup
280 {
281 my($uid) = @_;
282
283 $UidCache{$uid} = (getpwuid($uid))[0] if ( !exists($UidCache{$uid}) );
284 return $UidCache{$uid};
285 }
286
287 sub GidLookup
288 {
289 my($gid) = @_;
290
291 $GidCache{$gid} = (getgrgid($gid))[0] if ( !exists($GidCache{$gid}) );
292 return $GidCache{$gid};
293 }
294
295 sub TarWrite
296 {
297 my($fh, $dataRef) = @_;
298
299 if ( !defined($dataRef) ) {
300 #
301 # do flush by padding to a full $WriteBufSz
302 #
303 my $data = "\0" x ($WriteBufSz - length($WriteBuf));
304 $dataRef = \$data;
305 }
306 if ( length($WriteBuf) + length($$dataRef) < $WriteBufSz ) {
307 #
308 # just buffer and return
309 #
310 $WriteBuf .= $$dataRef;
311 return;
312 }
313 my $done = $WriteBufSz - length($WriteBuf);
314 if ( syswrite($fh, $WriteBuf . substr($$dataRef, 0, $done)) != $WriteBufSz ) {
315 print(STDERR "Unable to write to output file ($!)\n");
316 exit(1);
317 }
318 while ( $done + $WriteBufSz <= length($$dataRef) ) {
319 if ( syswrite($fh, substr($$dataRef, $done, $WriteBufSz)) != $WriteBufSz ) {
320 print(STDERR "Unable to write to output file ($!)\n");
321 exit(1);
322 }
323 $done += $WriteBufSz;
324 }
325 $WriteBuf = substr($$dataRef, $done);
326 }
327
328 sub TarWritePad
329 {
330 my($fh, $size) = @_;
331
332 if ( $size % $tar_header_length ) {
333 my $data = "\0" x ($tar_header_length - ($size % $tar_header_length));
334 TarWrite($fh, \$data);
335 }
336 }
337
338 sub TarWriteHeader
339 {
340 my($fh, $hdr) = @_;
341
342 $hdr->{uname} = UidLookup($hdr->{uid}) if ( !defined($hdr->{uname}) );
343 $hdr->{gname} = GidLookup($hdr->{gid}) if ( !defined($hdr->{gname}) );
344 my $devmajor =
345 defined($hdr->{devmajor})
346 ? sprintf("%07o", $hdr->{devmajor})
347 : "";
348 my $devminor =
349 defined($hdr->{devminor})
350 ? sprintf("%07o", $hdr->{devminor})
351 : "";
352 my $data = pack(
353 $tar_pack_header,
354 substr($hdr->{name}, 0, 99),
355 sprintf("%07o", $hdr->{mode}),
356 sprintf("%07o", $hdr->{uid}),
357 sprintf("%07o", $hdr->{gid}),
358 sprintf("%011o", $hdr->{size}),
359 sprintf("%011o", $hdr->{mtime}),
360 "", #checksum field - space padded by pack("A8")
361 $hdr->{type},
362 substr($hdr->{linkname}, 0, 99),
363 $hdr->{magic} || 'ustar ',
364 $hdr->{version} || ' ',
365 $hdr->{uname},
366 $hdr->{gname},
367 $devmajor,
368 $devminor,
369 "" # prefix is empty
370 );
371 #
372 # now unpack it to see which fields weren't represented correctly,
373 # and if there are any we generate a pax header
374 #
375 my @paxFlds;
376 my(
377 $name, # string
378 $mode, # octal number
379 $uid, # octal number
380 $gid, # octal number
381 $size, # octal number
382 $mtime, # octal number
383 $chksum, # octal number
384 $type, # character
385 $linkname, # string
386 $magic, # string
387 $version, # two bytes
388 $uname, # string
389 $gname, # string
390 $devmajor, # octal number
391 $devminor, # octal number
392 $prefix
393 ) = unpack($tar_unpack_header, $data);
394 push(@paxFlds, "path=$hdr->{name}") if ( $name ne $hdr->{name} );
395 push(@paxFlds, "linkpath=$hdr->{linkname}") if ( $linkname ne $hdr->{linkname} );
396 push(@paxFlds, "size=$hdr->{size}") if ( oct($size) != $hdr->{size} );
397 push(@paxFlds, "mtime=$hdr->{mtime}") if ( oct($mtime) != $hdr->{mtime} );
398 push(@paxFlds, "uid=$hdr->{uid}") if ( oct($uid) != $hdr->{uid} );
399 push(@paxFlds, "gid=$hdr->{gid}") if ( oct($uid) != $hdr->{gid} );
400 push(@paxFlds, "uname=$hdr->{uname}") if ( $uname ne $hdr->{uname} );
401 push(@paxFlds, "gname=$hdr->{gname}") if ( $gname ne $hdr->{gname} );
402
403 if ( ref($hdr->{xattr}) eq 'HASH' ) {
404
405 # include xattr and acl using gnu tar naming convention
406 foreach my $name ( keys(%{$hdr->{xattr}}) ) {
407
408 # Skip rsync acls; should try to figure out binary rsync acls, and map
409 # then to ascii version used by tar...
410 next if ( $name eq "user.rsync.%aacl" || $name eq "user.rsync.%dacl" );
411 if ( $name eq "user.gtar.%aacl" ) {
412 push(@paxFlds, "SCHILY.acl.access=" . $hdr->{xattr}{$name});
413 } elsif ( $name eq "user.gtar.%dacl" ) {
414 push(@paxFlds, "SCHILY.acl.default=" . $hdr->{xattr}{$name});
415 } else {
416 push(@paxFlds, "SCHILY.xattr.$name=" . $hdr->{xattr}{$name});
417 }
418 }
419 }
420 if ( @paxFlds ) {
421 #
422 # Some fields don't match - we need to generate a pax header
423 #
424 my $paxData;
425 foreach my $fld ( @paxFlds ) {
426
427 # the length includes the string length...
428 my $len = sprintf("%d", length($fld) + 3); # at least 1 digit + space + \n
429 my $len2 = sprintf("%d", length($fld) + length($len) + 2); # + space + \n
430 if ( length($len2) != length($len) ) {
431
432 # rollover: adding length requires one more digit in length
433 $len2 = sprintf("%d", length($fld) + length($len2) + 2);
434 }
435 $paxData .= "$len2 " . $fld . "\n";
436 }
437 my $paxHdrData = pack(
438 $tar_pack_header,
439 substr("./PaxHeaders/$hdr->{name}", 0, 99),
440 sprintf("%07o", $hdr->{mode}),
441 sprintf("%07o", $hdr->{uid}),
442 sprintf("%07o", $hdr->{gid}),
443 sprintf("%011o", length($paxData)),
444 sprintf("%011o", $hdr->{mtime}),
445 "", #checksum field - space padded by pack("A8")
446 "x",
447 substr($hdr->{linkname}, 0, 99),
448 $hdr->{magic} || 'ustar ',
449 $hdr->{version} || ' ',
450 $hdr->{uname},
451 $hdr->{gname},
452 $devmajor,
453 $devminor,
454 "" # prefix is empty
455 );
456 substr($paxHdrData, 148, 7) = sprintf("%06o\0", unpack("%16C*", $paxHdrData));
457 TarWrite($fh, \$paxHdrData);
458 TarWrite($fh, \$paxData);
459 TarWritePad($fh, length($paxData));
460 }
461 substr($data, 148, 7) = sprintf("%06o\0", unpack("%16C*", $data));
462 TarWrite($fh, \$data);
463 }
464
465 sub TarWriteFileInfo
466 {
467 my($fh, $hdr) = @_;
468
469 #
470 # Convert path names to requested (eg: client) charset
471 #
472 if ( $Charset ne "" ) {
473 from_to($hdr->{name}, "utf8", $Charset);
474 from_to($hdr->{linkname}, "utf8", $Charset);
475 }
476
477 if ( $opts{l} ) {
478 print($hdr->{name} . "\n");
479 return;
480 } elsif ( $opts{L} ) {
481 my $owner = "$hdr->{uid}/$hdr->{gid}";
482
483 my $name = $hdr->{name};
484
485 if ( $hdr->{type} == BPC_FTYPE_SYMLINK ) {
486 $name .= " -> $hdr->{linkname}";
487 }
488 $name =~ s/\n/\\n/g;
489
490 printf("%6o %9s %11.0f %s\n", $hdr->{mode}, $owner, $hdr->{size}, $name);
491 return;
492 }
493
494 TarWriteHeader($fh, $hdr);
495 }
496
497 sub TarWriteFile
498 {
499 my($hdr, $fh, $tarPathOverride) = @_;
500
501 my $tarPath = $hdr->{relPath};
502 $tarPath = $tarPathOverride if ( defined($tarPathOverride) );
503
504 $tarPath =~ s{//+}{/}g;
505 if ( defined($PathRemove)
506 && substr($tarPath, 0, length($PathRemove)) eq $PathRemove ) {
507 substr($tarPath, 0, length($PathRemove)) = $PathAdd;
508 }
509 $tarPath = "./" . $tarPath if ( $tarPath !~ /^\.\// );
510 $tarPath =~ s{//+}{/}g;
511 $hdr->{name} = $tarPath;
512
513 if ( !$PreV4 && $hdr->{nlinks} > 0 && defined($hdr->{inode}) ) {
514 if ( defined($Inode2File{$hdr->{inode}}) ) {
515 #
516 # Later inodes: emit a hardlink to an existing file in the archive
517 # TODO: do path rewrite on link path?
518 #
519 $hdr->{size} = 0;
520 $hdr->{type} = BPC_FTYPE_HARDLINK;
521 $hdr->{linkname} = $Inode2File{$hdr->{inode}}{name};
522 TarWriteFileInfo($fh, $hdr);
523 return;
524 } else {
525 #
526 # First time: remember the data for this inode and dump
527 # the file in its original form.
528 #
529 $Inode2File{$hdr->{inode}} = {%$hdr};
530 }
531 }
532
533 if ( $hdr->{type} == BPC_FTYPE_DIR ) {
534 #
535 # Directory: just write the header
536 #
537 $hdr->{name} .= "/" if ( $hdr->{name} !~ m{/$} );
538 TarWriteFileInfo($fh, $hdr);
539 $DirCnt++;
540 } elsif ( $hdr->{type} == BPC_FTYPE_FILE ) {
541 my($data, $size);
542 #
543 # Regular file: write the header and file
544 #
545 my $f = BackupPC::XS::FileZIO::open($hdr->{fullPath}, 0, $hdr->{compress});
546 if ( !defined($f) ) {
547 print(STDERR "Unable to open file $hdr->{fullPath} (for $hdr->{name})\n");
548 $ErrorCnt++;
549 return;
550 }
551 TarWriteFileInfo($fh, $hdr);
552 if ( $opts{l} || $opts{L} ) {
553 $size = $hdr->{size};
554 } else {
555 while ( $f->read(\$data, $BufSize) > 0 ) {
556 if ( $size + length($data) > $hdr->{size} ) {
557 print(STDERR "Error: truncating $hdr->{fullPath} to $hdr->{size} bytes (for $hdr->{name})\n");
558 $data = substr($data, 0, $hdr->{size} - $size);
559 $ErrorCnt++;
560 }
561 TarWrite($fh, \$data);
562 $size += length($data);
563 }
564 $f->close;
565 if ( $size != $hdr->{size} ) {
566 print(STDERR "Error: padding $hdr->{fullPath} to $hdr->{size}"
567 . " bytes from $size bytes (for $hdr->{name})\n");
568 $ErrorCnt++;
569 while ( $size < $hdr->{size} ) {
570 my $len = $hdr->{size} - $size;
571 $len = $BufSize if ( $len > $BufSize );
572 $data = "\0" x $len;
573 TarWrite($fh, \$data);
574 $size += $len;
575 }
576 }
577 TarWritePad($fh, $size);
578 }
579 $FileCnt++;
580 $ByteCnt += $size;
581 } elsif ( $PreV4 && $hdr->{type} == BPC_FTYPE_HARDLINK ) {
582 #
583 # Note: the meaning of this type changed between BackupPC <= v3.x
584 # and >= 4.x.
585 #
586 # In 3.x a hardlink is stored like a symlink: the contents
587 # of the "file" is the path to the linked-to file.
588 #
589 # In 4.x+ a hardlink's attributes are stored with the
590 # inode, and the real attributes are stored by inode
591 # for all files with nlinks >= 1.
592 #
593 # The 4.x case is handled above.
594 #
595 # TODO: do path rewrite on link path?
596 #
597 # Hardlink file: either write a hardlink or the complete file
598 # depending upon whether the linked-to file will be written
599 # to the archive.
600 #
601 # Start by reading the contents of the link.
602 #
603 my $f = BackupPC::XS::FileZIO::open($hdr->{fullPath}, 0, $hdr->{compress});
604 if ( !defined($f) ) {
605 print(STDERR "Unable to open file $hdr->{fullPath} (for $hdr->{name})\n");
606 $ErrorCnt++;
607 return;
608 }
609 my $data;
610 while ( $f->read(\$data, $BufSize) > 0 ) {
611 $hdr->{linkname} .= $data;
612 }
613 $f->close;
614 #
615 # Check @ARGV and the list of hardlinked files we have explicitly
616 # dumped to see if we have dumped this file or not
617 #
618 my $done = 0;
619 my $name = $hdr->{linkname};
620 $name =~ s{^\.?/+}{/};
621 $name = "/$name" if ( $name !~ m{^/} );
622 if ( defined($HardLinkExtraFiles{$name}) ) {
623 $done = 1;
624 } else {
625 foreach my $arg ( @ARGV ) {
626 $arg = "/" if ( $arg eq "." );
627 $arg =~ s{^\.?/+}{/};
628 $arg =~ s{/+$}{};
629 $done = 1 if ( $name eq $arg || $name =~ /^\Q$arg\// || $arg eq "" );
630 }
631 }
632 if ( $done ) {
633 #
634 # Target file will be or was written, so just remember
635 # the hardlink so we can dump it later.
636 #
637 push(@HardLinks, $hdr);
638 $SpecialCnt++;
639 } else {
640 #
641 # Have to dump the original file. Just call the top-level
642 # routine, so that we save the hassle of dealing with
643 # mangling, merging and attributes.
644 #
645 my $name = $hdr->{linkname};
646 $name =~ s{^\./}{/};
647 $HardLinkExtraFiles{$name} = $hdr->{name};
648 archiveWrite($fh, $name, $hdr->{name});
649 }
650 } elsif ( $hdr->{type} == BPC_FTYPE_SYMLINK ) {
651 #
652 # Symbolic link: read the symbolic link contents into the header
653 # and write the header.
654 # TODO: do path rewrite on link path?
655 #
656 my $f = BackupPC::XS::FileZIO::open($hdr->{fullPath}, 0, $hdr->{compress});
657 if ( !defined($f) ) {
658 print(STDERR "Unable to open symlink file $hdr->{fullPath} (for $hdr->{name})\n");
659 $ErrorCnt++;
660 return;
661 }
662 my $data;
663 while ( $f->read(\$data, $BufSize) > 0 ) {
664 $hdr->{linkname} .= $data;
665 }
666 $f->close;
667 $hdr->{size} = 0;
668 TarWriteFileInfo($fh, $hdr);
669 $SpecialCnt++;
670 } elsif ( $hdr->{type} == BPC_FTYPE_CHARDEV
671 || $hdr->{type} == BPC_FTYPE_BLOCKDEV
672 || $hdr->{type} == BPC_FTYPE_FIFO ) {
673 #
674 # Special files: for char and block special we read the
675 # major and minor numbers from a plain file.
676 #
677 if ( $hdr->{type} != BPC_FTYPE_FIFO ) {
678 my $f = BackupPC::XS::FileZIO::open($hdr->{fullPath}, 0, $hdr->{compress});
679 my $data;
680 if ( !defined($f) || $f->read(\$data, $BufSize) < 0 ) {
681 print(STDERR "Unable to open/read char/block special file $hdr->{fullPath} (for $hdr->{name})\n");
682 $f->close if ( defined($f) );
683 $ErrorCnt++;
684 return;
685 }
686 $f->close;
687 if ( $data =~ /(\d+),(\d+)/ ) {
688 $hdr->{devmajor} = $1;
689 $hdr->{devminor} = $2;
690 }
691 }
692 $hdr->{size} = 0;
693 TarWriteFileInfo($fh, $hdr);
694 $SpecialCnt++;
695 } elsif ( $hdr->{type} == BPC_FTYPE_SOCKET || $hdr->{type} == BPC_FTYPE_UNKNOWN ) {
696 #
697 # ignore these two file types - these are dynamic file types created
698 # by applications as needed
699 #
700 } else {
701 print(STDERR "Got unknown type $hdr->{type} for $hdr->{name}\n");
702 $ErrorCnt++;
703 }
704 }