* Added Italian translation, it.pm, from Lorenzo Cappelletti

[BackupPC.git] / bin / BackupPC_tarExtract

diff --git a/bin/BackupPC_tarExtract b/bin/BackupPC_tarExtract
index 06eaf73..9a2872b 100755 (executable)
--- a/bin/BackupPC_tarExtract
+++ b/bin/BackupPC_tarExtract
@@ -1,4 +1,4 @@
-#!/bin/perl -T
+#!/bin/perl
 #============================================================= -*-perl-*-
 #
 # BackupPC_tarExtract: extract data from a dump
@@ -9,7 +9,7 @@
 #   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
@@ -27,13 +27,14 @@
 #
 #========================================================================
 #
-# 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);
@@ -50,7 +51,7 @@ if ( @ARGV != 3 ) {
     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);
 }
@@ -76,7 +77,7 @@ my $Compress = $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
@@ -160,9 +161,35 @@ sub TarReadFileInfo
         $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;
@@ -372,8 +399,10 @@ sub processClose
 }
 
 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) );