Change forgotten getinoquota to ext2_getinoquota to fix building
[dragonfly.git] / tools / LibraryReport / LibraryReport.tcl
1 #!/bin/sh
2 # tcl magic \
3 exec tclsh $0 $*
4 ################################################################################
5 # Copyright (C) 1997
6 #      Michael Smith.  All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions
10 # are met:
11 # 1. Redistributions of source code must retain the above copyright
12 #    notice, this list of conditions and the following disclaimer.
13 # 2. Redistributions in binary form must reproduce the above copyright
14 #    notice, this list of conditions and the following disclaimer in the
15 #    documentation and/or other materials provided with the distribution.
16 # 3. Neither the name of the author nor the names of any co-contributors
17 #    may be used to endorse or promote products derived from this software
18 #    without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY Michael Smith AND CONTRIBUTORS ``AS IS'' AND
21 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED.  IN NO EVENT SHALL Michael Smith OR CONTRIBUTORS BE LIABLE
24 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
26 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
27 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
29 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
30 # SUCH DAMAGE.
31 ################################################################################
32 #
33 # LibraryReport; produce a list of shared libraries on the system, and a list of
34 # all executables that use them.
35 #
36 ################################################################################
37 #
38 # Stage 1 looks for shared libraries; the output of 'ldconfig -r' is examined
39 # for hints as to where to look for libraries (but not trusted as a complete
40 # list).
41 #
42 # These libraries each get an entry in the global 'Libs()' array.
43 #
44 # Stage 2 walks the entire system directory heirachy looking for executable
45 # files, applies 'ldd' to them and attempts to determine which libraries are
46 # used.  The path of the executable is then added to the 'Libs()' array 
47 # for each library used.
48 #
49 # Stage 3 reports on the day's findings.
50 #
51 ################################################################################
52 #
53 # $FreeBSD: src/tools/LibraryReport/LibraryReport.tcl,v 1.5 1999/08/28 00:54:21 peter Exp $
54 # $DragonFly: src/tools/LibraryReport/LibraryReport.tcl,v 1.2 2003/06/17 04:29:11 dillon Exp $
55 #
56
57 #########################################################################################
58 # findLibs
59 #
60 # Ask ldconfig where it thinks libraries are to be found.  Go look for them, and
61 # add an element to 'Libs' for everything that looks like a library.
62 #
63 proc findLibs {} {
64
65     global Libs stats verbose;
66
67     # Older ldconfigs return a junk value when asked for a report
68     if {[catch {set liblist [exec ldconfig -r]} err]} { # get ldconfig output
69         puts stderr "ldconfig returned nonzero, persevering.";
70         set liblist $err;                               # there's junk in this
71     }
72
73     # remove hintsfile name, convert to list
74     set liblist [lrange [split $liblist "\n"] 1 end];
75
76     set libdirs "";                             # no directories yet
77     foreach line $liblist {
78         # parse ldconfig output
79         if {[scan $line "%s => %s" junk libname] == 2} {
80             # find directory name
81             set libdir [file dirname $libname];
82             # have we got this one already?
83             if {[lsearch -exact $libdirs $libdir] == -1} {
84                 lappend libdirs $libdir;
85             }
86         } else {
87             puts stderr "Unparseable ldconfig output line :";
88             puts stderr $line;
89         }
90     }
91     
92     # libdirs is now a list of directories that we might find libraries in
93     foreach dir $libdirs {
94         # get the names of anything that looks like a library
95         set libnames [glob -nocomplain "$dir/lib*.so.*"]
96         foreach lib $libnames {
97             set type [file type $lib];                  # what is it?
98             switch $type {
99                 file {          # looks like a library
100                     # may have already been referenced by a symlink
101                     if {![info exists Libs($lib)]} {
102                         set Libs($lib) "";              # add it to our list
103                         if {$verbose} {puts "+ $lib";}
104                     }
105                 }
106                 link {          # symlink; probably to another library
107                     # If the readlink fails, the symlink is stale
108                     if {[catch {set ldest [file readlink $lib]}]} {
109                         puts stderr "Symbolic link points to nothing : $lib";
110                     } else {
111                         # may have already been referenced by another symlink
112                         if {![info exists Libs($lib)]} {
113                             set Libs($lib) "";          # add it to our list
114                             if {$verbose} {puts "+ $lib";}
115                         }
116                         # list the symlink as a consumer of this library
117                         lappend Libs($ldest) "($lib)";
118                         if {$verbose} {puts "-> $ldest";}
119                     }
120                 }
121             }
122         }
123     }
124     set stats(libs) [llength [array names Libs]];
125 }
126
127 ################################################################################
128 # findLibUsers
129 #
130 # Look in the directory (dir) for executables.  If we find any, call 
131 # examineExecutable to see if it uses any shared libraries.  Call ourselves
132 # on any directories we find.
133 #
134 # Note that the use of "*" as a glob pattern means we miss directories and
135 # executables starting with '.'.  This is a Feature.
136 #
137 proc findLibUsers {dir} {
138
139     global stats verbose;
140
141     if {[catch {
142         set ents [glob -nocomplain "$dir/*"];
143     } msg]} {
144         if {$msg == ""} {
145             set msg "permission denied";
146         }
147         puts stderr "Can't search under '$dir' : $msg";
148         return ;
149     }
150
151     if {$verbose} {puts "===>> $dir";}
152     incr stats(dirs);
153
154     # files?
155     foreach f $ents {
156         # executable?
157         if {[file executable $f]} {
158             # really a file?
159             if {[file isfile $f]} {
160                 incr stats(files);
161                 examineExecutable $f;
162             }
163         }
164     }
165     # subdirs?
166     foreach f $ents {
167         # maybe a directory with more files?
168         # don't use 'file isdirectory' because that follows symlinks
169         if {[catch {set type [file type $f]}]} {
170             continue ;          # may not be able to stat
171         }
172         if {$type == "directory"} {
173             findLibUsers $f;
174         }
175     }
176 }
177
178 ################################################################################
179 # examineExecutable
180 #
181 # Look at (fname) and see if ldd thinks it references any shared libraries.
182 # If it does, update Libs with the information.
183 #
184 proc examineExecutable {fname} {
185
186     global Libs stats verbose;
187
188     # ask Mr. Ldd.
189     if {[catch {set result [exec ldd $fname]} msg]} {
190         return ;        # not dynamic
191     }
192
193     if {$verbose} {puts -nonewline "$fname : ";}
194     incr stats(execs);
195
196     # For a non-shared executable, we get a single-line error message.
197     # For a shared executable, we get a heading line, so in either case
198     # we can discard the first line and any subsequent lines are libraries
199     # that are required.
200     set llist [lrange [split $result "\n"] 1 end];
201     set uses "";
202
203     foreach line $llist {
204         if {[scan $line "%s => %s %s" junk1 lib junk2] == 3} {
205             if {$lib == "not"} {        # "not found" error
206                 set mlname [string range $junk1 2 end];
207                 puts stderr "$fname : library '$mlname' not known.";
208             } else {
209                 lappend Libs($lib) $fname;
210                 lappend uses $lib;
211             }
212         } else {
213             puts stderr "Unparseable ldd output line :";
214             puts stderr $line;
215         }
216     }
217     if {$verbose} {puts "$uses";}
218 }
219
220 ################################################################################
221 # emitLibDetails
222 #
223 # Emit a listing of libraries and the executables that use them.
224 #
225 proc emitLibDetails {} {
226
227     global Libs;
228
229     # divide into used/unused
230     set used "";
231     set unused "";
232     foreach lib [array names Libs] {
233         if {$Libs($lib) == ""} {
234             lappend unused $lib;
235         } else {
236             lappend used $lib;
237         }
238     }
239
240     # emit used list
241     puts "== Current Shared Libraries ==================================================";
242     foreach lib [lsort $used] {
243         # sort executable names
244         set users [lsort $Libs($lib)];
245         puts [format "%-30s  %s" $lib $users];
246     }
247     # emit unused
248     puts "== Stale Shared Libraries ====================================================";
249     foreach lib [lsort $unused] {
250         # sort executable names
251         set users [lsort $Libs($lib)];
252         puts [format "%-30s  %s" $lib $users];
253     }
254 }
255
256 ################################################################################
257 # Run the whole shebang
258 #
259 proc main {} {
260
261     global stats verbose argv;
262
263     set verbose 0;
264     foreach arg $argv {
265         switch -- $arg {
266             -v {
267                 set verbose 1;
268             }
269             default {
270                 puts stderr "Unknown option '$arg'.";
271                 exit ;
272             }
273         }
274     }
275
276     set stats(libs) 0;
277     set stats(dirs) 0;
278     set stats(files) 0;
279     set stats(execs) 0
280
281     findLibs;
282     findLibUsers "/";
283     emitLibDetails;
284
285     puts [format "Searched %d directories, %d executables (%d dynamic) for %d libraries." \
286               $stats(dirs) $stats(files) $stats(execs) $stats(libs)];
287 }
288
289 ################################################################################
290 main;