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: 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 #
  63 proc 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 #
 137 proc 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 #
 184 proc 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 #
 225 proc 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 #
 259 proc 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 ################################################################################
 290 main;