1#!@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
13use strict;
14use Cwd 'chdir';
15use File::Find;
16no warnings 'File::Find';
17use Digest::MD5;
18use Getopt::Long ;
19use Pod::Usage;
20use Data::Dumper;
21use Cwd;
22use POSIX qw/strftime/;
23
24my ($src, $dst, $help, $acl, $attr, $wattr,
25    $dest_attrib, $src_attrib, $mtimedir);
26my %src_attr;
27my %dst_attr;
28my @exclude;
29my $hash;
30my $ret=0;
31
32GetOptions("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);
42if (!$src or !$dst) {
43   pod2usage(-verbose => 1,
44             -exitval => 1);
45}
46
47if ($help) {
48    pod2usage(-verbose => 2,
49              -exitval => 0);
50}
51my $md5 = Digest::MD5->new;
52
53my $dir = getcwd;
54
55chdir($src) or die "ERROR: Can't access to $src";
56$hash = \%src_attr;
57find(\&wanted_src, '.');
58
59if ($wattr) {
60    $src_attrib = `attrib /D /S`;
61    $src_attrib = strip_base($src_attrib, $src);
62}
63
64chdir ($dir);
65
66chdir($dst) or die "ERROR: Can't access to $dst";
67$hash = \%dst_attr;
68find(\&wanted_src, '.');
69
70if ($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
84foreach 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
97foreach my $f (keys %dst_attr)
98{
99    $ret++;
100    print "diff.pl ERROR: Can't find $f in src\n";
101}
102
103if ($ret) {
104    print "diff.pl ERROR: found $ret error(s)\n";
105}
106
107exit $ret;
108
109# convert \ to / and strip the path
110sub strip_base
111{
112    my ($data, $path) = @_;
113    $data =~ s!\\!/!sg;
114    $data =~ s!\Q$path!!sig;
115    return $data;
116}
117
118sub 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
150sub 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}
237