Platon Technologies
not logged in Login Registration
EnglishSlovak
open source software development celebrating 10 years of open source development! Wednesday, October 14, 2026
[BACK] [TXT][DIR] Up to [Platon] / scripts / perl / filesystem

Diff for scripts/perl/filesystem/hardlink-files.pl between version 1.6 and 1.7

version 1.6, 2005/07/24 21:40:48 version 1.7, 2005/07/25 15:06:49
Line 20 
Line 20 
 #  #
 #  #
   
 # $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;
   
Line 59  $start = [gettimeofday];
Line 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) {
Line 75  sub make_md5sum()
Line 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;
Line 93  sub make_md5sum()
Line 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";
                         }                          }
                 } # }}}                  } # }}}
   
Line 120  sub make_md5sum()
Line 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,
Line 144  find({
Line 171  find({
 #  #
 # 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,
Line 263  foreach my $dev (keys %$md5sums) {
Line 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";
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS 		Go to Top