git.sur5r.net Git - bacula/bacula/blob - regress/scripts/diff.pl

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5     diff.pl -- Helper to diff files (rights, acl and content)
   6
   7 =head2 USAGE
   8
   9     diff.pl -s source -d dest [-e exclude ] [--acl | --attr | --wattr]
  10
  11 =cut
  12
  13 use strict;
  14 use Cwd 'chdir';
  15 use File::Find;
  16 no warnings 'File::Find';
  17 use Digest::MD5;
  18 use Getopt::Long ;
  19 use Pod::Usage;
  20 use Data::Dumper;
  21 use Cwd;
  22 use POSIX qw/strftime/;
  23
  24 my ($src, $dst, $help, $acl, $attr, $wattr,
  25     $dest_attrib, $src_attrib, $mtimedir);
  26 my %src_attr;
  27 my %dst_attr;
  28 my @exclude;
  29 my $hash;
  30 my $ret=0;
  31
  32 GetOptions("src=s"   => \$src,        # source directory
  33            "dst=s"   => \$dst,        # dest directory
  34            "acl"     => \$acl,        # acl test
  35            "attr"    => \$attr,       # attributes test
  36            "wattr"   => \$wattr,      # windows attributes
  37            "mtime-dir" => \$mtimedir, # check mtime on directories
  38            "exclude=s@" => \@exclude, # exclude some files
  39            "help"    => \$help,
  40     ) or pod2usage(-verbose => 1,
  41                    -exitval => 1);
  42 if (!$src or !$dst) {
  43    pod2usage(-verbose => 1,
  44              -exitval => 1);
  45 }
  46
  47 if ($help) {
  48     pod2usage(-verbose => 2,
  49               -exitval => 0);
  50 }
  51 my $md5 = Digest::MD5->new;
  52
  53 my $dir = getcwd;
  54
  55 chdir($src) or die "ERROR: Can't access to $src";
  56 $hash = \%src_attr;
  57 find(\&wanted_src, '.');
  58
  59 if ($wattr) {
  60     $src_attrib = `attrib /D /S`;
  61     $src_attrib = strip_base($src_attrib, $src);
  62 }
  63
  64 chdir ($dir);
  65
  66 chdir($dst) or die "ERROR: Can't access to $dst";
  67 $hash = \%dst_attr;
  68 find(\&wanted_src, '.');
  69
  70 if ($wattr) {
  71     $dest_attrib = `attrib /D /S`;
  72     $dest_attrib = strip_base($dest_attrib, $dst);
  73
  74     if (lc($src_attrib) ne lc($dest_attrib)) {
  75         $ret++;
  76         print "diff.pl ERROR: Differences between windows attributes\n",
  77               "$src_attrib\n=========\n$dest_attrib\n";
  78     }
  79 }
  80
  81 #print Data::Dumper::Dumper(\%src_attr);
  82 #print Data::Dumper::Dumper(\%dst_attr);
  83
  84 foreach my $f (keys %src_attr)
  85 {
  86     if (!defined $dst_attr{$f}) {
  87         $ret++;
  88         print "diff.pl ERROR: Can't find $f in dst\n";
  89
  90     } else {
  91         compare($src_attr{$f}, $dst_attr{$f});
  92     }
  93     delete $src_attr{$f};
  94     delete $dst_attr{$f};
  95 }
  96
  97 foreach my $f (keys %dst_attr)
  98 {
  99     $ret++;
 100     print "diff.pl ERROR: Can't find $f in src\n";
 101 }
 102
 103 if ($ret) {
 104     print "diff.pl ERROR: found $ret error(s)\n";
 105 }
 106
 107 exit $ret;
 108
 109 # convert \ to / and strip the path
 110 sub strip_base
 111 {
 112     my ($data, $path) = @_;
 113     $data =~ s!\\!/!sg;
 114     $data =~ s!\Q$path!!sig;
 115     return $data;
 116 }
 117
 118 sub compare
 119 {
 120     my ($h1, $h2) = @_;
 121     my ($f1, $f2) = ($h1->{file}, $h2->{file});
 122     my %attr = %$h2;
 123     foreach my $k (keys %$h1) {
 124         if (!exists $h2->{$k}) {
 125             $ret++;
 126             print "diff.pl ERROR: Can't find $k for dest $f2 ($k=$h1->{$k})\n";
 127         }
 128         if (!defined $h2->{$k}) {
 129             $ret++;
 130             print "diff.pl ERROR: $k not found in destination ", $h1->{file}, "\n";
 131             print Data::Dumper::Dumper($h1, $h2);
 132         } elsif ($h2->{$k} ne $h1->{$k}) {
 133             $ret++;
 134             my ($val1, $val2) = ($h1->{$k}, $h2->{$k});
 135             if ($k =~ /time/) {
 136                 ($val1, $val2) =
 137                     (map { strftime('%F %T', localtime($_)) } ($val1, $val2));
 138             }
 139             print "diff.pl ERROR: src and dst $f2 differ on $k ($val1 != $val2)\n";
 140         }
 141         delete $attr{$k};
 142     }
 143
 144     foreach my $k (keys %attr) {
 145         $ret++;
 146         print "diff.pl ERROR: Found $k on dst file and not on src ($k=$h2->{$k})\n";
 147     }
 148 }
 149
 150 sub wanted_src
 151 {
 152     my $f = $_;
 153     if (grep ($f, @exclude)) {
 154         return;
 155     }
 156     if (-l $f) {
 157         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 158             $atime,$mtime,$ctime,$blksize,$blocks) = lstat($f);
 159
 160         my $target = readlink($f);
 161         $hash->{$File::Find::name} = {
 162             nlink => $nlink,
 163             uid => $uid,
 164             gid => $gid,
 165             mtime => 0,
 166             target => $target,
 167             type => 'l',
 168             file => $File::Find::name,
 169         };
 170         return;
 171     }
 172
 173     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 174         $atime,$mtime,$ctime,$blksize,$blocks) = stat($f);
 175
 176     if (-f $f)  {
 177         $hash->{$File::Find::name} = {
 178             mode => $mode,
 179             nlink => $nlink,
 180             uid => $uid,
 181             gid => $gid,
 182             size => $size,
 183             mtime => $mtime,
 184             type => 'f',
 185             file => $File::Find::name,
 186         };
 187         $md5->reset;
 188         open(FILE, '<', $f) or die "ERROR: Can't open '$f': $!";
 189         binmode(FILE);
 190         $hash->{$File::Find::name}->{md5} = $md5->addfile(*FILE)->hexdigest;
 191         close(FILE);
 192
 193     } elsif (-d $f) {
 194         $hash->{$File::Find::name} = {
 195             mode => $mode,
 196             uid => $uid,
 197             gid => $gid,
 198             mtime => ($mtimedir)?$mtime:0,
 199             type => 'd',
 200             file =>  $File::Find::name,
 201         };
 202
 203     } elsif (-b $f or -c $f) { # dev
 204         $hash->{$File::Find::name} = {
 205             mode => $mode,
 206             uid => $uid,
 207             gid => $gid,
 208             mtime => $mtime,
 209             rdev => $rdev,
 210             type => (-b $f)?'block':'char',
 211             file =>  $File::Find::name,
 212         };
 213
 214     } elsif (-p $f) { # named pipe
 215         $hash->{$File::Find::name} = {
 216             mode => $mode,
 217             uid => $uid,
 218             gid => $gid,
 219             mtime => $mtime,
 220             type => 'pipe',
 221             file =>  $File::Find::name,
 222         };
 223
 224     } else {                # other than file and directory
 225         return;
 226     }
 227
 228     my $fe = $f;
 229     $fe =~ s/"/\\"/g;
 230     if ($acl) {
 231         $hash->{$File::Find::name}->{acl} = `getfacl "$fe" 2>/dev/null`;
 232     }
 233     if ($attr) {
 234         $hash->{$File::Find::name}->{attr} = `getfattr "$fe" 2>/dev/null`;
 235     }
 236 }