3 files changed, 421 insertions, 0 deletions

diff --git a/tools/LibraryReport/LibraryReport.tcl b/tools/LibraryReport/LibraryReport.tcl
new file mode 100755
index 000000000000..37b4379bf6c7
--- /dev/null
+++ b/tools/LibraryReport/LibraryReport.tcl
@@ -0,0 +1,289 @@
+#!/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.
+#
+################################################################################
+#
+# $Id$
+#
+
+#########################################################################################
+# 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;
diff --git a/tools/tools/epfe/epfe.pl b/tools/tools/epfe/epfe.pl
new file mode 100644
index 000000000000..4afd824d4791
--- /dev/null
+++ b/tools/tools/epfe/epfe.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+# Copyright (c) 1996 Wolfram Schneider <wosch@FreeBSD.org>. Berlin.
+#
+# epfe - extract printing filter examples from printing.sgml
+#
+# usage: 
+#	$ cd /usr/share/examples/printing
+#	$ epfe < ../../doc/handbook/printing.sgml
+#
+# $Id$
+
+$in = 0; @a = ();
+sub Print { s/\&amp\;/&/g; push(@a,$_); }
+sub out { 
+    local($name, *lines) = @_;
+    open(F, "> $name") || die "open $_[0]: $!\n"; 
+    print F @lines;
+    close F;
+}
+
+while(<>) {
+    if (/^<code>/) {
+	$in = 1;
+    } elsif (m%</code>% && $in > 0) {
+	if ($in > 1) {
+	    $name = 'unknown' if !$name;
+	    while(1) { if ($d{$name}) { $name .= 'X'; } else { last } }
+	    &out("$name", *a);
+	    $d{$name} = $name;
+	}
+	$in = 0; $name = ''; @a = ();
+    } elsif ($in == 1 && /^\#\s*!/) {
+	$in++; &Print;
+    } elsif ($in > 1) {
+	$name = $1 if (!$name && /^\#\s+(\S+)\s+-\s+/);
+	$in++; &Print;
+    }
+}
diff --git a/tools/tools/scsi-defects/scsi-defects.pl b/tools/tools/scsi-defects/scsi-defects.pl
new file mode 100755
index 000000000000..5f48ec01c5a5
--- /dev/null
+++ b/tools/tools/scsi-defects/scsi-defects.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+# 
+# Copyright (C) 1997
+# 	Peter Dufault, Joerg Wunsch.  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.
+# 
+# THIS SOFTWARE IS PROVIDED BY THE AUTHORS 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 THE AUTHORS 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.
+# 
+# $Id$
+#
+
+#
+# Read and decode a SCSI disk's primary or grown defect list.
+#
+
+sub usage
+{
+    die "usage: scsi-defects raw-device-name [Glist|Plist]\n";
+}
+
+
+#
+# Main
+#
+
+&usage if $#ARGV < 0 || $#ARGV > 1;
+
+$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";
+
+$dev = $ARGV[0];
+
+# generic device name given?
+if ($dev =~ /^[so]d\d+$/) { $dev = "/dev/r${dev}.ctl"; }
+
+#
+# Select what you want to read.  PList include the primary defect list
+# from the factory.  GList is grown defects only.
+#
+if ($#ARGV > 0) {
+    if ($ARGV[1] =~ /^[Gg]/) { $glist = 1; $plist = 0; }
+    elsif ($ARGV[1] =~ /^[Pp]/) { $glist = 0; $plist = 1; }
+    else { &usage; }
+} else {
+    $glist = 1; $plist = 0;
+}
+
+open(PIPE, "scsi -f $dev " .
+     "-c '{ Op code} 37 0 0:3 v:1 v:1 5:3 0 0 0 0 4:i2 0' $plist $glist " .
+     "-i 4 '{ stuff } *i2 { Defect list length } i2' |") ||
+    die "Cannot pipe to scsi(8)\n";
+chop($amnt = <PIPE>);
+close(PIPE);
+
+if ($amnt == 0) {
+    print "There are no defects (in this list).\n";
+    exit 0;
+}
+
+print "There are " . $amnt / 8 . " defects in this list.\n";
+
+$amnt += 4;
+
+open(PIPE, "scsi -f $dev " .
+     "-c '{ Op code} 37 0 0:3 v:1 v:1 5:3 0 0 0 0 v:i2 0' $plist $glist " .
+     "$amnt -i $amnt - |") ||
+    die "Cannot pipe to scsi(8)\n";
+
+read(PIPE, $buf, 4);		# defect list header
+
+print "cylinder head  sector\n";
+
+while(read(PIPE, $buf, 8)) {
+    ($cylhi, $cyllo, $head, $sec) = unpack("CnCN", $buf);
+    printf "%8u %4u  %6u\n", $cylhi*65536+$cyllo, $head, $sec;
+}
+close(PIPE);