#!/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.
#
################################################################################
#
# $FreeBSD$
#
#########################################################################################
# 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;
