1#!/bin/sh
2# tcl magic \
3exec 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#
63proc 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#
137proc 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#
184proc 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#
225proc 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#
259proc 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################################################################################
290main;
291