mirror of
https://git.FreeBSD.org/src.git
synced 2024-11-24 07:40:52 +00:00
289 lines
8.6 KiB
Tcl
Executable File
289 lines
8.6 KiB
Tcl
Executable File
#!/bin/sh
|
|
# tcl magic \
|
|
exec tclsh $0 $*
|
|
################################################################################
|
|
# Copyright (C) 1997
|
|
# Michael Smith. All rights reserved.
|
|
#
|
|
# Redistribution and use in source and binary forms, with or without
|
|
# modification, are permitted provided that the following conditions
|
|
# are met:
|
|
# 1. Redistributions of source code must retain the above copyright
|
|
# notice, this list of conditions and the following disclaimer.
|
|
# 2. Redistributions in binary form must reproduce the above copyright
|
|
# notice, this list of conditions and the following disclaimer in the
|
|
# documentation and/or other materials provided with the distribution.
|
|
# 3. Neither the name of the author nor the names of any co-contributors
|
|
# may be used to endorse or promote products derived from this software
|
|
# without specific prior written permission.
|
|
#
|
|
# THIS SOFTWARE IS PROVIDED BY Michael Smith AND CONTRIBUTORS ``AS IS'' AND
|
|
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
# ARE DISCLAIMED. IN NO EVENT SHALL Michael Smith OR CONTRIBUTORS BE LIABLE
|
|
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
# SUCH DAMAGE.
|
|
################################################################################
|
|
#
|
|
# LibraryReport; produce a list of shared libraries on the system, and a list of
|
|
# all executables that use them.
|
|
#
|
|
################################################################################
|
|
#
|
|
# Stage 1 looks for shared libraries; the output of 'ldconfig -r' is examined
|
|
# for hints as to where to look for libraries (but not trusted as a complete
|
|
# list).
|
|
#
|
|
# These libraries each get an entry in the global 'Libs()' array.
|
|
#
|
|
# Stage 2 walks the entire system directory heirachy looking for executable
|
|
# files, applies 'ldd' to them and attempts to determine which libraries are
|
|
# used. The path of the executable is then added to the 'Libs()' array
|
|
# for each library used.
|
|
#
|
|
# Stage 3 reports on the day's findings.
|
|
#
|
|
################################################################################
|
|
#
|
|
#
|
|
|
|
#########################################################################################
|
|
# findLibs
|
|
#
|
|
# Ask ldconfig where it thinks libraries are to be found. Go look for them, and
|
|
# add an element to 'Libs' for everything that looks like a library.
|
|
#
|
|
proc findLibs {} {
|
|
|
|
global Libs stats verbose;
|
|
|
|
# Older ldconfigs return a junk value when asked for a report
|
|
if {[catch {set liblist [exec ldconfig -r]} err]} { # get ldconfig output
|
|
puts stderr "ldconfig returned nonzero, persevering.";
|
|
set liblist $err; # there's junk in this
|
|
}
|
|
|
|
# remove hintsfile name, convert to list
|
|
set liblist [lrange [split $liblist "\n"] 1 end];
|
|
|
|
set libdirs ""; # no directories yet
|
|
foreach line $liblist {
|
|
# parse ldconfig output
|
|
if {[scan $line "%s => %s" junk libname] == 2} {
|
|
# find directory name
|
|
set libdir [file dirname $libname];
|
|
# have we got this one already?
|
|
if {[lsearch -exact $libdirs $libdir] == -1} {
|
|
lappend libdirs $libdir;
|
|
}
|
|
} else {
|
|
puts stderr "Unparseable ldconfig output line :";
|
|
puts stderr $line;
|
|
}
|
|
}
|
|
|
|
# libdirs is now a list of directories that we might find libraries in
|
|
foreach dir $libdirs {
|
|
# get the names of anything that looks like a library
|
|
set libnames [glob -nocomplain "$dir/lib*.so.*"]
|
|
foreach lib $libnames {
|
|
set type [file type $lib]; # what is it?
|
|
switch $type {
|
|
file { # looks like a library
|
|
# may have already been referenced by a symlink
|
|
if {![info exists Libs($lib)]} {
|
|
set Libs($lib) ""; # add it to our list
|
|
if {$verbose} {puts "+ $lib";}
|
|
}
|
|
}
|
|
link { # symlink; probably to another library
|
|
# If the readlink fails, the symlink is stale
|
|
if {[catch {set ldest [file readlink $lib]}]} {
|
|
puts stderr "Symbolic link points to nothing : $lib";
|
|
} else {
|
|
# may have already been referenced by another symlink
|
|
if {![info exists Libs($lib)]} {
|
|
set Libs($lib) ""; # add it to our list
|
|
if {$verbose} {puts "+ $lib";}
|
|
}
|
|
# list the symlink as a consumer of this library
|
|
lappend Libs($ldest) "($lib)";
|
|
if {$verbose} {puts "-> $ldest";}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
set stats(libs) [llength [array names Libs]];
|
|
}
|
|
|
|
################################################################################
|
|
# findLibUsers
|
|
#
|
|
# Look in the directory (dir) for executables. If we find any, call
|
|
# examineExecutable to see if it uses any shared libraries. Call ourselves
|
|
# on any directories we find.
|
|
#
|
|
# Note that the use of "*" as a glob pattern means we miss directories and
|
|
# executables starting with '.'. This is a Feature.
|
|
#
|
|
proc findLibUsers {dir} {
|
|
|
|
global stats verbose;
|
|
|
|
if {[catch {
|
|
set ents [glob -nocomplain "$dir/*"];
|
|
} msg]} {
|
|
if {$msg == ""} {
|
|
set msg "permission denied";
|
|
}
|
|
puts stderr "Can't search under '$dir' : $msg";
|
|
return ;
|
|
}
|
|
|
|
if {$verbose} {puts "===>> $dir";}
|
|
incr stats(dirs);
|
|
|
|
# files?
|
|
foreach f $ents {
|
|
# executable?
|
|
if {[file executable $f]} {
|
|
# really a file?
|
|
if {[file isfile $f]} {
|
|
incr stats(files);
|
|
examineExecutable $f;
|
|
}
|
|
}
|
|
}
|
|
# subdirs?
|
|
foreach f $ents {
|
|
# maybe a directory with more files?
|
|
# don't use 'file isdirectory' because that follows symlinks
|
|
if {[catch {set type [file type $f]}]} {
|
|
continue ; # may not be able to stat
|
|
}
|
|
if {$type == "directory"} {
|
|
findLibUsers $f;
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
# examineExecutable
|
|
#
|
|
# Look at (fname) and see if ldd thinks it references any shared libraries.
|
|
# If it does, update Libs with the information.
|
|
#
|
|
proc examineExecutable {fname} {
|
|
|
|
global Libs stats verbose;
|
|
|
|
# ask Mr. Ldd.
|
|
if {[catch {set result [exec ldd $fname]} msg]} {
|
|
return ; # not dynamic
|
|
}
|
|
|
|
if {$verbose} {puts -nonewline "$fname : ";}
|
|
incr stats(execs);
|
|
|
|
# For a non-shared executable, we get a single-line error message.
|
|
# For a shared executable, we get a heading line, so in either case
|
|
# we can discard the first line and any subsequent lines are libraries
|
|
# that are required.
|
|
set llist [lrange [split $result "\n"] 1 end];
|
|
set uses "";
|
|
|
|
foreach line $llist {
|
|
if {[scan $line "%s => %s %s" junk1 lib junk2] == 3} {
|
|
if {$lib == "not"} { # "not found" error
|
|
set mlname [string range $junk1 2 end];
|
|
puts stderr "$fname : library '$mlname' not known.";
|
|
} else {
|
|
lappend Libs($lib) $fname;
|
|
lappend uses $lib;
|
|
}
|
|
} else {
|
|
puts stderr "Unparseable ldd output line :";
|
|
puts stderr $line;
|
|
}
|
|
}
|
|
if {$verbose} {puts "$uses";}
|
|
}
|
|
|
|
################################################################################
|
|
# emitLibDetails
|
|
#
|
|
# Emit a listing of libraries and the executables that use them.
|
|
#
|
|
proc emitLibDetails {} {
|
|
|
|
global Libs;
|
|
|
|
# divide into used/unused
|
|
set used "";
|
|
set unused "";
|
|
foreach lib [array names Libs] {
|
|
if {$Libs($lib) == ""} {
|
|
lappend unused $lib;
|
|
} else {
|
|
lappend used $lib;
|
|
}
|
|
}
|
|
|
|
# emit used list
|
|
puts "== Current Shared Libraries ==================================================";
|
|
foreach lib [lsort $used] {
|
|
# sort executable names
|
|
set users [lsort $Libs($lib)];
|
|
puts [format "%-30s %s" $lib $users];
|
|
}
|
|
# emit unused
|
|
puts "== Stale Shared Libraries ====================================================";
|
|
foreach lib [lsort $unused] {
|
|
# sort executable names
|
|
set users [lsort $Libs($lib)];
|
|
puts [format "%-30s %s" $lib $users];
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
# Run the whole shebang
|
|
#
|
|
proc main {} {
|
|
|
|
global stats verbose argv;
|
|
|
|
set verbose 0;
|
|
foreach arg $argv {
|
|
switch -- $arg {
|
|
-v {
|
|
set verbose 1;
|
|
}
|
|
default {
|
|
puts stderr "Unknown option '$arg'.";
|
|
exit ;
|
|
}
|
|
}
|
|
}
|
|
|
|
set stats(libs) 0;
|
|
set stats(dirs) 0;
|
|
set stats(files) 0;
|
|
set stats(execs) 0
|
|
|
|
findLibs;
|
|
findLibUsers "/";
|
|
emitLibDetails;
|
|
|
|
puts [format "Searched %d directories, %d executables (%d dynamic) for %d libraries." \
|
|
$stats(dirs) $stats(files) $stats(execs) $stats(libs)];
|
|
}
|
|
|
|
################################################################################
|
|
main;
|