1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
use strict;
use warnings;
use POSIX qw(strftime);
# is_subdir potential_base potential_subdir
# 1 = success ; if potential_subdir is a subdir of potential_base or they are
# the same
# 0 = failure ; otherwise
sub is_subdir($$)
{
my ($dir, $sub) = @_;
# compact multiple slashes
$dir =~ s#/+#/#g;
$sub =~ s#/+#/#g;
# strip trailing slash unless it's the root dir
$dir =~ s#/+$## unless $dir eq '/';
$sub =~ s#/+$## unless $sub eq '/';
# "the same"
return 1 if $dir eq $sub;
# / - special cases, which would need special treatment below
# every dir is a subdir of /
return 1 if $dir eq '/';
# no dir is parent of / (except for itself, but that was caught above)
return 0 if $sub eq '/';
# see, if $sub begins with $dir
if ($dir eq substr($sub, 0, length($dir))) {
# it does, so there are two possibilities:
if (substr($sub, length($dir), 1) eq '/') {
# the char in $sub after $dir is a slash (/dir/sub)
return 1;
} else {
# it's something else (/diranother/sub)
return 0
}
} else {
# if it's not, then $sub cannot possibly be a subdir of $dir
return 0;
}
}
sub ignores
{
my @lines = `cat /var/spool/cruft/IGNORES`;
chomp @lines;
return grep { $_ ne '' } @lines;
}
sub scan_fs
{
my @lines = `cat /var/spool/cruft/DRIVES`;
chomp @lines;
return @lines;
}
sub all_fs
{
my @all = `mount|cut -d\\ -f3`;
chomp @all;
push @all, '/' unless grep { '/' eq $_ } @all;
return @all if @all;
}
sub noscan_fs
{
my @all = all_fs;
my @ret;
my @do = scan_fs;
foreach my $a (@all) { push @ret, $a unless grep { $_ eq $a } @do };
return @ret;
}
sub get_direct_fs($@)
{
my $path = shift;
my $found = '';
foreach my $fs (@_) {
$fs =~ s#/+#/#g;
$found = $fs if
is_subdir($fs, $path)
and
length($fs) > length($found);
}
return $found || undef;
}
sub prunes($@)
{
my $path = shift;
my @prunes;
foreach my $prune (@_) {
push @prunes, "-wholename $prune -prune" if is_subdir($path, $prune);
}
return "\\( ".join(" -or ", @prunes)." \\) -or" if @prunes;
return '';
}
sub debug($)
{
# XXX this needs to be fixed to show nanosecods, to be consistent with shell date calls
printf STDERR ">[%s] [0] %s\n", strftime('%Y-%m-%d %H:%M:%S.?????????', localtime), $_[0] if defined $ENV{'CRUFT_DEBUG'} and $ENV{'CRUFT_DEBUG'} ne '';
}
1;
|
