verzia 1.6, 2005/07/24 21:40:48 |
verzia 1.7, 2005/07/25 15:06:49 |
|
|
# |
# |
# |
# |
|
|
# $Platon: scripts/perl/filesystem/hardlink-files.pl,v 1.5 2005/07/10 22:17:13 rajo Exp $ |
# $Platon: scripts/perl/filesystem/hardlink-files.pl,v 1.6 2005/07/24 21:40:48 rajo Exp $ |
|
|
use strict; |
use strict; |
|
|
Riadok 59 $start = [gettimeofday]; |
|
Riadok 59 $start = [gettimeofday]; |
|
*dir = *File::Find::dir; |
*dir = *File::Find::dir; |
*prune = *File::Find::prune; |
*prune = *File::Find::prune; |
|
|
|
sub file_writable_by_others($$;) |
|
{ # {{{ |
|
my ($file, $mode) = @_; |
|
|
|
#print "file = '$file', mode = '$mode'"; |
|
#use Data::Dumper; |
|
#print Dumper(caller, $file, $mode); |
|
|
|
return ($mode & 00022); |
|
} # }}} |
|
|
sub find_directories() |
sub find_directories() |
{ # {{{ |
{ # {{{ |
if (-d $file) { |
if (-d $file) { |
Riadok 75 sub make_md5sum() |
|
Riadok 86 sub make_md5sum() |
|
if (-f $file) { |
if (-f $file) { |
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = lstat($file); |
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = lstat($file); |
|
|
|
# |
|
# security checks: |
|
# |
|
if ((-f _ ? ! -o _ : 0) || # owned by effective uid? |
|
-l _ || -d _ || -p _ || -b _ || -c _ || -S _ || -t _) { |
|
print STDERR "WARNING: File '$file' is not a regular file or not owned by EUID. Ignored for security reason.\n"; |
|
return; |
|
} |
|
if (file_writable_by_others($file, $mode)) { |
|
print STDERR "WARNING: File '$file' is writable by others. Ignored for security reason.\n"; |
|
return; |
|
} |
|
|
|
my $perm = sprintf("%lo", $mode & 07777), # perm in decimal format |
|
|
my $abs_file = abs_path($file); |
my $abs_file = abs_path($file); |
my ($filename, $path, $suffix) = fileparse($abs_file, qr{\.[^.]+$}); |
my ($filename, $path, $suffix) = fileparse($abs_file, qr{\.[^.]+$}); |
$filename .= $suffix; |
$filename .= $suffix; |
Riadok 93 sub make_md5sum() |
|
Riadok 119 sub make_md5sum() |
|
if ( $cache->{$path}->{$filename}->{size} == $size |
if ( $cache->{$path}->{$filename}->{size} == $size |
and $cache->{$path}->{$filename}->{ino} == $ino |
and $cache->{$path}->{$filename}->{ino} == $ino |
and $cache->{$path}->{$filename}->{mtime} == $mtime |
and $cache->{$path}->{$filename}->{mtime} == $mtime |
|
and $cache->{$path}->{$filename}->{perm} == $perm |
) { |
) { |
$cache_valid = 1; |
$cache_valid = 1; |
} |
} |
else { |
else { |
print "File '$abs_file' modified, updating cache...\n"; |
print "File '$abs_file' modified (or permissions changed), updating cache...\n"; |
} |
} |
} # }}} |
} # }}} |
|
|
Riadok 120 sub make_md5sum() |
|
Riadok 147 sub make_md5sum() |
|
#dir => $dir, |
#dir => $dir, |
dev => $dev, |
dev => $dev, |
ino => $ino, |
ino => $ino, |
#mode => $mode, |
perm => $perm, |
#nlink => $nlink, |
#nlink => $nlink, |
#uid => $uid, |
#uid => $uid, |
#gid => $gid, |
#gid => $gid, |
|
|
# |
# |
# Load cache |
# Load cache |
# TODO: |
# TODO: |
|
my @ok_directories; |
foreach my $xdir (@directories) { # {{{ |
foreach my $xdir (@directories) { # {{{ |
my $file = "$xdir/$cache_file"; |
my $file = "$xdir/$cache_file"; |
if (-f $file) { |
|
|
if (file_writable_by_others($xdir, (lstat($xdir))[2] )) { |
|
print STDERR "WARNING: Cache dir '$xdir' is writable by others. Ignoring directory for security reason.\n"; |
|
next; |
|
} |
|
|
|
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = lstat($file); # create special _ filehandle, see below |
|
|
|
# |
|
# security checks: |
|
# |
|
if ((-f _ ? ! -o _ : 0) || # owned by effective uid? |
|
-l _ || -d _ || -p _ || -b _ || -c _ || -S _ || -t _) { |
|
print STDERR "WARNING: Cache file '$file' is not a regular file or not owned by EUID. Ignored for security reason.\n"; |
|
next; |
|
} |
|
|
|
if (-f _) { |
|
if (file_writable_by_others($file, $mode)) { |
|
print STDERR "WARNING: Cache file '$file' is writable by others. Ignored for security reason.\n"; |
|
next; |
|
} |
|
|
print "Trying to load cache file '$file' ... "; |
print "Trying to load cache file '$file' ... "; |
my $hardlink_cache = $dump->xml2pl($file); |
my $hardlink_cache; |
if (defined $hardlink_cache and ref($hardlink_cache) eq 'HASH') { |
eval { $hardlink_cache = $dump->xml2pl($file) }; |
|
if ($@) { |
|
print STDERR "FAILED: $@\n"; |
|
unlink $file or print STDERR "Can't remove cache file '$file', please remove them manualy\n"; |
|
} |
|
elsif (defined $hardlink_cache and ref($hardlink_cache) eq 'HASH') { |
$cache->{$xdir} = $hardlink_cache; |
$cache->{$xdir} = $hardlink_cache; |
print "OK\n" |
print "OK\n" |
} |
} |
|
else { |
|
print STDERR "FAILED: bad data structure\n"; |
|
} |
|
push @ok_directories, $xdir; |
} |
} |
} # }}} |
} # }}} |
|
|
|
# bad directories removed |
|
@directories = @ok_directories; |
|
|
find({ |
find({ |
wanted => \&make_md5sum, |
wanted => \&make_md5sum, |
bydepth => 0, |
bydepth => 0, |
Riadok 263 foreach my $dev (keys %$md5sums) { |
|
Riadok 325 foreach my $dev (keys %$md5sums) { |
|
print " [already linked]"; |
print " [already linked]"; |
} |
} |
else { |
else { |
unlink $arr[$i]->{filename} or warn "\n\nunlink error: $!\n"; |
if ($arr[0]->{perm} ne $arr[$i]->{perm}) { |
link $source, $arr[$i]->{filename} or warn "\n\nlink error: $!\n"; |
print STDERR "\n\nWARNING: file '$arr[$i]->{filename}' not linked to '$arr[0]->{filename}' due permission difference. Security reason."; |
|
} |
|
else { |
|
unlink $arr[$i]->{filename} or print STDERR "\n\nWARNING: nunlink error: $!\n"; |
|
link $source, $arr[$i]->{filename} or print STDERR "\n\nWARNING: link error: $!\n"; |
|
} |
} |
} |
} # }}} |
} # }}} |
print "\n\n"; |
print "\n\n"; |