detect backup file timewarps
[ipreg/sccs2rcs2cvs2git.git] / sccscheck
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use feature 'switch';
7
8 use File::Find;
9 use POSIX;
10
11 unless (@ARGV) {
12 die <<USAGE;
13 usage: sccscheck [directory]
14
15 Scan the directory tree for anomalies:
16
17 gzipped files
18 backup ~ files
19 symlinks
20 SCCS files without working files
21 working files without SCCS files
22 working files which do not match the latest SCCS revision
23
24 USAGE
25 }
26
27 # case-sensitive -f
28 sub _f {
29 my $f = shift;
30 return -f $f && 1 == grep { $_ eq $f } glob "$f*";
31 }
32
33 find { wanted => \&found, no_chdir => 1}, @ARGV;
34
35 sub found {
36 given ($File::Find::name) {
37 when (m{^(.*)/SCCS/s\.([^/]+)$}s) {
38 when (m{~$}) {
39 print "SCCS BACK $_\n";
40 }
41 when (m{\.gz$}) {
42 print "SCCS GZIP $_\n";
43 }
44 when (! _f "$1/$2") {
45 print "SCCS UNGET $_\n";
46 }
47 }
48 when (m{^(.*)/SCCS/p\.([^/]+)$}s) {
49 print "SCCS LOCK $_\n";
50 }
51 when (m{^(.*)/([^/]+)(\.orig|~)$}s) {
52 my $sccs = "$1/SCCS/s.$2";
53 when (_f $sccs) {
54 # was the backup checked in?
55 my $mtime = strftime "%Y-%m-%d.%H:%M:%S%z",
56 localtime((stat)[9]);
57 my $qsccs = quotemeta $sccs;
58 my $qback = quotemeta $_;
59 my @revs = qx{sccs prs -e -d:I: $qsccs};
60 for my $rev (@revs) {
61 chomp $rev;
62 system "sccs get -s -k -p -r$rev $qsccs | diff -u - $qback >/dev/null";
63 if ($? == 0) {
64 print "BACKSCCS $rev $_\n";
65 break;
66 }
67 }
68 my $time1 = qx{sccs prs -r1.1 -d':D:.:T:' $qsccs};
69 $time1 =~ s{^([789])}{19$1} or $time1 =~ s{^}{20};
70 if ($mtime lt $time1) {
71 print "BACKSCCS PREDATE $mtime $time1 $_\n";
72 } else {
73 print "BACKSCCS NOMATCH $mtime $time1 $_\n";
74 }
75 continue;
76 }
77 when (_f "$1/$2") {
78 my $qback = quotemeta $_;
79 my $qfile = quotemeta "$1/$2";
80 system "diff -u $qback $qfile >/dev/null";
81 if (not $?) {
82 print "BACKSAME $_\n"
83 } else {
84 my $backtime = (stat $_)[9];
85 my $filetime = (stat "$1/$2")[9];
86 if ($backtime < $filetime) {
87 print "BACKDIFF $_\n";
88 } else {
89 print "BACKTIMEWARP $_\n";
90 }
91 }
92 }
93 print "BACKLESS $_\n";
94 }
95 when (m{\.gz$}) {
96 print "GZIP $_\n";
97 }
98 when (-l) {
99 print "LINK $_\n";
100 }
101 when (-d) {
102 # skip
103 }
104 default {
105 m{^(.*)/([^/]+)$}s;
106 my $sccs = "$1/SCCS/s.$2";
107 when (! _f $sccs) {
108 print "NO SCCS $_\n";
109 }
110 my $qsccs = quotemeta $sccs;
111 my $qfile = quotemeta $_;
112 system "sccs get -s -k -p $qsccs | diff -u - $qfile";
113 print "DIFF $_\n" if $?;
114 }
115 }
116 }