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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
#!/usr/bin/perl
use File::Basename;
use Getopt::Long;
# this dependency analysis program is the only one which need to know
# the RPM buildroot to do its work.
# Figuring out what files are really executables via magic numbers is
# hard. Not only is every '#!' an executable of some type (with a
# potentially infinite supply of interpreters) but there are thousands
# of valid binary magic numbers for old OS's and old CPU types.
# Permissions do not always help discriminate binaries from the rest
# of the files, on Solaris the shared libraries are marked as
# 'executable'.
# -rwxr-xr-x 1 bin bin 1013248 Jul 1 1998 /lib/libc.so.1
# I would like to let the 'file' command take care of the magic
# numbers for us. Alas! under linux file prints different kind of
# messages for each interpreter, there is no common word 'script' to
# look for.
# ' perl commands text'
# ' Bourne shell script text'
# ' a /usr/bin/wish -f script text'
# WORSE on solaris there are entries which say:
# ' current ar archive, not a dynamic executable or shared object'
# how do I grep for 'executable' when people put a 'not executable' in
# there? I trim off everything after the first comma (if there is
# one) and if the result has the string 'executable' in it then it may
# be one.
# so we must also do some magic number processing ourselves, and be
# satisfied with 'good enough'.
# I look for files which have atleast one of the executable bits set
# and are either labled 'executable' by the file command (see above
# restriction) OR have a '#!' as their first two characters.
$is_mode_executable=oct(111);
# set a known path
$ENV{'PATH'}= (
':/usr/bin'.
':/bin'.
'');
# taint perl requires we clean up these bad environmental variables.
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
$BUILDROOT = '';
%option_linkage = (
"buildroot" => \$BUILDROOT,
);
if( !GetOptions (\%option_linkage, "buildroot=s") ) {
die("Illegal options in \@ARGV: '@ARGV'\n");
}
if ($BUILDROOT == '/') {
$BUILDROOT = '';
}
if ("@ARGV") {
foreach (@ARGV) {
process_file($_);
}
} else {
# notice we are passed a list of filenames NOT as common in unix the
# contents of the file.
foreach (<>) {
process_file($_);
}
}
foreach $module (sort keys %provides) {
print "executable($module)\n";
}
exit 0;
sub is_file_script {
my ($file) = @_;
chomp $file;
my $out = 0;
open(FILE, "<$file")||
die("$0: Could not open file: '$file' : $!\n");
my $rc = sysread(FILE,$line,2);
if ( ($rc > 1) && ($line =~ m/^\#\!/) ) {
$out = 1;
}
close(FILE) ||
die("$0: Could not close file: '$file' : $!\n");
return $out;
}
sub is_file_binary_executable {
my ($file) = @_;
$file_out=`file $file`;
# trim off any extra descriptions.
$file_out =~ s/\,.*$//;
my $out = 0;
if ($file_out =~ m/executable/ ) {
$out = 1;
}
return $out;
}
sub process_file {
my ($file) = @_;
chomp $file;
my $prov_name = $file;
$prov_name =~ s!^$BUILDROOT!!;
# If its a link find the file it points to. Dead links do not
# provide anything.
while (-l $file) {
my $newfile = readlink($file);
if ($newfile !~ m!^/!) {
$newfile = dirname($file).'/'.$newfile;
} else {
$newfile = $BUILDROOT.$newfile;
}
$file = $newfile;
}
(-f $file) || return ;
( (stat($file))[2] & $is_mode_executable ) || return ;
is_file_script($file) ||
is_file_binary_executable($file) ||
return ;
$provides{$prov_name}=1;
$provides{basename($prov_name)}=1;
return ;
}
|
