File Coverage

blib/lib/File/RsyncP/FileIO.pm
Criterion Covered Total %
statement 39 327 11.9
branch 0 172 0.0
condition 0 59 0.0
subroutine 13 45 28.8
pod 25 31 80.6
total 77 634 12.1


line stmt bran cond sub pod time code
1             #============================================================= -*-perl-*-
2             #
3             # File::RsyncP::FileIO package
4             #
5             # DESCRIPTION
6             # Provide file system IO for File::RsyncP.
7             #
8             # AUTHOR
9             # Craig Barratt
10             #
11             # COPYRIGHT
12             # File::RsyncP is Copyright (C) 2002 Craig Barratt.
13             #
14             # Rsync is Copyright (C) 1996-2001 by Andrew Tridgell, 1996 by Paul
15             # Mackerras, and 2001, 2002 by Martin Pool.
16             #
17             # This program is free software: you can redistribute it and/or modify
18             # it under the terms of the GNU General Public License as published by
19             # the Free Software Foundation, either version 3 of the License, or
20             # (at your option) any later version.
21             #
22             # This program is distributed in the hope that it will be useful,
23             # but WITHOUT ANY WARRANTY; without even the implied warranty of
24             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25             # GNU General Public License for more details.
26             #
27             # You should have received a copy of the GNU General Public License
28             # along with this program. If not, see .
29             #
30             #========================================================================
31             #
32             # Version 0.74, released 17 Jan 2015.
33             #
34             # See http://perlrsync.sourceforge.net.
35             #
36             #========================================================================
37              
38             package File::RsyncP::FileIO;
39              
40 1     1   5 use strict;
  1         2  
  1         43  
41 1     1   5 use File::RsyncP::Digest;
  1         2  
  1         57  
42 1     1   8 use File::Path;
  1         2  
  1         89  
43 1     1   6 use File::Find;
  1         2  
  1         72  
44              
45 1     1   15 use vars qw($VERSION);
  1         2  
  1         77  
46             $VERSION = '0.74';
47              
48 1     1   7 use constant S_IFMT => 0170000; # type of file
  1         1  
  1         99  
49 1     1   7 use constant S_IFDIR => 0040000; # directory
  1         2  
  1         76  
50 1     1   7 use constant S_IFCHR => 0020000; # character special
  1         6  
  1         65  
51 1     1   6 use constant S_IFBLK => 0060000; # block special
  1         2  
  1         68  
52 1     1   6 use constant S_IFREG => 0100000; # regular
  1         1  
  1         60  
53 1     1   6 use constant S_IFLNK => 0120000; # symbolic link
  1         2  
  1         66  
54 1     1   6 use constant S_IFSOCK => 0140000; # socket
  1         2  
  1         59  
55 1     1   6 use constant S_IFIFO => 0010000; # fifo
  1         1  
  1         4949  
