-#!/bin/perl -T
+#!/bin/perl
#============================================================= -*-perl-*-
#
# BackupPC_tarExtract: extract data from a dump
# Craig Barratt <cbarratt@users.sourceforge.net>
#
# COPYRIGHT
-# Copyright (C) 2001 Craig Barratt
+# Copyright (C) 2001-2003 Craig Barratt
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
#
#========================================================================
#
-# Version 1.6.0_CVS, released 10 Dec 2002.
+# Version 2.1.0_CVS, released 8 Feb 2004.
#
# See http://backuppc.sourceforge.net.
#
#========================================================================
use strict;
+no utf8;
use lib "/usr/local/BackupPC/lib";
use BackupPC::Lib;
use BackupPC::Attrib qw(:all);
print("usage: $0 <host> <shareName> <compressLevel>\n");
exit(1);
}
-if ( $ARGV[0] !~ /^([\w\.-]+)$/ ) {
+if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
print("$0: bad host name '$ARGV[0]'\n");
exit(1);
}
# Copyright 1998 Stephen Zander. All rights reserved.
#
my $tar_unpack_header
- = 'A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12';
+ = 'Z100 A8 A8 A8 A12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
my $tar_header_length = 512;
my $BufSize = 1048576; # 1MB or 2^20
$mode = oct $mode;
$uid = oct $uid;
$gid = oct $gid;
- $size =~ s/^6/2/; # fix bug in smbclient for >=2GB files
- $size =~ s/^7/3/; # fix bug in smbclient for >=2GB files
- $size = oct $size;
+ if ( ord($size) == 128 ) {
+ #
+ # GNU tar extension: for >=8GB files the size is stored
+ # in big endian binary.
+ #
+ $size = 65536 * 65536 * unpack("N", substr($size, 4, 4))
+ + unpack("N", substr($size, 8, 4));
+ } else {
+ #
+ # We used to have a patch here for smbclient 2.2.x. For file
+ # sizes between 2 and 4GB it sent the wrong size. But since
+ # samba 3.0.0 has been released we no longer support this
+ # patch since valid files could have sizes that start with
+ # 6 or 7 in octal (eg: 6-8GB files).
+ #
+ # $size =~ s/^6/2/; # fix bug in smbclient for >=2GB files
+ # $size =~ s/^7/3/; # fix bug in smbclient for >=2GB files
+ #
+ # To avoid integer overflow in case we are in the 4GB - 8GB
+ # range, we do the conversion in two parts.
+ #
+ if ( $size =~ /([0-9]{9,})/ ) {
+ my $len = length($1);
+ $size = oct(substr($1, 0, $len - 8)) * (1 << 24)
+ + oct(substr($1, $len - 8));
+ } else {
+ $size = oct($size);
+ }
+ }
$mtime = oct $mtime;
$chksum = oct $chksum;
$devmajor = oct $devmajor;
}
mkpath("$OutDir/$ShareName", 0, 0777);
-open(NEW_FILES, ">>$TopDir/pc/$host/NewFileList")
+open(NEW_FILES, ">>", "$TopDir/pc/$host/NewFileList")
|| die("can't open $TopDir/pc/$host/NewFileList");
+binmode(NEW_FILES);
+binmode(STDIN);
1 while ( TarReadFile(*STDIN) );
1 while ( sysread(STDIN, my $discard, 1024) );