From: Eric Bollengier Date: Thu, 24 Jun 2010 14:53:59 +0000 (+0200) Subject: regress: backport diff.pl X-Git-Tag: Release-5.0.3~117 X-Git-Url: https://git.sur5r.net/?a=commitdiff_plain;h=762312c35293f41bfe039a9cee696b2c666e83fa;p=bacula%2Fbacula regress: backport diff.pl --- diff --git a/regress/scripts/diff.pl b/regress/scripts/diff.pl new file mode 100755 index 0000000000..a90e6a1901 --- /dev/null +++ b/regress/scripts/diff.pl @@ -0,0 +1,232 @@ +#!/usr/bin/perl -w + +=head1 NAME + + diff.pl -- Helper to diff files (rights, acl and content) + +=head2 USAGE + + diff.pl -s source -d dest [--acl | --attr | --wattr] + +=cut + +use strict; +use Cwd 'chdir'; +use File::Find; +no warnings 'File::Find'; +use Digest::MD5; +use Getopt::Long ; +use Pod::Usage; +use Data::Dumper; +use Cwd; +use POSIX qw/strftime/; + +my ($src, $dst, $help, $acl, $attr, $wattr, + $dest_attrib, $src_attrib, $mtimedir); +my %src_attr; +my %dst_attr; +my $hash; +my $ret=0; + +GetOptions("src=s" => \$src, # source directory + "dst=s" => \$dst, # dest directory + "acl" => \$acl, # acl test + "attr" => \$attr, # attributes test + "wattr" => \$wattr, # windows attributes + "mtime-dir" => \$mtimedir, # check mtime on directories + "help" => \$help, + ) or pod2usage(-verbose => 1, + -exitval => 1); +if (!$src or !$dst) { + pod2usage(-verbose => 1, + -exitval => 1); +} + +if ($help) { + pod2usage(-verbose => 2, + -exitval => 0); +} +my $md5 = Digest::MD5->new; + +my $dir = getcwd; + +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) 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); + +foreach my $f (keys %src_attr) +{ + if (!defined $dst_attr{$f}) { + $ret++; + print "E: Can't find $f in dst\n"; + + } else { + compare($src_attr{$f}, $dst_attr{$f}); + } + delete $src_attr{$f}; + delete $dst_attr{$f}; +} + +foreach my $f (keys %dst_attr) +{ + $ret++; + 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 (!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++; + 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 $attr{$k}; + } + + foreach my $k (keys %attr) { + $ret++; + print "E: Found $k on dst file and not on src ($k=$h2->{$k})\n"; + } +} + +sub wanted_src +{ + my $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, + mtime => 0, + target => $target, + type => 'l', + file => $File::Find::name, + }; + return; + } + + 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, + mtime => $mtime, + type => 'f', + file => $File::Find::name, + }; + $md5->reset; + open(FILE, '<', $f) or die "Can't open '$f': $!"; + binmode(FILE); + $hash->{$File::Find::name}->{md5} = $md5->addfile(*FILE)->hexdigest; + close(FILE); + + } elsif (-d $f) { + $hash->{$File::Find::name} = { + mode => $mode, + uid => $uid, + gid => $gid, + mtime => ($mtimedir)?$mtime:0, + type => 'd', + file => $File::Find::name, + }; + + } elsif (-b $f or -c $f) { # dev + $hash->{$File::Find::name} = { + mode => $mode, + uid => $uid, + gid => $gid, + mtime => $mtime, + rdev => $rdev, + type => (-b $f)?'block':'char', + file => $File::Find::name, + }; + + } elsif (-p $f) { # named pipe + $hash->{$File::Find::name} = { + mode => $mode, + uid => $uid, + gid => $gid, + mtime => $mtime, + type => 'pipe', + file => $File::Find::name, + }; + + } else { # other than file and directory + return; + } + + my $fe = $f; + $fe =~ s/"/\\"/g; + if ($acl) { + $hash->{$File::Find::name}->{acl} = `getfacl "$fe" 2>/dev/null`; + } + if ($attr) { + $hash->{$File::Find::name}->{attr} = `getfattr "$fe" 2>/dev/null`; + } +}