From f6ecd9a8228606fc357caa1374c293fdac2e33bf Mon Sep 17 00:00:00 2001 From: Eric Bollengier Date: Tue, 22 Jun 2010 16:10:35 +0200 Subject: [PATCH] regress: update diff.pl - Fix problem when reading filename ending with space - Use lstat for symlinks - Don't compare atime between versions - Don't compare mtime/ctime for symlinks - add windows attributes testing - Don't compare ctime between versions --- regress/scripts/diff.pl | 107 +++++++++++++++++++++++++++------------- 1 file changed, 73 insertions(+), 34 deletions(-) diff --git a/regress/scripts/diff.pl b/regress/scripts/diff.pl index 54e2132df9..0136324433 100755 --- a/regress/scripts/diff.pl +++ b/regress/scripts/diff.pl @@ -6,7 +6,7 @@ =head2 USAGE - diff.pl -s source -d dest [--acl | --attr] + diff.pl -s source -d dest [--acl | --attr | --wattr] =cut @@ -19,17 +19,19 @@ use Getopt::Long ; use Pod::Usage; use Data::Dumper; use Cwd; +use POSIX qw/strftime/; -my ($src, $dst, $help, $acl, $attr); +my ($src, $dst, $help, $acl, $attr, $wattr, $dest_attrib, $src_attrib); my %src_attr; my %dst_attr; my $hash; my $ret=0; -GetOptions("src=s" => \$src, - "dst=s" => \$dst, - "acl" => \$acl, - "attr" => \$attr, +GetOptions("src=s" => \$src, # source directory + "dst=s" => \$dst, # dest directory + "acl" => \$acl, # acl test + "attr" => \$attr, # attributes test + "wattr" => \$wattr,# windows attributes "help" => \$help, ) or pod2usage(-verbose => 1, -exitval => 1); @@ -46,16 +48,32 @@ my $md5 = Digest::MD5->new; my $dir = getcwd; -chdir($src); +chdir($src) or die "E: Can't access to $src"; $hash = \%src_attr; find(\&wanted_src, '.'); +if ($wattr) { + $src_attrib = `attrib /D /S`; + $src_attrib = strip_base($src_attrib, $src); +} + chdir ($dir); -chdir($dst); +chdir($dst) or die "E: Can't access to $dst"; $hash = \%dst_attr; find(\&wanted_src, '.'); +if ($wattr) { + $dest_attrib = `attrib /D /S`; + $dest_attrib = strip_base($dest_attrib, $dst); + + if (lc($src_attrib) ne lc($dest_attrib)) { + $ret++; + print "E: Differences between windows attributes\n", + "$src_attrib\n=========\n$dest_attrib\n"; + } +} + #print Data::Dumper::Dumper(\%src_attr); #print Data::Dumper::Dumper(\%dst_attr); @@ -78,26 +96,48 @@ foreach my $f (keys %dst_attr) print "E: Can't find $f in src\n"; } +if ($ret) { + print "ERROR: found $ret error(s)\n"; +} + exit $ret; +# convert \ to / and strip the path +sub strip_base +{ + my ($data, $path) = @_; + $data =~ s!\\!/!sg; + $data =~ s!\Q$path!!sig; + return $data; +} + sub compare { my ($h1, $h2) = @_; my ($f1, $f2) = ($h1->{file}, $h2->{file}); + my %attr = %$h2; foreach my $k (keys %$h1) { if (!exists $h2->{$k}) { $ret++; print "E: Can't find $k for dest $f2 ($k=$h1->{$k})\n"; } - if ($h2->{$k} ne $h1->{$k}) { + if (!defined $h2->{$k}) { + $ret++; + print "E: $k not found in destination ", $h1->{file}, "\n"; + print Data::Dumper::Dumper($h1, $h2); + } elsif ($h2->{$k} ne $h1->{$k}) { $ret++; - print "E: src and dst $f2 differ on $k ($h1->{$k} != $h2->{$k})\n"; + my ($val1, $val2) = ($h1->{$k}, $h2->{$k}); + if ($k =~ /time/) { + ($val1, $val2) = + (map { strftime('%F %T', localtime($_)) } ($val1, $val2)); + } + print "E: src and dst $f2 differ on $k ($val1 != $val2)\n"; } - delete $h1->{$k}; - delete $h2->{$k}; + delete $attr{$k}; } - foreach my $k (keys %$h2) { + foreach my $k (keys %attr) { $ret++; print "E: Found $k on dst file and not on src ($k=$h2->{$k})\n"; } @@ -106,68 +146,67 @@ sub compare sub wanted_src { my $f = $_; - my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) = stat($f); - if (-l $f) { + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) = lstat($f); + my $target = readlink($f); $hash->{$File::Find::name} = { nlink => $nlink, uid => $uid, gid => $gid, - atime => $atime, - mtime => $mtime, - ctime => $ctime, + mtime => 0, target => $target, type => 'l', file => $File::Find::name, }; + return; + } - } elsif (-f $f) { + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) = stat($f); + + if (-f $f) { $hash->{$File::Find::name} = { mode => $mode, nlink => $nlink, uid => $uid, gid => $gid, size => $size, - atime => $atime, mtime => $mtime, - ctime => $ctime, type => 'f', file => $File::Find::name, }; $md5->reset; - open(FILE, $f) or die "Can't open '$f': $!"; + open(FILE, '<', $f) or die "Can't open '$f': $!"; binmode(FILE); $hash->{$File::Find::name}->{md5} = $md5->addfile(*FILE)->hexdigest; close(FILE); - + if ($acl) { - $hash->{$File::Find::name}->{acl} = `getfacl $f 2>/dev/null`; + $hash->{$File::Find::name}->{acl} = `getfacl "$f" 2>/dev/null`; } if ($attr) { - $hash->{$File::Find::name}->{attr} = `getfattr $f 2>/dev/null`; + $hash->{$File::Find::name}->{attr} = `getfattr "$f" 2>/dev/null`; } - + } elsif (-d $f) { $hash->{$File::Find::name} = { mode => $mode, uid => $uid, gid => $gid, - atime => $atime, mtime => $mtime, - ctime => $ctime, type => 'd', file => $File::Find::name, }; if ($acl) { - $hash->{$File::Find::name}->{acl} = `getfacl $f 2>/dev/null`; + $hash->{$File::Find::name}->{acl} = `getfacl "$f" 2>/dev/null`; } if ($attr) { - $hash->{$File::Find::name}->{attr} = `getfattr $f 2>/dev/null`; + $hash->{$File::Find::name}->{attr} = `getfattr "$f" 2>/dev/null`; } - - } else { - + + } else { # other than file and directory + } } -- 2.39.5