X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?p=dupemerge;a=blobdiff_plain;f=dm6;h=34bb654f41f9bf77c33e933557414e51e99c2a68;hp=c5ce5d45ee6ec6e0760df40589bef258d3ca1e54;hb=941242a8d5dfcd2fbbbd306d00ef38115f841600;hpb=8104c13303bb6b502c35ace2d956919367e51760 diff --git a/dm6 b/dm6 index c5ce5d4..34bb654 100755 --- a/dm6 +++ b/dm6 @@ -6,6 +6,8 @@ use Fcntl qw(:DEFAULT :flock); use File::Compare; use File::Path; use File::Temp; +use File::stat; +use MIME::Base64; # Copyright (C) 2010 Zygo Blaxell @@ -38,6 +40,8 @@ sub usage { die < $tmp_to: $!"; + print STDERR "\bR"; unless (rename($tmp_to, $to)) { my $saved_bang = $!; + print STDERR "\bU"; unlink($tmp_to) or warn "unlink: $tmp_to: $!"; # Try, possibly in vain, to clean up die "rename: $tmp_to -> $from: $saved_bang"; } + print STDERR "\b"; } my $link_dir = shift @ARGV; -(-d $link_dir) or usage; +usage unless $link_dir; + +my $prefix_length = 3; + +sub slash_prefix { + my ($file) = @_; + $file .= '_' x (length($file) + 1 - $prefix_length) if length($file) + 1 < $prefix_length; + my $prefix = substr($file, 0, $prefix_length); + my $suffix = substr($file, $prefix_length); + $prefix =~ s:(.):$1/:osg; + chop($prefix); + return ($prefix, $suffix); +} + +sub mkdir_p { + my ($dir) = @_; + return if -d $dir; + $dir =~ s:/+$::os; + my $parent; + ($parent = $dir) =~ s:[^/]+$::os; + if ($parent ne $dir) { + mkdir_p($parent); + print STDERR 'm'; + mkdir($dir) or die "mkdir: $dir: $!"; + } + die "mkdir: $dir: $!" unless -d $dir; +} + +sub prepare_parents { + my ($link_dir, $file) = @_; + my ($prefix, $suffix) = slash_prefix($file); + my $parent = "$link_dir/$prefix"; + mkdir_p($parent); + return "$parent/$suffix"; +} + +sub name_quad { + my ($int64) = @_; + my $packed = pack('Q', $int64); + $packed =~ s/^\0+//os; + my $base64_packed = encode_base64($packed, ''); + # Don't strip off the trailing padding since it makes the string + # so short we end up just putting it back on again. + # $base64_packed =~ s/=+$//os; + return $base64_packed; +} + +sub name_ino { + my ($ino) = @_; + return name_quad($ino) . 'I'; +} + +# ext3 cannot handle more than 32000 links to a file. Leave some headroom. +# Arguably this should be configurable, but the losses are miniscule and +# the coding for option support is not. +my $link_count_max = 31990; $/ = "\0"; while () { my $file = $_; eval { - chomp $file; - print STDERR "digest($file) = "; - my $digest = digest($file); - $digest =~ y:/:_:; - print STDERR "$digest\n"; - $digest =~ s:^(.)(.)(.):$1/$2/$3:osg; - my ($parent) = ($digest =~ m:^(.*/):osg); - $parent = "$link_dir/$parent"; - mkpath($parent, { verbose => 1 }); - die "mkpath: $parent: $!" unless -d $parent; - link_files($file, "$link_dir/$digest"); + for (1) { + chomp $file; + + # Get file stat data + print STDERR '.'; + my $st = lstat($file); + die "lstat: $file: $!" unless $st; + + # Oops? + next unless -f _; + + # Skip the file if it has far too many links already + next if ($st->nlink > $link_count_max); + + # Check link to inode + my $inode_link = prepare_parents($link_dir, name_ino($st->ino)); + print STDERR 'I'; + my $inode_st = lstat($inode_link); + my $update_links; + if ($inode_st) { + my $inode_dev = $inode_st->dev; + my $inode_ino = $inode_st->ino; + my $file_dev = $st->dev; + my $file_ino = $st->ino; + if ($inode_ino != $file_ino || $inode_dev != $file_dev) { + warn "inode link '$inode_link' is wrong (inode $inode_ino should be $file_ino)" if $inode_ino != $file_ino; + warn "inode link '$inode_link' is wrong (dev $inode_dev should be $file_dev)" if $inode_dev != $file_dev; + $update_links = 1; + } + } else { + $update_links = 1; + } + print STDERR "\b"; + + # If neither criteria for updating link is met, leave it as-is + next unless $update_links; + + # Compute digest + print STDERR 'd'; + my $digest = digest($file); + print STDERR "\b"; + + # Base64 uses /, we prefer _ + $digest =~ y:/:_:; + + # Check link to digest + my $digest_link = prepare_parents($link_dir, "${digest}D"); + print STDERR 'D'; + my $digest_st = lstat($digest_link); + if ($digest_st) { + my $digest_nlink = $digest_st->nlink; + if ($digest_nlink > 31990) { + print STDERR 'u'; + unlink($digest_link) or die "unlink: $digest_link: $!"; + undef $digest_st; + } + } + print STDERR "\b"; + + # Which file are we keeping? + my $keep_ino; + + # If digest link exists, link it to file + if ($digest_st) { + print STDERR 'c'; + die "NOT identical!" if compare($digest_link, $file); + + # Old, replace input with old file + print STDERR '-'; + link_files($digest_link, $file); + $keep_ino = $digest_st->ino; + } else { + # New, add input to digest + print STDERR '+'; + link_files($file, $digest_link); + $keep_ino = $st->ino; + } + + # A link to the inode indicates we are done, so do it last + $inode_link = prepare_parents($link_dir, name_ino($keep_ino)); + print STDERR ' '; + link_files($digest_link, $inode_link); + + } }; warn "$file: $@" if $@; } +# Garbage collection +print STDERR "\nGarbage collection in '$link_dir'..."; +chdir($link_dir) || die "chdir: $link_dir: $!"; +print STDERR "\nRemoving files with link count < 3..."; +system("find . -type f -links -3 -print0 | xargs -0rt rm -f") and die "system: exit status $?"; +print STDERR "\nRemoving empty directories..."; +system("find . -type d -empty -print0 | xargs -0rt rmdir -p --ignore-fail-on-non-empty") and die "system: exit status $?"; +print STDERR "\nDone.\n"; + exit(0); __END__