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