a894bab8851e251747b6bc88bb6376972013b61b
[BackupPC.git] / 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.0beta0, released 5 April 2009.
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;