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