lib/BackupPC/FileZIO.pm

   1 #============================================================= -*-perl-*-
   2 #
   3 # BackupPC::FileZIO package
   4 #
   5 # DESCRIPTION
   6 #
   7 #   This library defines a BackupPC::FileZIO class for doing
   8 #   compressed or normal file I/O.
   9 #
  10 # AUTHOR
  11 #   Craig Barratt  <cbarratt@users.sourceforge.net>
  12 #
  13 # COPYRIGHT
  14 #   Copyright (C) 2001-2009  Craig Barratt
  15 #
  16 #   This program is free software; you can redistribute it and/or modify
  17 #   it under the terms of the GNU General Public License as published by
  18 #   the Free Software Foundation; either version 2 of the License, or
  19 #   (at your option) any later version.
  20 #
  21 #   This program is distributed in the hope that it will be useful,
  22 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 #   GNU General Public License for more details.
  25 #
  26 #   You should have received a copy of the GNU General Public License
  27 #   along with this program; if not, write to the Free Software
  28 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  29 #
  30 #========================================================================
  31 #
  32 # Version 3.2.0, released 31 Jul 2010.
  33 #
  34 # See http://backuppc.sourceforge.net.
  35 #
  36 #========================================================================
  37
  38 package BackupPC::FileZIO;
  39
  40 use strict;
  41
  42 use vars qw( $CompZlibOK );
  43 use Carp;
  44 use File::Path;
  45 use File::Copy;
  46 use Encode;
  47
  48 #
  49 # For compressed files we have a to careful about running out of memory
  50 # when we inflate a deflated file. For example, if a 500MB file of all
  51 # zero-bytes is compressed, it will only occupy a few tens of kbytes. If
  52 # we read the compressed file in decent-size chunks, a single inflate
  53 # will try to allocate 500MB. Not a good idea.
  54 #
  55 # Instead, we compress the file in chunks of $CompMaxWrite. If a
  56 # deflated chunk produces less than $CompMaxRead bytes, then we flush
  57 # and continue. This adds a few bytes to the compressed output file, but
  58 # only in extreme cases where the compression ratio is very close to
  59 # 100%. The result is that, provided we read the compressed file in
  60 # chunks of $CompMaxRead or less, the biggest inflated data will be
  61 # $CompMaxWrite.
  62 #
  63 my $CompMaxRead  = 131072;          # 128K
  64 my $CompMaxWrite = 6291456;         # 6MB
  65
  66 #
  67 # We maintain a write buffer for small writes for both compressed and
  68 # uncompressed files.  This is the size of the write buffer.
  69 #
  70 my $WriteBufSize = 65536;
  71
  72 BEGIN {
  73     eval "use Compress::Zlib;";
  74     if ( $@ ) {
  75         #
  76         # Compress::Zlib doesn't exist.  Define some dummy constant
  77         # subs so that the code below doesn't barf.
  78         #
  79         eval {
  80             sub Z_OK         { return 0; }
  81             sub Z_STREAM_END { return 1; }
  82         };
  83         $CompZlibOK = 0;
  84     } else {
  85         $CompZlibOK = 1;
  86     }
  87 };
  88
  89 sub open
  90 {
  91     my($class, $fileName, $write, $compLevel) = @_;
  92     local(*FH);
  93     my($fh);
  94
  95     if ( ref(\$fileName) eq "GLOB" ) {
  96         $fh = $fileName;
  97     } else {
  98         if ( $write ) {
  99             open(FH, ">", $fileName) || return;
 100         } else {
 101             open(FH, "<", $fileName) || return;
 102         }
 103         binmode(FH);
 104         $fh = *FH;
 105     }
 106     $compLevel  = 0 if ( !$CompZlibOK );
 107     my $self = bless {
 108         fh           => $fh,
 109         name         => $fileName,
 110         write        => $write,
 111         writeZeroCnt => 0,
 112         compress     => $compLevel,
 113     }, $class;
 114     if ( $compLevel ) {
 115         if ( $write ) {
 116             $self->{deflate} = $self->myDeflateInit;
 117         } else {
 118             $self->{inflate} = $self->myInflateInit;
 119             $self->{inflateStart} = 1;
 120         }
 121     }
 122     return $self;
 123 }
 124
 125 sub compOk
 126 {
 127     return $CompZlibOK;
 128 }
 129
 130 #
 131 # Request utf8 strings with readLine interface
 132 #
 133 sub utf8
 134 {
 135     my($self, $mode) = @_;
 136
 137     $self->{utf8} = $mode;
 138 }
 139
 140 sub myDeflateInit
 141 {
 142     my $self = shift;
 143
 144     return deflateInit(
 145                 -Bufsize => 65536,
 146                 -Level   => $self->{compress},
 147            );
 148 }
 149
 150 sub myInflateInit
 151 {
 152     my $self = shift;
 153
 154     return inflateInit(
 155                 -Bufsize => 65536,
 156            );
 157 }
 158
 159 sub read
 160 {
 161     my($self, $dataRef, $nRead) = @_;
 162     my($n);
 163
 164     return if ( $self->{write} );
 165     return sysread($self->{fh}, $$dataRef, $nRead) if ( !$self->{compress} );
 166     while ( !$self->{eof} && $nRead > length($self->{dataOut}) ) {
 167         if ( !length($self->{dataIn}) ) {
 168             $n = sysread($self->{fh}, $self->{dataIn}, $CompMaxRead);
 169             return $n if ( $n < 0 );
 170             $self->{eof} = 1 if ( $n == 0 );
 171         }
 172         if ( $self->{inflateStart} && $self->{dataIn} ne "" ) {
 173             my $chr = substr($self->{dataIn}, 0, 1);
 174
 175             $self->{inflateStart} = 0;
 176             if ( $chr eq chr(0xd6) || $chr eq chr(0xd7) ) {
 177                 #
 178                 # Flag 0xd6 or 0xd7 means this is a compressed file with
 179                 # appended md4 block checksums for rsync.  Change
 180                 # the first byte back to 0x78 and proceed.
 181                 #
 182                 ##print("Got 0xd6/0xd7 block: normal\n");
 183                 substr($self->{dataIn}, 0, 1) = chr(0x78);
 184             } elsif ( $chr eq chr(0xb3) ) {
 185                 #
 186                 # Flag 0xb3 means this is the start of the rsync
 187                 # block checksums, so consider this as EOF for
 188                 # the compressed file.  Also seek the file so
 189                 # it is positioned at the 0xb3.
 190                 #
 191                 sysseek($self->{fh}, -length($self->{dataIn}), 1);
 192                 $self->{eof} = 1;
 193                 $self->{dataIn} = "";
 194                 ##print("Got 0xb3 block: considering eof\n");
 195                 last;
 196             } else {
 197                 #
 198                 # normal case: nothing to do
 199                 #
 200             }
 201         }
 202         my($data, $err) = $self->{inflate}->inflate($self->{dataIn});
 203         $self->{dataOut} .= $data;
 204         if ( $err == Z_STREAM_END ) {
 205             #print("R");
 206             $self->{inflate} = $self->myInflateInit;
 207             $self->{inflateStart} = 1;
 208         } elsif ( $err != Z_OK ) {
 209             $$dataRef = "";
 210             return -1;
 211         }
 212     }
 213     if ( $nRead >= length($self->{dataOut}) ) {
 214         $n = length($self->{dataOut});
 215         $$dataRef = $self->{dataOut};
 216         $self->{dataOut} = '';
 217         return $n;
 218     } else {
 219         $$dataRef = substr($self->{dataOut}, 0, $nRead);
 220         $self->{dataOut} = substr($self->{dataOut}, $nRead);
 221         return $nRead;
 222     }
 223 }
 224
 225 #
 226 # Provide a line-at-a-time interface.  This splits and buffers the
 227 # lines, you cannot mix calls to read() and readLine().
 228 #
 229 sub readLine
 230 {
 231     my($self) = @_;
 232     my $str;
 233
 234     $self->{readLineBuf} = [] if ( !defined($self->{readLineBuf}) );
 235     while ( !@{$self->{readLineBuf}} ) {
 236         $self->read(\$str, $CompMaxRead);
 237         if ( $str eq "" ) {
 238             $str = $self->{readLineFrag};
 239             $self->{readLineFrag} = "";
 240             $str = decode_utf8($str) if ( $self->{utf8} );
 241             return $str;
 242         }
 243         @{$self->{readLineBuf}} = split(/\n/, $self->{readLineFrag} . $str);
 244         if ( substr($str, -1, 1) ne "\n" ) {
 245             $self->{readLineFrag} = pop(@{$self->{readLineBuf}});
 246         } else {
 247             $self->{readLineFrag} = "";
 248         }
 249     }
 250     $str = shift(@{$self->{readLineBuf}}) . "\n";
 251     if ( $self->{utf8} ) {
 252         my $strUtf8 = decode_utf8($str, 0);
 253         $strUtf8 = $str if ( length($strUtf8) == 0 );
 254         return $strUtf8;
 255     }
 256     return $str;
 257 }
 258
 259 sub rewind
 260 {
 261     my($self) = @_;
 262
 263     return if ( $self->{write} );
 264     return sysseek($self->{fh}, 0, 0) if ( !$self->{compress} );
 265     $self->{dataOut} = '';
 266     $self->{dataIn}  = '';
 267     $self->{eof}     = 0;
 268     $self->{inflate} = $self->myInflateInit;
 269     $self->{inflateStart} = 1;
 270     return sysseek($self->{fh}, 0, 0);
 271 }
 272
 273 sub writeBuffered
 274 {
 275     my $self = shift;
 276     my($data, $force) = @_;
 277
 278     #
 279     # Buffer small writes using a buffer size of up to $WriteBufSize.
 280     #
 281     if ( $force || length($self->{writeBuf}) + length($data) > $WriteBufSize ) {
 282         if ( length($self->{writeBuf}) ) {
 283             my $wrData = $self->{writeBuf} . $data;
 284             return -1 if ( syswrite($self->{fh}, $wrData) != length($wrData) );
 285             $self->{writeBuf} = undef;
 286         } else {
 287             return if ( length($data) == 0 );
 288             return -1 if ( syswrite($self->{fh}, $data) != length($data) );
 289         }
 290     } else {
 291         $self->{writeBuf} .= $data;
 292     }
 293     return 0;
 294 }
 295
 296 sub write
 297 {
 298     my($self, $dataRef) = @_;
 299     my $n = length($$dataRef);
 300
 301     return if ( !$self->{write} );
 302     print(STDERR $$dataRef) if ( $self->{writeTeeStderr} );
 303     return 0 if ( $n == 0 );
 304     if ( !$self->{compress} ) {
 305         #
 306         # If smbclient gets a read error on the client (due to a file lock)
 307         # it will write a dummy file of zeros.  We detect this so we can
 308         # store the file efficiently as a sparse file.  writeZeroCnt is
 309         # the number of consecutive 0 bytes at the start of the file.
 310         #
 311         my $skip = 0;
 312         if ( $self->{writeZeroCnt} >= 0 && $$dataRef =~ /^(\0+)/s ) {
 313             $skip = length($1);
 314             $self->{writeZeroCnt} += $skip;
 315             return $n if ( $skip == $n );
 316         }
 317         #
 318         # We now have some non-zero bytes, so time to seek to the right
 319         # place and turn off zero-byte detection.
 320         #
 321         if ( $self->{writeZeroCnt} > 0 ) {
 322             sysseek($self->{fh}, $self->{writeZeroCnt}, 0);
 323             $self->{writeZeroCnt} = -1;
 324         } elsif ( $self->{writeZeroCnt} == 0 ) {
 325             $self->{writeZeroCnt} = -1;
 326         }
 327         return -1 if ( $self->writeBuffered(substr($$dataRef, $skip)) < 0 );
 328         return $n;
 329     }
 330     for ( my $i = 0 ; $i < $n ; $i += $CompMaxWrite ) {
 331         my $dataIn  = substr($$dataRef, $i, $CompMaxWrite);
 332         my $dataOut = $self->{deflate}->deflate($dataIn);
 333         return -1 if ( $self->writeBuffered($dataOut) < 0 );
 334         $self->{deflateIn}  += length($dataIn);
 335         $self->{deflateOut} += length($dataOut);
 336         if ( $self->{deflateIn} >= $CompMaxWrite ) {
 337             if ( $self->{deflateOut} < $CompMaxRead ) {
 338                 #
 339                 # Compression is too high: to avoid huge memory requirements
 340                 # on read we need to flush().
 341                 #
 342                 $dataOut = $self->{deflate}->flush();
 343                 #print("F");
 344                 $self->{deflate} = $self->myDeflateInit;
 345                 return -1 if ( $self->writeBuffered($dataOut) < 0 );
 346             }
 347             $self->{deflateIn} = $self->{deflateOut} = 0;
 348         }
 349     }
 350     return $n;
 351 }
 352
 353 sub name
 354 {
 355     my($self) = @_;
 356
 357     return $self->{name};
 358 }
 359
 360 sub writeTeeStderr
 361 {
 362     my($self, $param) = @_;
 363
 364     $self->{writeTeeStderr} = $param if ( defined($param) );
 365     return $self->{writeTeeStderr};
 366 }
 367
 368 sub close
 369 {
 370     my($self) = @_;
 371     my $err = 0;
 372
 373     if ( $self->{write} && $self->{compress} ) {
 374         my $data = $self->{deflate}->flush();
 375         $err = 1 if ( $self->writeBuffered($data) < 0 );
 376     } elsif ( $self->{write} && !$self->{compress} ) {
 377         if ( $self->{writeZeroCnt} > 0 ) {
 378             #
 379             # We got a file of all zero bytes.  Write a single zero byte
 380             # at the end of the file.  On most file systems this is an
 381             # efficient way to store the file.
 382             #
 383             $err = 1 if ( sysseek($self->{fh}, $self->{writeZeroCnt} - 1, 0)
 384                                             != $self->{writeZeroCnt} - 1
 385                         || syswrite($self->{fh}, "\0") != 1 );
 386         }
 387     }
 388     $self->writeBuffered(undef, 1);
 389     close($self->{fh});
 390     return $err ? -1 : 0;
 391 }
 392
 393 #
 394 # If $compress is >0, copy and compress $srcFile putting the output
 395 # in $destFileZ.  Otherwise, copy the file to $destFileNoZ, or do
 396 # nothing if $destFileNoZ is undef.  Finally, if rename is set, then
 397 # the source file is removed.
 398 #
 399 sub compressCopy
 400 {
 401     my($class, $srcFile, $destFileZ, $destFileNoZ, $compress, $rmSrc) = @_;
 402     my(@s) = stat($srcFile);
 403     my $atime = $s[8] =~ /(.*)/ && $1;
 404     my $mtime = $s[9] =~ /(.*)/ && $1;
 405     if ( $CompZlibOK && $compress > 0 ) {
 406         my $fh = BackupPC::FileZIO->open($destFileZ, 1, $compress);
 407         my $data;
 408         if ( defined($fh) && open(LOG, "<", $srcFile) ) {
 409             binmode(LOG);
 410             while ( sysread(LOG, $data, 65536) > 0 ) {
 411                 $fh->write(\$data);
 412             }
 413             close(LOG);
 414             $fh->close();
 415             unlink($srcFile) if ( $rmSrc );
 416             utime($atime, $mtime, $destFileZ);
 417             return 1;
 418         } else {
 419             $fh->close() if ( defined($fh) );
 420             return 0;
 421         }
 422     }
 423     return 0 if ( !defined($destFileNoZ) );
 424     if ( $rmSrc ) {
 425         return rename($srcFile, $destFileNoZ);
 426     } else {
 427         return 0 if ( !copy($srcFile, $destFileNoZ) );
 428         utime($atime, $mtime, $destFileNoZ);
 429     }
 430 }
 431
 432 1;