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 #
  54
  55 #########################################################################################
  56 # findLibs
  57 #
  58 # Ask ldconfig where it thinks libraries are to be found.  Go look for them, and
  59 # add an element to 'Libs' for everything that looks like a library.
  60 #
  61 proc findLibs {} {
  62
  63     global Libs stats verbose;
  64
  65     # Older ldconfigs return a junk value when asked for a report
  66     if {[catch {set liblist [exec ldconfig -r]} err]} { # get ldconfig output
  67         puts stderr "ldconfig returned nonzero, persevering.";
  68         set liblist $err;                               # there's junk in this
  69     }
  70
  71     # remove hintsfile name, convert to list
  72     set liblist [lrange [split $liblist "\n"] 1 end];
  73
  74     set libdirs "";                             # no directories yet
  75     foreach line $liblist {
  76         # parse ldconfig output
  77         if {[scan $line "%s => %s" junk libname] == 2} {
  78             # find directory name
  79             set libdir [file dirname $libname];
  80             # have we got this one already?
  81             if {[lsearch -exact $libdirs $libdir] == -1} {
  82                 lappend libdirs $libdir;
  83             }
  84         } else {
  85             puts stderr "Unparseable ldconfig output line :";
  86             puts stderr $line;
  87         }
  88     }
  89
  90     # libdirs is now a list of directories that we might find libraries in
  91     foreach dir $libdirs {
  92         # get the names of anything that looks like a library
  93         set libnames [glob -nocomplain "$dir/lib*.so.*"]
  94         foreach lib $libnames {
  95             set type [file type $lib];                  # what is it?
  96             switch $type {
  97                 file {          # looks like a library
  98                     # may have already been referenced by a symlink
  99                     if {![info exists Libs($lib)]} {
 100                         set Libs($lib) "";              # add it to our list
 101                         if {$verbose} {puts "+ $lib";}
 102                     }
 103                 }
 104                 link {          # symlink; probably to another library
 105                     # If the readlink fails, the symlink is stale
 106                     if {[catch {set ldest [file readlink $lib]}]} {
 107                         puts stderr "Symbolic link points to nothing : $lib";
 108                     } else {
 109                         # may have already been referenced by another symlink
 110                         if {![info exists Libs($lib)]} {
 111                             set Libs($lib) "";          # add it to our list
 112                             if {$verbose} {puts "+ $lib";}
 113                         }
 114                         # list the symlink as a consumer of this library
 115                         lappend Libs($ldest) "($lib)";
 116                         if {$verbose} {puts "-> $ldest";}
 117                     }
 118                 }
 119             }
 120         }
 121     }
 122     set stats(libs) [llength [array names Libs]];
 123 }
 124
 125 ################################################################################
 126 # findLibUsers
 127 #
 128 # Look in the directory (dir) for executables.  If we find any, call
 129 # examineExecutable to see if it uses any shared libraries.  Call ourselves
 130 # on any directories we find.
 131 #
 132 # Note that the use of "*" as a glob pattern means we miss directories and
 133 # executables starting with '.'.  This is a Feature.
 134 #
 135 proc findLibUsers {dir} {
 136
 137     global stats verbose;
 138
 139     if {[catch {
 140         set ents [glob -nocomplain "$dir/*"];
 141     } msg]} {
 142         if {$msg == ""} {
 143             set msg "permission denied";
 144         }
 145         puts stderr "Can't search under '$dir' : $msg";
 146         return ;
 147     }
 148
 149     if {$verbose} {puts "===>> $dir";}
 150     incr stats(dirs);
 151
 152     # files?
 153     foreach f $ents {
 154         # executable?
 155         if {[file executable $f]} {
 156             # really a file?
 157             if {[file isfile $f]} {
 158                 incr stats(files);
 159                 examineExecutable $f;
 160             }
 161         }
 162     }
 163     # subdirs?
 164     foreach f $ents {
 165         # maybe a directory with more files?
 166         # don't use 'file isdirectory' because that follows symlinks
 167         if {[catch {set type [file type $f]}]} {
 168             continue ;          # may not be able to stat
 169         }
 170         if {$type == "directory"} {
 171             findLibUsers $f;
 172         }
 173     }
 174 }
 175
 176 ################################################################################
 177 # examineExecutable
 178 #
 179 # Look at (fname) and see if ldd thinks it references any shared libraries.
 180 # If it does, update Libs with the information.
 181 #
 182 proc examineExecutable {fname} {
 183
 184     global Libs stats verbose;
 185
 186     # ask Mr. Ldd.
 187     if {[catch {set result [exec ldd $fname]} msg]} {
 188         return ;        # not dynamic
 189     }
 190
 191     if {$verbose} {puts -nonewline "$fname : ";}
 192     incr stats(execs);
 193
 194     # For a non-shared executable, we get a single-line error message.
 195     # For a shared executable, we get a heading line, so in either case
 196     # we can discard the first line and any subsequent lines are libraries
 197     # that are required.
 198     set llist [lrange [split $result "\n"] 1 end];
 199     set uses "";
 200
 201     foreach line $llist {
 202         if {[scan $line "%s => %s %s" junk1 lib junk2] == 3} {
 203             if {$lib == "not"} {        # "not found" error
 204                 set mlname [string range $junk1 2 end];
 205                 puts stderr "$fname : library '$mlname' not known.";
 206             } else {
 207                 lappend Libs($lib) $fname;
 208                 lappend uses $lib;
 209             }
 210         } else {
 211             puts stderr "Unparseable ldd output line :";
 212             puts stderr $line;
 213         }
 214     }
 215     if {$verbose} {puts "$uses";}
 216 }
 217
 218 ################################################################################
 219 # emitLibDetails
 220 #
 221 # Emit a listing of libraries and the executables that use them.
 222 #
 223 proc emitLibDetails {} {
 224
 225     global Libs;
 226
 227     # divide into used/unused
 228     set used "";
 229     set unused "";
 230     foreach lib [array names Libs] {
 231         if {$Libs($lib) == ""} {
 232             lappend unused $lib;
 233         } else {
 234             lappend used $lib;
 235         }
 236     }
 237
 238     # emit used list
 239     puts "== Current Shared Libraries ==================================================";
 240     foreach lib [lsort $used] {
 241         # sort executable names
 242         set users [lsort $Libs($lib)];
 243         puts [format "%-30s  %s" $lib $users];
 244     }
 245     # emit unused
 246     puts "== Stale Shared Libraries ====================================================";
 247     foreach lib [lsort $unused] {
 248         # sort executable names
 249         set users [lsort $Libs($lib)];
 250         puts [format "%-30s  %s" $lib $users];
 251     }
 252 }
 253
 254 ################################################################################
 255 # Run the whole shebang
 256 #
 257 proc main {} {
 258
 259     global stats verbose argv;
 260
 261     set verbose 0;
 262     foreach arg $argv {
 263         switch -- $arg {
 264             -v {
 265                 set verbose 1;
 266             }
 267             default {
 268                 puts stderr "Unknown option '$arg'.";
 269                 exit ;
 270             }
 271         }
 272     }
 273
 274     set stats(libs) 0;
 275     set stats(dirs) 0;
 276     set stats(files) 0;
 277     set stats(execs) 0
 278
 279     findLibs;
 280     findLibUsers "/";
 281     emitLibDetails;
 282
 283     puts [format "Searched %d directories, %d executables (%d dynamic) for %d libraries." \
 284               $stats(dirs) $stats(files) $stats(execs) $stats(libs)];
 285 }
 286
 287 ################################################################################
 288 main;