56              
57             sub new
58             {
59 0     0 1   my($class, $options) = @_;
60              
61 0   0       $options ||= {};
62 0           my $self = bless {
63             blockSize => 700,
64             logLevel => 0,
65             digest => File::RsyncP::Digest->new($options->{protocol_version}),
66             checksumSeed => 0,
67             logHandler => \&logHandler,
68             %$options,
69             }, $class;
70 0           return $self;
71             }
72              
73             sub blockSize
74             {
75 0     0 1   my($fio, $value) = @_;
76              
77 0 0         $fio->{blockSize} = $value if ( defined($value) );
78 0           return $fio->{blockSize};
79             }
80              
81             #
82             # We publish our version to File::RsyncP. This is so File::RsyncP
83             # can provide backward compatibility to older FileIO code.
84             #
85             # Versions:
86             #
87             # undef or 1: protocol version 26, no hardlinks
88             # 2: protocol version 28, supports hardlinks
89             #
90             sub version
91             {
92 0     0 0   return 2;
93             }
94              
95             sub preserve_hard_links
96             {
97 0     0 0   my($fio, $value) = @_;
98              
99 0 0         $fio->{preserve_hard_links} = $value if ( defined($value) );
100 0           return $fio->{preserve_hard_links};
101             }
102              
103             sub protocol_version
104             {
105 0     0 0   my($fio, $value) = @_;
106              
107 0 0         if ( defined($value) ) {
108 0           $fio->{protocol_version} = $value;
109 0           $fio->{digest}->protocol($fio->{protocol_version});
110             }
111 0           return $fio->{protocol_version};
112             }
113              
114             sub logHandlerSet
115             {
116 0     0 1   my($fio, $sub) = @_;
117 0           $fio->{logHandler} = $sub;
118             }
119              
120             #
121             # Given a remote name, return the local name
122             #
123             sub localName
124             {
125 0     0 0   my($fio, $name) = @_;
126              
127 0 0 0       return $name if ( !defined($fio->{localDir})
128             && !defined($fio->{remoteDir}) );
129 0 0         if ( substr($name, 0, length($fio->{remoteDir})) eq $fio->{remoteDir} ) {
130 0           substr($name, 0, length($fio->{remoteDir})) = $fio->{localDir};
131             }
132 0           return $name;
133             }
134              
135             #
136             # Setup rsync checksum computation for the given file.
137             #
138             sub csumStart
139             {
140 0     0 1   my($fio, $f, $needMD4) = @_;
141 0           local(*F);
142 0           my $localName = $fio->localName($f->{name});
143              
144 0           $fio->{file} = $f;
145 0 0         $fio->csumEnd if ( defined($fio->{fh}) );
146 0 0 0       return if ( !-f $localName || -l $localName );
147 0 0         if ( !open(F, $localName) ) {
148 0           $fio->log("Can't open $localName");
149 0           return -1;
150             }
151 0 0         if ( $needMD4) {
152 0           $fio->{csumDigest}
153             = File::RsyncP::Digest->new($fio->{protocol_version});
154 0           $fio->{csumDigest}->add(pack("V", $fio->{checksumSeed}));
155             } else {
156 0           delete($fio->{csumDigest});
157             }
158 0           $fio->{fh} = *F;
159             }
160              
161             sub csumGet
162             {
163 0     0 1   my($fio, $num, $csumLen, $blockSize) = @_;
164 0           my($fileData);
165              
166 0   0       $num ||= 100;
167 0   0       $csumLen ||= 16;
168              
169 0 0         return if ( !defined($fio->{fh}) );
170 0 0         if ( sysread($fio->{fh}, $fileData, $blockSize * $num) <= 0 ) {
171 0           return;
172             }
173 0 0         $fio->{csumDigest}->add($fileData) if ( defined($fio->{csumDigest}) );
174 0 0         $fio->log(sprintf("%s: getting csum ($num,$csumLen,%d,0x%x)",
175             $fio->{file}{name},
176             length($fileData),
177             $fio->{checksumSeed}))
178             if ( $fio->{logLevel} >= 10 );
179 0           return $fio->{digest}->blockDigest($fileData, $blockSize,
180             $csumLen, $fio->{checksumSeed});
181             }
182              
183             sub csumEnd
184             {
185 0     0 1   my($fio) = @_;
186              
187 0 0         return if ( !defined($fio->{fh}) );
188             #
189             # make sure we read the entire file for the file MD4 digest
190             #
191 0 0         if ( defined($fio->{csumDigest}) ) {
192 0           while ( sysread($fio->{fh}, my $fileData, 65536) > 0 ) {
193 0           $fio->{csumDigest}->add($fileData);
194             }
195             }
196 0           close($fio->{fh});
197 0           delete($fio->{fh});
198 0 0         return $fio->{csumDigest}->digest if ( defined($fio->{csumDigest}) );
199             }
200              
201             sub readStart
202             {
203 0     0 1   my($fio, $f) = @_;
204 0           local(*F);
205 0           my $localName = $fio->localName($f->{name});
206              
207 0           $fio->{file} = $f;
208 0 0         $fio->readEnd if ( defined($fio->{fh}) );
209 0 0 0       return if ( !-f $localName || -l $localName );
210 0 0         if ( !open(F, $localName) ) {
211 0           $fio->log("Can't open $localName");
212 0           return;
213             }
214 0           $fio->{fh} = *F;
215             }
216              
217             sub read
218             {
219 0     0 1   my($fio, $num) = @_;
220 0           my($fileData);
221              
222 0   0       $num ||= 32768;
223 0 0         return if ( !defined($fio->{fh}) );
224 0 0         if ( sysread($fio->{fh}, $fileData, $num) <= 0 ) {
225 0           return $fio->readEnd;
226             }
227 0           return \$fileData;
228             }
229              
230             sub readEnd
231             {
232 0     0 1   my($fio) = @_;
233              
234 0 0         return if ( !defined($fio->{fh}) );
235 0           close($fio->{fh});
236 0           delete($fio->{fh});
237             }
238              
239             sub checksumSeed
240             {
241 0     0 1   my($fio, $checksumSeed) = @_;
242              
243 0           $fio->{checksumSeed} = $checksumSeed;
244             }
245              
246             sub dirs
247             {
248 0     0 1   my($fio, $localDir, $remoteDir) = @_;
249              
250 0           $fio->{localDir} = $localDir;
251 0           $fio->{remoteDir} = $remoteDir;
252             }
253              
254             sub attribGet
255             {
256 0     0 1   my($fio, $f) = @_;
257 0           my $localName = $fio->localName($f->{name});
258              
259 0           my @s = stat($localName);
260 0 0         return if ( !@s );
261             return {
262 0           mode => $s[2],
263             uid => $s[4],
264             gid => $s[5],
265             size => $s[7],
266             mtime => $s[9],
267             }
268             }
269              
270             #
271             # Set the attributes for a file. Returns non-zero on error.
272             #
273             sub attribSet
274             {
275 0     0 1   my($fio, $f, $placeHolder) = @_;
276 0           my $ret;
277              
278             #
279             # Ignore placeholder attribute sets: only do real ones.
280             #
281 0 0         return if ( $placeHolder );
282              
283 0           my $lName = $fio->localName($f->{name});
284 0           my @s = stat($lName);
285 0           my $a = {
286             mode => $s[2],
287             uid => $s[4],
288             gid => $s[5],
289             size => $s[7],
290             atime => $s[8],
291             mtime => $s[9],
292             };
293 0 0         $f->{atime} = $f->{mtime} if ( !defined($f->{atime}) );
294 0 0 0       if ( ($f->{mode} & ~S_IFMT) != ($a->{mode} & ~S_IFMT)
295             && !chmod($f->{mode} & ~S_IFMT, $lName) ) {
296 0           $fio->log(sprintf("Can't chmod(%s, 0%o)", $lName, $f->{mode}));
297 0           $ret = -1;
298             }
299 0 0 0       if ( ($f->{uid} != $a->{uid} || $f->{gid} != $a->{gid})
      0        
300             && !chown($f->{uid}, $f->{gid}, $lName) ) {
301 0           $fio->log("Can't chown($f->{uid}, $f->{gid}, $lName)");
302 0           $ret = -1;
303             }
304 0 0 0       if ( ($f->{mtime} != $a->{mtime} || $f->{atime} != $a->{atime})
      0        
305             && !utime($f->{atime}, $f->{mtime}, $lName) ) {
306 0           $fio->log("Can't mtime($f->{atime}, $f->{mtime}, $lName)");
307 0           $ret = -1;
308             }
309 0           return $ret;
310             }
311              
312             sub statsGet
313             {
314 0     0 1   my($fio) = @_;
315              
316 0           return {};
317             }
318              
319             #
320             # Make a given directory. Returns non-zero on error.
321             #
322             sub makePath
323             {
324 0     0 1   my($fio, $f) = @_;
325 0           my $localDir = $fio->localName($f->{name});
326              
327 0 0         return $fio->attribSet($f) if ( -d $localDir );
328 0           File::Path::mkpath($localDir, 0, $f->{mode});
329 0 0         return $fio->attribSet($f) if ( -d $localDir );
330 0           $fio->log("Can't create directory $localDir");
331 0           return -1;
332             }
333              
334             #
335             # Make a special file. Returns non-zero on error.
336             #
337             sub makeSpecial
338             {
339 0     0 1   my($fio, $f) = @_;
340 0           my $localPath = $fio->localName($f->{name});
341              
342             #
343             # TODO: check if the special file is the same, then do nothing.
344             # Should also create as a new unique name, then rename/unlink.
345             #
346 0           $fio->unlink($f->{name});
347 0 0         if ( ($f->{mode} & S_IFMT) == S_IFCHR ) {
    0          
    0          
    0          
348 0           my($major, $minor);
349              
350 0           $major = $f->{rdev} >> 8;
351 0           $minor = $f->{rdev} & 0xff;
352 0           return system("mknod $localPath c $major $minor");
353             } elsif ( ($f->{mode} & S_IFMT) == S_IFBLK ) {
354 0           my($major, $minor);
355              
356 0           $major = $f->{rdev} >> 8;
357 0           $minor = $f->{rdev} & 0xff;
358 0           return system("mknod $localPath b $major $minor");
359             } elsif ( ($f->{mode} & S_IFMT) == S_IFLNK ) {
360 0 0         if ( !symlink($f->{link}, $localPath) ) {
361             # error
362             }
363             } elsif ( ($f->{mode} & S_IFMT) == S_IFIFO ) {
364 0 0         if ( system("mknod $localPath p") ) {
365             # error
366             }
367             }
368 0           return $fio->attribSet($f);
369             }
370              
371             #
372             # Make a hardlink. Returns non-zero on error.
373             # This actually gets called twice for each hardlink.
374             # Once as the file list is processed, and again at
375             # the end. This subroutine should decide whether it
376             # should do the hardlinks during the transer or at
377             # the end. Normally they would be done at the end
378             # since the target might not exist until them.
379             # BackupPC does them as it goes (since it is just saving the
380             # hardlink info and not actually making hardlinks).
381             #
382             sub makeHardLink
383             {
384 0     0 0   my($fio, $f, $end) = @_;
385              
386             #
387             # In this case, only do hardlinks at the end.
388             #
389 0 0         return if ( !$end );
390 0           my $localPath = $fio->localName($f->{name});
391 0           my $destLink = $fio->localName($f->{hlink});
392 0 0         $fio->unlink($localPath) if ( -e $localPath );
393 0           return !link($destLink, $localPath);
394             }
395              
396              
397             sub unlink
398             {
399 0     0 1   my($fio, $path) = @_;
400 0           my $localPath = $fio->localName($path);
401              
402 0 0 0       return if ( !-e $localPath && !-l $localPath );
403 0 0         if ( -d _ ) {
404 0           rmtree($localPath);
405             } else {
406 0           CORE::unlink($localPath);
407             }
408             }
409              
410             sub ignoreAttrOnFile
411             {
412 0     0 1   return undef;
413             }
414              
415             #
416             # Start receive of file deltas for a particular file.
417             #
418             sub fileDeltaRxStart
419             {
420 0     0 1   my($fio, $f, $cnt, $size, $remainder) = @_;
421              
422 0           $fio->{rxFile} = $f; # file attributes
423 0           $fio->{rxBlkCnt} = $cnt; # how many blocks we will receive
424 0           $fio->{rxBlkSize} = $size; # block size
425 0           $fio->{rxRemainder} = $remainder; # size of the last block
426 0           $fio->{rxMatchBlk} = 0; # current start of match
427 0           $fio->{rxMatchNext} = 0; # current next block of match
428 0           $fio->{rxSize} = 0; # size of received file
429 0 0         if ( $fio->{rxFile}{size} != ($cnt > 0
    0          
430             ? ($cnt - 1) * $size + $remainder
431             : 0) ) {
432 0           $fio->{rxMatchBlk} = undef; # size different, so no file match
433 0 0         $fio->log("$fio->{rxFile}{name}: size doesn't match"
434             . " ($fio->{rxFile}{size})")
435             if ( $fio->{logLevel} >= 5 );
436             }
437 0           delete($fio->{rxInFd});
438 0           delete($fio->{rxOutFd});
439 0           delete($fio->{rxDigest});
440 0           $fio->{rxFile}{localName} = $fio->localName($fio->{rxFile}{name});
441             }
442              
443             #
444             # Process the next file delta for the current file. Returns 0 if ok,
445             # -1 if not. Must be called with either a block number, $blk, or new data,
446             # $newData, (not both) defined.
447             #
448             sub fileDeltaRxNext
449             {
450 0     0 1   my($fio, $blk, $newData) = @_;
451              
452 0 0         if ( defined($blk) ) {
453 0 0 0       if ( defined($fio->{rxMatchBlk}) && $fio->{rxMatchNext} == $blk ) {
454             #
455             # got the next block in order; just keep track.
456             #
457 0           $fio->{rxMatchNext}++;
458 0           return;
459             }
460             }
461 0           my $newDataLen = length($newData);
462 0 0         $fio->log("$fio->{rxFile}{name}: blk=$blk, newData=$newDataLen,"
463             . " rxMatchBlk=$fio->{rxMatchBlk}, rxMatchNext=$fio->{rxMatchNext}")
464             if ( $fio->{logLevel} >= 8 );
465 0 0         if ( !defined($fio->{rxOutFd}) ) {
466             #
467             # maybe the file has no changes
468             #
469 0 0 0       if ( $fio->{rxMatchNext} == $fio->{rxBlkCnt}
      0        
470             && !defined($blk) && !defined($newData) ) {
471             #$fio->log("$fio->{rxFile}{name}: file is unchanged");
472             # if ( $fio->{logLevel} >= 8 );
473 0           return;
474             }
475              
476             #
477             # need to open a temporary output file where we will build the
478             # new version.
479             #
480 0           local(*F);
481 0           my $rxTmpFile;
482 0           for ( my $i = 0 ; ; $i++ ) {
483 0           $rxTmpFile = "$fio->{rxFile}{localName}__tmp__$$.$i";
484 0 0         last if ( !-e $rxTmpFile );
485             }
486 0 0         if ( !open(F, ">$rxTmpFile") ) {
487 0           $fio->log("Can't open/create $rxTmpFile");
488 0           return -1;
489             }
490 0 0         $fio->log("$fio->{rxFile}{name}: opening tmp output file $rxTmpFile")
491             if ( $fio->{logLevel} >= 10 );
492 0           $fio->{rxOutFd} = *F;
493 0           $fio->{rxTmpFile} = $rxTmpFile;
494              
495 0           $fio->{rxDigest} = File::RsyncP::Digest->new($fio->{protocol_version});
496 0           $fio->{rxDigest}->add(pack("V", $fio->{checksumSeed}));
497             }
498 0 0 0       if ( defined($fio->{rxMatchBlk})
499             && $fio->{rxMatchBlk} != $fio->{rxMatchNext} ) {
500             #
501             # need to copy the sequence of blocks that matched
502             #
503 0 0         if ( !defined($fio->{rxInFd}) ) {
504 0 0         if ( open(F, "$fio->{rxFile}{localName}") ) {
505 0           $fio->{rxInFd} = *F;
506             } else {
507 0           $fio->log("Unable to open $fio->{rxFile}{localName}");
508 0           return -1;
509             }
510             }
511 0           my $lastBlk = $fio->{rxMatchNext} - 1;
512 0 0         $fio->log("$fio->{rxFile}{name}: writing blocks $fio->{rxMatchBlk}.."
513             . "$lastBlk")
514             if ( $fio->{logLevel} >= 10 );
515 0           my $seekPosn = $fio->{rxMatchBlk} * $fio->{rxBlkSize};
516 0 0         if ( !sysseek($fio->{rxInFd}, $seekPosn, 0) ) {
517 0           $fio->log("Unable to seek $fio->{rxFile}{localName} to $seekPosn");
518 0           return -1;
519             }
520 0           my $cnt = $fio->{rxMatchNext} - $fio->{rxMatchBlk};
521 0           my($thisCnt, $len, $data);
522 0           for ( my $i = 0 ; $i < $cnt ; $i += $thisCnt ) {
523 0           $thisCnt = $cnt - $i;
524 0 0         $thisCnt = 512 if ( $thisCnt > 512 );
525 0 0         if ( $fio->{rxMatchBlk} + $i + $thisCnt == $fio->{rxBlkCnt} ) {
526 0           $len = ($thisCnt - 1) * $fio->{rxBlkSize} + $fio->{rxRemainder};
527             } else {
528 0           $len = $thisCnt * $fio->{rxBlkSize};
529             }
530 0 0         if ( sysread($fio->{rxInFd}, $data, $len) != $len ) {
531 0           $fio->log("Unable to read $len bytes from"
532             . " $fio->{rxFile}{localName} ($i,$thisCnt,$fio->{rxBlkCnt})");
533 0           return -1;
534             }
535 0 0         if ( syswrite($fio->{rxOutFd}, $data) != $len ) {
536 0           $fio->log("Unable to write $len bytes to"
537             . " $fio->{rxTmpFile}");
538             }
539 0           $fio->{rxDigest}->add($data);
540 0           $fio->{rxSize} += length($data);
541             }
542 0           $fio->{rxMatchBlk} = undef;
543             }
544 0 0         if ( defined($blk) ) {
545             #
546             # Remember the new block number
547             #
548 0           $fio->{rxMatchBlk} = $blk;
549 0           $fio->{rxMatchNext} = $blk + 1;
550             }
551 0 0         if ( defined($newData) ) {
552             #
553             # Write the new chunk
554             #
555 0           my $len = length($newData);
556 0 0         $fio->log("$fio->{rxFile}{name}: writing $len bytes new data")
557             if ( $fio->{logLevel} >= 10 );
558 0 0         if ( syswrite($fio->{rxOutFd}, $newData) != $len ) {
559 0           $fio->log("Unable to write $len bytes to $fio->{rxTmpFile}");
560 0           return -1;
561             }
562 0           $fio->{rxDigest}->add($newData);
563 0           $fio->{rxSize} += length($newData);
564             }
565 0           return;
566             }
567              
568             #
569             # Finish up the current receive file. Returns undef if ok, -1 if not.
570             # Returns 1 if the md4 digest doesn't match.
571             #
572             sub fileDeltaRxDone
573             {
574 0     0 1   my($fio, $md4) = @_;
575              
576 0 0         if ( !defined($fio->{rxDigest}) ) {
577 0           local(*F);
578             #
579             # File was exact match, but we still need to verify the
580             # MD4 checksum. Therefore open and read the file.
581             #
582 0           $fio->{rxDigest} = File::RsyncP::Digest->new($fio->{protocol_version});
583 0           $fio->{rxDigest}->add(pack("V", $fio->{checksumSeed}));
584 0 0         if ( open(F, $fio->{rxFile}{localName}) ) {
585 0           $fio->{rxInFd} = *F;
586 0           while ( sysread($fio->{rxInFd}, my $data, 4 * 65536) > 0 ) {
587 0           $fio->{rxDigest}->add($data);
588 0           $fio->{rxSize} += length($data);
589             }
590             } else {
591             # error
592             }
593 0 0         $fio->log("$fio->{rxFile}{name}: got exact match")
594             if ( $fio->{logLevel} >= 5 );
595             }
596 0 0         close($fio->{rxInFd}) if ( defined($fio->{rxInFd}) );
597 0 0         close($fio->{rxOutFd}) if ( defined($fio->{rxOutFd}) );
598 0           my $newDigest = $fio->{rxDigest}->digest;
599 0 0         if ( $fio->{logLevel} >= 3 ) {
600 0           my $md4Str = unpack("H*", $md4);
601 0           my $newStr = unpack("H*", $newDigest);
602 0           $fio->log("$fio->{rxFile}{name}: got digests $md4Str vs $newStr")
603             }
604 0 0         if ( $md4 eq $newDigest ) {
605             #
606             # Nothing to do if there is no output file
607             #
608 0 0         if ( !defined($fio->{rxOutFd}) ) {
609 0 0         $fio->log("$fio->{rxFile}{name}: nothing to do")
610             if ( $fio->{logLevel} >= 5 );
611 0           return $fio->attribSet($fio->{rxFile});
612             }
613              
614             #
615             # First rename the original file (in case the rename below fails)
616             # to a unique temporary name.
617             #
618 0           my $oldFile;
619 0 0         if ( -e $fio->{rxFile}{localName} ) {
620 0           for ( my $i = 0 ; ; $i++ ) {
621 0           $oldFile = "$fio->{rxFile}{localName}__old__$$.$i";
622 0 0         last if ( !-e $oldFile );
623             }
624 0 0         $fio->log("$fio->{rxFile}{name}: unlinking/renaming")
625             if ( $fio->{logLevel} >= 5 );
626 0 0         if ( !rename($fio->{rxFile}{localName}, $oldFile) ) {
627 0           $fio->log("Can't rename $fio->{rxFile}{localName}"
628             . " to $oldFile");
629 0           CORE::unlink($fio->{rxTmpFile});
630 0           return -1;
631             }
632             }
633 0 0         if ( !rename($fio->{rxTmpFile}, $fio->{rxFile}{localName}) ) {
634             #
635             # Restore old file
636             #
637 0 0         if ( !rename($oldFile, $fio->{rxFile}{localName}) ) {
638 0           $fio->log("Can't retore original file $oldFile after rename"
639             . " of $fio->{rxTmpFile} failed");
640             } else {
641 0           $fio->log("Can't rename $fio->{rxTmpFile} to"
642             . " $fio->{rxFile}{localName}");
643             }
644 0           return -1;
645             }
646 0 0 0       if ( defined($oldFile) && CORE::unlink($oldFile) != 1 ) {
647 0           $fio->log("Can't unlink old file $oldFile");
648 0           return -1;
649             }
650             } else {
651 0 0         $fio->log("$fio->{rxFile}{name}: md4 doesn't match")
652             if ( $fio->{logLevel} >= 1 );
653 0 0         CORE::unlink($fio->{rxTmpFile}) if ( defined($fio->{rxTmpFile}) );
654 0           return 1;
655             }
656 0           delete($fio->{rxDigest});
657 0           $fio->{rxFile}{size} = $fio->{rxSize};
658 0           return $fio->attribSet($fio->{rxFile});
659             }
660              
661             sub fileListEltSend
662             {
663 0     0 0   my($fio, $name, $fList, $outputFunc) = @_;
664 0           my @s;
665 0           my $extra = {};
666              
667 0           (my $n = $name) =~ s/^\Q$fio->{localDir}/$fio->{remoteDir}/;
668 0 0         if ( -l $name ) {
669 0           @s = lstat($name);
670 0           $extra = {
671             %$extra,
672             link => readlink($name),
673             };
674             } else {
675 0           @s = stat($name);
676             }
677 0 0 0       if ( $fio->{preserve_hard_links}
      0        
      0        
678             && ($s[2] & S_IFMT) == S_IFREG
679             && ($fio->{protocol_version} < 27 || $s[3] > 1) ) {
680 0           $extra = {
681             %$extra,
682             dev => $s[0],
683             inode => $s[1],
684             };
685             }
686 0 0         $fio->log("fileList send $name (remote=$n)") if ( $fio->{logLevel} >= 3 );
687 0           $fList->encode({
688             name => $n,
689             mode => $s[2],
690             uid => $s[4],
691             gid => $s[5],
692             rdev => $s[6],
693             size => $s[7],
694             mtime => $s[9],
695             %$extra,
696             });
697 0           &$outputFunc($fList->encodeData);
698             }
699              
700             sub fileListSend
701             {
702 0     0 1   my($fio, $flist, $outputFunc) = @_;
703              
704             find({wanted => sub {
705 0     0     $fio->fileListEltSend($File::Find::name, $flist, $outputFunc);
706             },
707 0           no_chdir => 1
708             }, $fio->{localDir});
709             }
710              
711             sub finish
712             {
713 0     0 1   my($fio, $isChild) = @_;
714              
715 0           return;
716             }
717              
718             #
719             # Default log handler
720             #
721             sub logHandler
722             {
723 0     0 1   my($str) = @_;
724              
725 0           print(STDERR $str, "\n");
726             }
727              
728             #
729             # Handle one or more log messages
730             #
731             sub log
732             {
733 0     0 1   my($fio, @logStr) = @_;
734              
735 0           foreach my $str ( @logStr ) {
736 0 0         next if ( $str eq "" );
737 0           $fio->{logHandler}->($str);
738             }
739             }
740              
741             1;
742             __END__