Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
executable file 186 lines (150 sloc) 4.366 kB
#! /usr/bin/perl
use 5.008;
use strict;
use warnings;
use Digest::MD5 qw(md5);
use Errno;
use Getopt::Long;
use Pod::Usage;
use POSIX qw(:sys_wait_h);
our $VERSION = '0.02';
# file descriptors:
# 0 < data file (or uses $ARGV[0] if exists)
# 1 > patch data
# 5 < old digest (optional)
# 6 > new digest
sub readall {
my ($fh, $buf, $len) = @_;
my $off = 0;
while ($off != $len) {
my $r = sysread($fh, $$buf, $len - $off, $off);
if ($r == 0) {
return $off;
} elsif ($r == -1) {
if ($! != Errno::EAGAIN) {
return $off || -1;
}
} else {
$off += $r;
}
}
return $off;
}
my $blocksize = $ENV{BLOCKSIZE} || 16384;
my @compress_cmd;
my ($opt_help, $opt_version);
GetOptions(
'blocksize=i' => \$blocksize,
'z|gzip' => sub { @compress_cmd = qw(gzip -f) },
'lzop' => sub { @compress_cmd = qw(lzop -f) },
'help' => \$opt_help,
'version' => \$opt_version,
) or pod2usage(1);
if ($opt_help) {
pod2usage(0);
} elsif ($opt_version) {
print "$VERSION\n";
exit 0;
}
if (@ARGV == 1) {
open STDIN, '<', $ARGV[0]
or die "failed to open:$ARGV[0]:$!";
}
my $compress_pid;
if (@compress_cmd) {
pipe my $rfh, my $wfh,
or die "failed to create pipe(2):$!";
unless ($compress_pid = fork) {
die "fork(2) failed:$!"
unless defined $compress_pid;
# child process
close $wfh;
open STDIN, '<&', $rfh
or die "dup(2) failed:$!";
exec @compress_cmd;
die "failed to exec(2):", join(' ', @compress_cmd), ":$!";
}
close $rfh;
open STDOUT, '>&', $wfh
or die "dup2 failed:$!";
close $wfh;
}
# open files
open my $new_digest_fp, '>&=', 6
or die "cloud not open digest data output (fd:6):$!";
my $orig_digest_fp;
if (open $orig_digest_fp, '<&=', 5) {
readall($orig_digest_fp, \my $bsbin, 4) == 4
or die "old digest data is corrupt";
$blocksize = unpack 'V', $bsbin;
} else {
undef $orig_digest_fp;
}
# write block size
syswrite(STDOUT, pack('V', $blocksize)) == 4
or die "failed to write digest data (fd:1):$!";
syswrite($new_digest_fp, pack('V', $blocksize)) == 4
or die "failed to write digest data (fd:6):$!";
for (my $offset = 0;
(my $rlen = readall(\*STDIN, \my $block, $blocksize)) != 0;
$offset += $rlen) {
die "failed to read data:$!"
if $rlen == -1;
my $digest = md5($block);
my $orig_digest;
if ($orig_digest_fp
&& (readall($orig_digest_fp, \$orig_digest, length $digest)
== length $digest)
&& $digest eq $orig_digest) {
# no need to dump data
} else {
# dump data
(syswrite(STDOUT, pack('V2', $offset % 2**32, $offset / 2**32)) == 8
and syswrite(STDOUT, $block) == $rlen)
or die "failed to write patch data (fd:1):$!";
}
# write digest
syswrite($new_digest_fp, $digest) == length $digest
or die "failed to write digest data (fd:6):$!";
}
close $orig_digest_fp
if $orig_digest_fp;
close $new_digest_fp
or die "failed to close digest output (fd:6):$!";
close STDOUT
or die "failed to close stdout:$!";
if ($compress_pid) {
while (wait != $compress_pid) {}
my $status = $?;
exit 1
unless WIFEXITED($status) && WEXITSTATUS($status) == 0;
}
exit 0;
__END__
=head1 NAME
blockdiff_dump - block-based diff (with separate md5 file)
=head1 SYNOPSIS
# take full backup
blockdiff_dump [opts] < file 6> backup_md5.1 > backup.1
# take inrcemental backups
blockdiff_dump [opts] < file 5< backup_md5.1 6> backup_md5.2 > backup.2
blockdiff_dump [opts] < file 5< backup_md5.2 6> backup_md5.3 > backup.3
...
=over 4
=item --blocksize=bytes
block size used (default: 16384)
=item -z, --gzip
use gzip for compression (requires gzip to be installed)
=item --lzop
use lzop for compression (requires lzop to be installed)
=back
=head1 DESCRIPTION
Blockdiff_dump is a low-level dump script for taking block-based diffs.
=head1 SEE ALSO
L<App::Blockdiff> - for general information
=head1 AUTHOR
Copyright (C) 2009 Cybozu Labs, Inc., written by Kazuho Oku
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
See http://www.perl.com/perl/misc/Artistic.html
=cut
Jump to Line
Something went wrong with that request. Please try again.