Import of Perl 5.003 into the tree. Makefile.bsd-wrapper and

config.sh.OpenBSD are the only local changes.

44 files changed, 2416 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/eg/ADB b/gnu/usr.bin/perl/eg/ADB
new file mode 100644
index 00000000000..d724eec66bf
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/ADB
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+# $RCSfile: ADB,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:52 $
+
+# This script is only useful when used in your crash directory.
+
+$num = shift;
+exec 'adb', '-k', "vmunix.$num", "vmcore.$num";
diff --git a/gnu/usr.bin/perl/eg/README b/gnu/usr.bin/perl/eg/README
new file mode 100644
index 00000000000..87cfc334f14
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/README
@@ -0,0 +1,22 @@
+Although supplied with the perl package, the perl scripts in this eg
+directory and its subdirectories are placed in the public domain, and
+you may do anything with them that you wish.
+
+This stuff is supplied on an as-is basis--little attempt has been made to make
+any of it portable.  It's mostly here to give you an idea of what perl code
+looks like, and what tricks and idioms are used.
+
+System administrators responsible for many computers will enjoy the items
+down in the g directory very much.  The scan directory contains the beginnings
+of a system to check on and report various kinds of anomalies.
+
+If you machine doesn't support #!, the first thing you'll want to do is
+replace the #! with a couple of lines that look like this:
+
+	eval "exec /usr/bin/perl -S $0 $*"
+		if $running_under_some_shell;
+
+being sure to include any flags that were on the #! line.  A supplied script
+called "nih" will translate perl scripts in place for you:
+
+	nih g/g??
diff --git a/gnu/usr.bin/perl/eg/changes b/gnu/usr.bin/perl/eg/changes
new file mode 100644
index 00000000000..e1c90870bbb
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/changes
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: changes,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:52 $
+
+($dir, $days) = @ARGV;
+$dir = '/' if $dir eq '';
+$days = '14' if $days eq '';
+
+# Masscomps do things differently from Suns
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Find, "find $dir -mtime -$days -print |") ||
+	die "changes: can't run find";
+#else
+open(Find, "find $dir \\( -fstype nfs -prune \\) -o -mtime -$days -ls |") ||
+	die "changes: can't run find";
+#endif
+
+while (<Find>) {
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $x = `/bin/ls -ild $_`;
+    $_ = $x;
+    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split(' ');
+#else
+    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split(' ');
+#endif
+
+    printf("%10s%3s %-8s %-8s%9s %3s %2s %s\n",
+	    $perm,$links,$owner,$group,$size,$month,$day,$name);
+}
+
diff --git a/gnu/usr.bin/perl/eg/client b/gnu/usr.bin/perl/eg/client
new file mode 100644
index 00000000000..5900c90d095
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/client
@@ -0,0 +1,34 @@
+#!./perl
+
+$pat = 'S n C4 x8';
+$inet = 2;
+$echo = 7;
+$smtp = 25;
+$nntp = 119;
+$test = 2345;
+
+$SIG{'INT'} = 'dokill';
+
+$this = pack($pat,$inet,0,   128,149,13,43);
+$that = pack($pat,$inet,$test,127,0,0,1);
+
+if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
+if (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
+if (connect(S,$that)) { print "connect ok\n"; } else { die $!; }
+
+select(S); $| = 1; select(stdout);
+
+if ($child = fork) {
+    while (<STDIN>) {
+	print S;
+    }
+    sleep 3;
+    do dokill();
+}
+else {
+    while (<S>) {
+	print;
+    }
+}
+
+sub dokill { kill 9,$child if $child; }
diff --git a/gnu/usr.bin/perl/eg/down b/gnu/usr.bin/perl/eg/down
new file mode 100644
index 00000000000..bbb0d062cbd
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/down
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+$| = 1;
+if ($#ARGV >= 0) {
+    $cmd = join(' ',@ARGV);
+}
+else {
+    print "Command: ";
+    $cmd = <stdin>;
+    chop($cmd);
+    while ($cmd =~ s/\\$//) {
+	print "+ ";
+	$cmd .= <stdin>;
+	chop($cmd);
+    }
+}
+$cwd = `pwd`; chop($cwd);
+
+open(FIND,'find . -type d -print|') || die "Can't run find";
+
+while (<FIND>) {
+    chop;
+    unless (chdir $_) {
+	print stderr "Can't cd to $_\n";
+	next;
+    }
+    print "\t--> ",$_,"\n";
+    system $cmd;
+    chdir $cwd;
+}
diff --git a/gnu/usr.bin/perl/eg/dus b/gnu/usr.bin/perl/eg/dus
new file mode 100644
index 00000000000..78062f82a4d
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/dus
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+# $RCSfile: dus,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This script does a du -s on any directories in the current directory that
+# are not mount points for another filesystem.
+
+($mydev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('.');
+
+open(ls,'ls -F1|');
+
+while (<ls>) {
+    chop;
+    next unless s|/$||;
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat($_);
+    next unless $dev == $mydev;
+    push(@ary,$_);
+}
+
+exec 'du', '-s', @ary;
diff --git a/gnu/usr.bin/perl/eg/findcp b/gnu/usr.bin/perl/eg/findcp
new file mode 100644
index 00000000000..3236ce37faa
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/findcp
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# $RCSfile: findcp,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This is a wrapper around the find command that pretends find has a switch
+# of the form -cp host:destination.  It presumes your find implements -ls.
+# It uses tar to do the actual copy.  If your tar knows about the I switch
+# you may prefer to use findtar, since this one has to do the tar in batches.
+
+sub copy {
+    `tar cf - $list | rsh $desthost cd $destdir '&&' tar xBpf -`;
+}
+
+$sourcedir = $ARGV[0];
+if ($sourcedir =~ /^\//) {
+    $ARGV[0] = '.';
+    unless (chdir($sourcedir)) { die "Can't find directory $sourcedir: $!"; }
+}
+
+$args = join(' ',@ARGV);
+if ($args =~ s/-cp *([^ ]+)/-ls/) {
+    $dest = $1;
+    if ($dest =~ /(.*):(.*)/) {
+	$desthost = $1;
+	$destdir = $2;
+    }
+    else {
+	die "Malformed destination--should be host:directory";
+    }
+}
+else {
+    die("No destination specified");
+}
+
+open(find,"find $args |") || die "Can't run find for you: $!";
+
+while (<find>) {
+    @x = split(' ');
+    if ($x[2] =~ /^d/) { next;}
+    chop($filename = $x[10]);
+    if (length($list) > 5000) {
+	do copy();
+	$list = '';
+    }
+    else {
+	$list .= ' ';
+    }
+    $list .= $filename;
+}
+
+if ($list) {
+    do copy();
+}
diff --git a/gnu/usr.bin/perl/eg/findtar b/gnu/usr.bin/perl/eg/findtar
new file mode 100644
index 00000000000..bf76d669aa5
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/findtar
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+# $RCSfile: findtar,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+
+# findtar takes find-style arguments and spits out a tarfile on stdout.
+# It won't work unless your find supports -ls and your tar the I flag.
+
+$args = join(' ',@ARGV);
+open(find,"/usr/bin/find $args -ls |") || die "Can't run find for you.";
+
+open(tar,"| /bin/tar cIf - -") || die "Can't run tar for you: $!";
+
+while (<find>) {
+    @x = split(' ');
+    if ($x[2] =~ /^d/) { print tar '-d ';}
+    print tar $x[10],"\n";
+}
diff --git a/gnu/usr.bin/perl/eg/g/gcp b/gnu/usr.bin/perl/eg/g/gcp
new file mode 100644
index 00000000000..a4d30d3f730
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gcp
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+# $RCSfile: gcp,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:55 $
+
+# Here is a script to do global rcps.  See man page.
+
+$#ARGV >= 1 || die "Not enough arguments.\n";
+
+if ($ARGV[0] eq '-r') {
+    $rcp = 'rcp -r';
+    shift;
+} else {
+    $rcp = 'rcp';
+}
+$args = $rcp;
+$dest = $ARGV[$#ARGV];
+
+$SIG{'QUIT'} = 'CLEANUP';
+$SIG{'INT'} = 'CONT';
+
+while ($arg = shift) {
+    if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
+	if ($systype && $systype ne $1) {
+	    die "Can't mix system type specifers ($systype vs $1).\n";
+	}
+	$#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
+	$systype = $1;
+	$args .= " $arg";
+    } else {
+	if ($#ARGV >= 0) {
+	    if ($arg =~ /^[\/~]/) {
+		$arg =~ /^(.*)\// && ($dir = $1);
+	    } else {
+		if (!$pwd) {
+		    chop($pwd = `pwd`);
+		}
+		$dir = $pwd;
+	    }
+	}
+	if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
+	    $args .= " $dest$olddir; $rcp";
+	}
+	$olddir = $dir;
+	$args .= " $arg";
+    }
+}
+
+die "No system type specified.\n" unless $systype;
+
+$args =~ s/:$/:$olddir/;
+
+chop($thishost = `hostname`);
+
+$one_of_these = ":$systype:";
+if ($systype =~ s/\+/[+]/g) {
+    $one_of_these =~ s/\+/:/g;
+}
+$one_of_these =~ s/-/:-/g;
+
+@ARGV = ();
+push(@ARGV,'.grem') if -f '.grem';
+push(@ARGV,'.ghosts') if -f '.ghosts';
+push(@ARGV,'/etc/ghosts');
+
+$remainder = '';
+
+line: while (<>) {
+    s/[ \t]*\n//;
+    if (!$_ || /^#/) {
+	next line;
+    }
+    if (/^([a-zA-Z_0-9]+)=(.+)/) {
+	$name = $1; $repl = $2;
+	$repl =~ s/\+/:/g;
+	$repl =~ s/-/:-/g;
+	$one_of_these =~ s/:$name:/:$repl:/;
+	$repl =~ s/:/:-/g;
+	$one_of_these =~ s/:-$name:/:-$repl:/g;
+	next line;
+    }
+    @gh = split(' ');
+    $host = $gh[0];
+  next line if $host eq $thishost;	# should handle aliases too
+    $wanted = 0;
+    foreach $class (@gh) {
+	$wanted++ if index($one_of_these,":$class:") >= 0;
+	$wanted = -9999 if index($one_of_these,":-$class:") >= 0;
+    }
+    if ($wanted > 0) {
+	($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
+	print "$cmd\n";
+	$result = `$cmd 2>&1`;
+	$remainder .= "$host+" if
+	    $result =~ /Connection timed out|Permission denied/;
+	print $result;
+    }
+}
+
+if ($remainder) {
+    chop($remainder);
+    open(grem,">.grem") || (printf stderr "Can't create .grem: $!\n");
+    print grem 'rem=', $remainder, "\n";
+    close(grem);
+    print 'rem=', $remainder, "\n";
+}
+
+sub CLEANUP {
+    exit;
+}
+
+sub CONT {
+    print "Continuing...\n";	# Just ignore the signal that kills rcp
+    $remainder .= "$host+";
+}
diff --git a/gnu/usr.bin/perl/eg/g/gcp.man b/gnu/usr.bin/perl/eg/g/gcp.man
new file mode 100644
index 00000000000..d9390cd6a3b
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gcp.man
@@ -0,0 +1,77 @@
+.\" $RCSfile: gcp.man,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:55 $
+.TH GCP 1C "13 May 1988"
+.SH NAME
+gcp \- global file copy
+.SH SYNOPSIS
+.B gcp
+file1 file2
+.br
+.B gcp
+[
+.B \-r
+] file ... directory
+.SH DESCRIPTION
+.I gcp
+works just like rcp(1C) except that you may specify a set of hosts to copy files
+from or to.
+The host sets are defined in the file /etc/ghosts.
+(An individual host name can be used as a set containing one member.)
+You can give a command like
+
+	gcp /etc/motd sun:
+
+to copy your /etc/motd file to /etc/motd on all the Suns.
+If, on the other hand, you say
+
+	gcp /a/foo /b/bar sun:/tmp
+
+then your files will be copied to /tmp on all the Suns.
+The general rule is that if you don't specify the destination directory,
+files go to the same directory they are in currently.
+.P
+You may specify the union of two or more sets by using + as follows:
+
+	gcp /a/foo /b/bar 750+mc:
+
+which will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy
+/b/bar to /b/bar on all 750's and Masscomps.
+.P
+Commonly used sets should be defined in /etc/ghosts.
+For example, you could add a line that says
+
+	pep=manny+moe+jack
+
+Another way to do that would be to add the word "pep" after each of the host
+entries:
+
+	manny	sun3 pep
+.br
+	moe		sun3 pep
+.br
+	jack		sun3 pep
+
+Hosts and sets of host can also be excluded:
+
+	foo=sun-sun2
+
+Any host so excluded will never be included, even if a subsequent set on the
+line includes it:
+
+	foo=abc+def
+.br
+	bar=xyz-abc+foo
+
+comes out to xyz+def.
+
+You can define private host sets by creating .ghosts in your current directory
+with entries just like /etc/ghosts.
+Also, if there is a file .grem, it defines "rem" to be the remaining hosts
+from the last gsh or gcp that didn't succeed everywhere.
+.PP
+Interrupting with a SIGINT will cause the rcp to the current host to be skipped
+and execution resumed with the next host.
+To stop completely, send a SIGQUIT.
+.SH SEE ALSO
+rcp(1C)
+.SH BUGS
+All the bugs of rcp, since it calls rcp.
diff --git a/gnu/usr.bin/perl/eg/g/ged b/gnu/usr.bin/perl/eg/g/ged
new file mode 100644
index 00000000000..5ccfff7bff3
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/ged
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $RCSfile: ged,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:55 $
+
+# Does inplace edits on a set of files on a set of machines.
+#
+# Typical invokation:
+#
+#	ged vax+sun /etc/passwd
+#	s/Freddy/Freddie/;
+#	^D
+#
+
+$class = shift;
+$files = join(' ',@ARGV);
+
+die "Usage: ged class files <perlcmds\n" unless $files;
+
+exec "gsh", $class, "-d", "perl -pi.bak - $files";
+
+die "Couldn't execute gsh for some reason, stopped";
diff --git a/gnu/usr.bin/perl/eg/g/ghosts b/gnu/usr.bin/perl/eg/g/ghosts
new file mode 100644
index 00000000000..96ec771c4a7
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/ghosts
@@ -0,0 +1,33 @@
+# This first section gives alternate sets defined in terms of the sets given
+# by the second section.  The order is important--all references must be
+# forward references.
+
+Nnd=sun-nd
+all=sun+mc+vax
+baseline=sun+mc
+sun=sun2+sun3
+vax=750+8600
+pep=manny+moe+jack
+
+# This second section defines the basic sets.  Each host should have a line
+# that specifies which sets it is a member of.  Extra sets should be separated
+# by white space.  (The first section isn't strictly necessary, since all sets
+# could be defined in the second section, but then it wouldn't be so readable.)
+
+basvax	8600	src
+cdb0	sun3		sys
+cdb1	sun3		sys
+cdb2	sun3		sys
+chief	sun3	src
+tis0	sun3
+manny	sun3		sys
+moe	sun3		sys
+jack	sun3		sys
+disney	sun3		sys
+huey	sun3		nd
+dewey	sun3		nd
+louie	sun3		nd
+bizet	sun2	src	sys
+gif0	mc	src
+mc0	mc
+dtv0	mc
diff --git a/gnu/usr.bin/perl/eg/g/gsh b/gnu/usr.bin/perl/eg/g/gsh
new file mode 100644
index 00000000000..ea0a11be9b9
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gsh
@@ -0,0 +1,117 @@
+#! /usr/bin/perl
+
+# $RCSfile: gsh,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:55 $
+
+# Do rsh globally--see man page
+
+$SIG{'QUIT'} = 'quit';			# install signal handler for SIGQUIT
+
+sub getswitches {
+    while ($ARGV[0] =~ /^-/) {		# parse switches
+	$ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-s/ && ($silent++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-d/ && ($dodist++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-n/ && ($n=' -n',shift(@ARGV),next);
+	$ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift(@ARGV),shift(@ARGV),
+				next);
+	last;
+    }
+}
+
+do getswitches();			# get any switches before class
+$systype = shift;			# get name representing set of hosts
+do getswitches();			# same switches allowed after class
+
+if ($dodist) {				# distribute input over all rshes?
+    `cat >/tmp/gsh$$`;			#  get input into a handy place
+    $dist = " </tmp/gsh$$";		#  each rsh takes input from there
+}
+
+$cmd = join(' ',@ARGV);			# remaining args constitute the command
+$cmd =~ s/'/'"'"'/g;			# quote any embedded single quotes
+
+$one_of_these = ":$systype:";		# prepare to expand "macros"
+$one_of_these =~ s/\+/:/g;		# we hope to end up with list of
+$one_of_these =~ s/-/:-/g;		#  colon separated attributes
+
+@ARGV = ();
+push(@ARGV,'.grem') if -f '.grem';
+push(@ARGV,'.ghosts') if -f '.ghosts';
+push(@ARGV,'/etc/ghosts');
+
+$remainder = '';
+
+line: while (<>) {		# for each line of ghosts
+
+    s/[ \t]*\n//;			# trim trailing whitespace
+    if (!$_ || /^#/) {			# skip blank line or comment
+	next line;
+    }
+
+    if (/^(\w+)=(.+)/) {		# a macro line?
+	$name = $1; $repl = $2;
+	$repl =~ s/\+/:/g;
+	$repl =~ s/-/:-/g;
+	$one_of_these =~ s/:$name:/:$repl:/;	# do expansion in "wanted" list
+	$repl =~ s/:/:-/g;
+	$one_of_these =~ s/:-$name:/:-$repl:/;
+	next line;
+    }
+
+    # we have a normal line
+
+    @attr = split(' ');			# a list of attributes to match against
+					#   which we put into an array
+    $host = $attr[0];			# the first attribute is the host name
+    if ($showhost) {
+	$showhost = "$host:\t";
+    }
+
+    $wanted = 0;
+    foreach $attr (@attr) {		# iterate over attribute array
+	$wanted++ if index($one_of_these,":$attr:") >= 0;
+	$wanted = -9999 if index($one_of_these,":-$attr:") >= 0;
+    }
+    if ($wanted > 0) {
+	print "rsh $host$l$n '$cmd'\n" unless $silent;
+	$SIG{'INT'} = 'DEFAULT';
+	if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) {	# start an rsh
+	    $SIG{'INT'} = 'cont';
+	    for ($iter=0; <PIPE>; $iter++) {
+		unless ($iter) {
+		    $remainder .= "$host+"
+			if /Connection timed out|Permission denied/;
+		}
+		print $showhost,$_;
+	    }
+	    close(PIPE);
+	} else {
+	    print "(Can't execute rsh: $!)\n";
+	    $SIG{'INT'} = 'cont';
+	}
+    }
+}
+
+unlink "/tmp/gsh$$" if $dodist;
+
+if ($remainder) {
+    chop($remainder);
+    open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n");
+    print grem 'rem=', $remainder, "\n";
+    close(grem);
+    print 'rem=', $remainder, "\n";
+}
+
+# here are a couple of subroutines that serve as signal handlers
+
+sub cont {
+    print "\rContinuing...\n";
+    $remainder .= "$host+";
+}
+
+sub quit {
+    $| = 1;
+    print "\r";
+    $SIG{'INT'} = '';
+    kill 2, $$;
+}
diff --git a/gnu/usr.bin/perl/eg/g/gsh.man b/gnu/usr.bin/perl/eg/g/gsh.man
new file mode 100644
index 00000000000..cc33232caf5
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gsh.man
@@ -0,0 +1,80 @@
+.\" $RCSfile: gsh.man,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:55 $
+.TH GSH 8 "13 May 1988"
+.SH NAME
+gsh \- global shell
+.SH SYNOPSIS
+.B gsh
+[options]
+.I host
+[options] 
+.I command
+.SH DESCRIPTION
+.I gsh
+works just like rsh(1C) except that you may specify a set of hosts to execute
+the command on.
+The host sets are defined in the file /etc/ghosts.
+(An individual host name can be used as a set containing one member.)
+You can give a command like
+
+	gsh sun /etc/mungmotd
+
+to run /etc/mungmotd on all your Suns.
+.P
+You may specify the union of two or more sets by using + as follows:
+
+	gsh 750+mc /etc/mungmotd
+
+which will run mungmotd on all 750's and Masscomps.
+.P
+Commonly used sets should be defined in /etc/ghosts.
+For example, you could add a line that says
+
+	pep=manny+moe+jack
+
+Another way to do that would be to add the word "pep" after each of the host
+entries:
+
+	manny	sun3 pep
+.br
+	moe		sun3 pep
+.br
+	jack		sun3 pep
+
+Hosts and sets of host can also be excluded:
+
+	foo=sun-sun2
+
+Any host so excluded will never be included, even if a subsequent set on the
+line includes it:
+
+	foo=abc+def
+	bar=xyz-abc+foo
+
+comes out to xyz+def.
+
+You can define private host sets by creating .ghosts in your current directory
+with entries just like /etc/ghosts.
+Also, if there is a file .grem, it defines "rem" to be the remaining hosts
+from the last gsh or gcp that didn't succeed everywhere.
+
+Options include all those defined by rsh, as well as
+
+.IP "\-d" 8
+Causes gsh to collect input till end of file, and then distribute that input
+to each invokation of rsh.
+.IP "\-h" 8
+Rather than print out the command followed by the output, merely prepends the
+host name to each line of output.
+.IP "\-s" 8
+Do work silently.
+.PP
+Interrupting with a SIGINT will cause the rsh to the current host to be skipped
+and execution resumed with the next host.
+To stop completely, send a SIGQUIT.
+.SH SEE ALSO
+rsh(1C)
+.SH BUGS
+All the bugs of rsh, since it calls rsh.
+
+Also, will not properly return data from the remote execution that contains
+null characters.
diff --git a/gnu/usr.bin/perl/eg/muck b/gnu/usr.bin/perl/eg/muck
new file mode 100644
index 00000000000..873539b10c6
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/muck
@@ -0,0 +1,141 @@
+#!../perl
+
+$M = '-M';
+$M = '-m' if -d '/usr/uts' && -f '/etc/master';
+
+do 'getopt.pl';
+do Getopt('f');
+
+if ($opt_f) {
+    $makefile = $opt_f;
+}
+elsif (-f 'makefile') {
+    $makefile = 'makefile';
+}
+elsif (-f 'Makefile') {
+    $makefile = 'Makefile';
+}
+else {
+    die "No makefile\n";
+}
+
+$MF = 'mf00';
+
+while(($key,$val) = each(ENV)) {
+    $mac{$key} = $val;
+}
+
+do scan($makefile);
+
+$co = $action{'.c.o'};
+$co = ' ' unless $co;
+
+$missing = "Missing dependencies:\n";
+foreach $key (sort keys(o)) {
+    if ($oc{$key}) {
+	$src = $oc{$key};
+	$action = $action{$key};
+    }
+    else {
+	$action = '';
+    }
+    if (!$action) {
+	if ($co && ($c = $key) =~ s/\.o$/.c/ && -f $c) {
+	    $src = $c;
+	    $action = $co;
+	}
+	else {
+	    print "No source found for $key $c\n";
+	    next;
+	}
+    }
+    $I = '';
+    $D = '';
+    $I .= $1 while $action =~ s/(-I\S+\s*)//;
+    $D .= $1 . ' ' while $action =~ s/(-D\w+)//;
+    if ($opt_v) {
+	$cmd = "Checking $key: cc $M $D $I $src";
+	$cmd =~ s/\s\s+/ /g;
+	print stderr $cmd,"\n";
+    }
+    open(CPP,"cc $M $D $I $src|") || die "Can't run C preprocessor: $!";
+    while (<CPP>) {
+	($name,$dep) = split;
+	$dep =~ s|^\./||;
+	(print $missing,"$key: $dep\n"),($missing='')
+	    unless ($dep{"$key: $dep"} += 2) > 2;
+    }
+}
+
+$extra = "\nExtraneous dependencies:\n";
+foreach $key (sort keys(dep)) {
+    if ($key =~ /\.o: .*\.h$/ && $dep{$key} == 1) {
+	print $extra,$key,"\n";
+	$extra = '';
+    }
+}
+
+sub scan {
+    local($makefile) = @_;
+    local($MF) = $MF;
+    print stderr "Analyzing $makefile.\n" if $opt_v;
+    $MF++;
+    open($MF,$makefile) || die "Can't open $makefile: $!";
+    while (<$MF>) {
+	chop;
+	chop($_ = $_ . <$MF>) while s/\\$//;
+	next if /^#/;
+	next if /^$/;
+	s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg;
+	s/\$\((\w+)\)/$mac{$1}/eg;
+	$mac{$1} = $2, next if /^(\w+)\s*=\s*(.*)/;
+	if (/^include\s+(.*)/) {
+	    do scan($1);
+	    print stderr "Continuing $makefile.\n" if $opt_v;
+	    next;
+	}
+	if (/^([^:]+):\s*(.*)/) {
+	    $left = $1;
+	    $right = $2;
+	    if ($right =~ /^([^;]*);(.*)/) {
+		$right = $1;
+		$action = $2;
+	    }
+	    else {
+		$action = '';
+	    }
+	    while (<$MF>) {
+		last unless /^\t/;
+		chop;
+		chop($_ = $_ . <$MF>) while s/\\$//;
+		next if /^#/;
+		last if /^$/;
+		s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg;
+		s/\$\((\w+)\)/$mac{$1}/eg;
+		$action .= $_;
+	    }
+	    foreach $targ (split(' ',$left)) {
+		$targ =~ s|^\./||;
+		foreach $src (split(' ',$right)) {
+		    $src =~ s|^\./||;
+		    $deplist{$targ} .= ' ' . $src;
+		    $dep{"$targ: $src"} = 1;
+		    $o{$src} = 1 if $src =~ /\.o$/;
+		    $oc{$targ} = $src if $targ =~ /\.o$/ && $src =~ /\.[yc]$/;
+		}
+		$action{$targ} .= $action;
+	    }
+	    redo if $_;
+	}
+    }
+    close($MF);
+}
+
+sub subst {
+    local($foo,$from,$to) = @_;
+    $foo = $mac{$foo};
+    $from =~ s/\./[.]/;
+    y/a/a/;
+    $foo =~ s/\b$from\b/$to/g;
+    $foo;
+}
diff --git a/gnu/usr.bin/perl/eg/muck.man b/gnu/usr.bin/perl/eg/muck.man
new file mode 100644
index 00000000000..e39b363fb90
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/muck.man
@@ -0,0 +1,21 @@
+.\" $RCSfile: muck.man,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+.TH MUCK 1 "10 Jan 1989"
+.SH NAME
+muck \- make usage checker
+.SH SYNOPSIS
+.B muck
+[options]
+.SH DESCRIPTION
+.I muck
+looks at your current makefile and complains if you've left out any dependencies
+between .o and .h files.
+It also complains about extraneous dependencies.
+.PP
+You can use the -f FILENAME option to specify an alternate name for your
+makefile.
+The -v option is a little more verbose about what muck is mucking around
+with at the moment.
+.SH SEE ALSO
+make(1)
+.SH BUGS
+Only knows about .h, .c and .o files.
diff --git a/gnu/usr.bin/perl/eg/myrup b/gnu/usr.bin/perl/eg/myrup
new file mode 100644
index 00000000000..4ce90689d5d
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/myrup
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+# $RCSfile: myrup,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This was a customization of ruptime requested by someone here who wanted
+# to be able to find the least loaded machine easily.  It uses the
+# /etc/ghosts file that's defined for gsh and gcp to prune down the
+# number of entries to those hosts we have administrative control over.
+
+print "node    load (u)\n------- --------\n";
+
+open(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts: $!";
+line: while (<ghosts>) {
+    next line if /^#/;
+    next line if /^$/;
+    next line if /=/;
+    ($host) = split;
+    $wanted{$host} = 1;
+}
+
+open(ruptime,'ruptime|') || die "Can't run ruptime: $!";
+open(sort,'|sort +1n');
+
+while (<ruptime>) {
+    ($host,$upness,$foo,$users,$foo,$foo,$load) = split(/[\s,]+/);
+    if ($wanted{$host} && $upness eq 'up') {
+	printf sort "%s\t%s (%d)\n", $host, $load, $users;
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/nih b/gnu/usr.bin/perl/eg/nih
new file mode 100644
index 00000000000..dae2bbdb8bd
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/nih
@@ -0,0 +1,10 @@
+eval "exec /usr/bin/perl -Spi.bak $0 $*"
+	if $running_under_some_shell;
+
+# $RCSfile: nih,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This script makes #! scripts directly executable on machines that don't
+# support #!.  It edits in place any scripts mentioned on the command line.
+
+s|^#!(.*)|#!$1\neval "exec $1 -S \$0 \$*"\n\tif \$running_under_some_shell;|
+	if $. == 1;
diff --git a/gnu/usr.bin/perl/eg/relink b/gnu/usr.bin/perl/eg/relink
new file mode 100644
index 00000000000..693e933d10a
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/relink
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $RCSfile: relink,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:53 $
+#
+# $Log: relink,v $
+# Revision 1.1  1996/08/19 10:11:53  downsj
+# Initial revision
+#
+
+($op = shift) || die "Usage: relink perlexpr [filenames]\n";
+if (!@ARGV) {
+    @ARGV = <STDIN>;
+    chop(@ARGV);
+}
+for (@ARGV) {
+    next unless -l;		# symbolic link?
+    $name = $_;
+    $_ = readlink($_);
+    $was = $_;
+    eval $op;
+    die $@ if $@;
+    if ($was ne $_) {
+	unlink($name);
+	symlink($_, $name);
+    }
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00;			# finish .ig
+ 
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+.TH RELINK 1 "July 30, 1990"
+.AT 3
+.SH LINK
+relink \- relinks multiple symbolic links
+.SH SYNOPSIS
+.B relink perlexpr [symlinknames]
+.SH DESCRIPTION
+.I Relink
+relinks the symbolic links given according to the rule specified as the
+first argument.
+The argument is a Perl expression which is expected to modify the $_
+string in Perl for at least some of the names specified.
+For each symbolic link named on the command line, the Perl expression
+will be executed on the contents of the symbolic link with that name.
+If a given symbolic link's contents is not modified by the expression,
+it will not be changed.
+If a name given on the command line is not a symbolic link, it will be ignored.
+If no names are given on the command line, names will be read
+via standard input.
+.PP
+For example, to relink all symbolic links in the current directory
+pointing to somewhere in X11R3 so that they point to X11R4, you might say
+.nf
+
+	relink 's/X11R3/X11R4/' *
+
+.fi
+To change all occurences of links in the system from /usr/spool to /var/spool,
+you'd say
+.nf
+
+	find / -type l -print | relink 's#/usr/spool#/var/spool#'
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+ln(1)
+.br
+perl(1)
+.SH DIAGNOSTICS
+If you give an invalid Perl expression you'll get a syntax error.
+.SH BUGS
+.ex
diff --git a/gnu/usr.bin/perl/eg/rename b/gnu/usr.bin/perl/eg/rename
new file mode 100644
index 00000000000..7dd0591b8f9
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/rename
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $RCSfile: rename,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:54 $
+#
+# $Log: rename,v $
+# Revision 1.1  1996/08/19 10:11:54  downsj
+# Initial revision
+#
+
+($op = shift) || die "Usage: rename perlexpr [filenames]\n";
+if (!@ARGV) {
+    @ARGV = <STDIN>;
+    chop(@ARGV);
+}
+for (@ARGV) {
+    $was = $_;
+    eval $op;
+    die $@ if $@;
+    rename($was,$_) unless $was eq $_;
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00;			# finish .ig
+ 
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+.TH RENAME 1 "July 30, 1990"
+.AT 3
+.SH NAME
+rename \- renames multiple files
+.SH SYNOPSIS
+.B rename perlexpr [files]
+.SH DESCRIPTION
+.I Rename
+renames the filenames supplied according to the rule specified as the
+first argument.
+The argument is a Perl expression which is expected to modify the $_
+string in Perl for at least some of the filenames specified.
+If a given filename is not modified by the expression, it will not be
+renamed.
+If no filenames are given on the command line, filenames will be read
+via standard input.
+.PP
+For example, to rename all files matching *.bak to strip the extension,
+you might say
+.nf
+
+	rename 's/\e.bak$//' *.bak
+
+.fi
+To translate uppercase names to lower, you'd use
+.nf
+
+	rename 'y/A-Z/a-z/' *
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+mv(1)
+.br
+perl(1)
+.SH DIAGNOSTICS
+If you give an invalid Perl expression you'll get a syntax error.
+.SH BUGS
+.I Rename
+does not check for the existence of target filenames, so use with care.
+.ex
diff --git a/gnu/usr.bin/perl/eg/rmfrom b/gnu/usr.bin/perl/eg/rmfrom
new file mode 100644
index 00000000000..19e283fcdc8
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/rmfrom
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -n
+
+# $RCSfile: rmfrom,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:54 $
+
+# A handy (but dangerous) script to put after a find ... -print.
+
+chop; unlink;
diff --git a/gnu/usr.bin/perl/eg/scan/scan_df b/gnu/usr.bin/perl/eg/scan/scan_df
new file mode 100644
index 00000000000..aa799ff6146
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_df
@@ -0,0 +1,51 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_df,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This report points out filesystems that are in danger of overflowing.
+
+(chdir '/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
+`df >newdf`;
+open(Df, 'olddf');
+
+while (<Df>) {
+    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
+    next if $fs =~ /:/;
+    next if $fs eq '';
+    $oldused{$fs} = $used;
+}
+
+open(Df, 'newdf') || die "scan_df: can't open newdf";
+
+while (<Df>) {
+    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
+    next if $fs =~ /:/;
+    next if $fs eq '';
+    $oldused = $oldused{$fs};
+    next if ($oldused == $used && $capacity < 99);	# inactive filesystem
+    if ($capacity >= 90) {
+#if defined(mc300) || defined(mc500) || defined(mc700)
+	$_ = substr($_,0,13) . '        ' . substr($_,13,1000);
+	$kbytes /= 2;		# translate blocks to K
+	$used /= 2;
+	$oldused /= 2;
+	$avail /= 2;
+#endif
+	$diff = int($used - $oldused);
+	if ($avail < $diff * 2) {	# mark specially if in danger
+	    $mounted_on .= ' *';
+	}
+	next if $diff < 50 && $mounted_on eq '/';
+	$fs =~ s|/dev/||;
+	if ($diff >= 0) {
+	    $diff = '(+' . $diff . ')';
+	}
+	else {
+	    $diff = '(' . $diff . ')';
+	}
+	printf "%-8s%8d%8d %-8s%8d%7s    %s\n",
+	    $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on;
+    }
+}
+
+rename('newdf','olddf');
diff --git a/gnu/usr.bin/perl/eg/scan/scan_last b/gnu/usr.bin/perl/eg/scan/scan_last
new file mode 100644
index 00000000000..e9da42c6746
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_last
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_last,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This reports who was logged on at weird hours
+
+($dy, $mo, $lastdt) = split(/ +/,`date`);
+
+open(Last, 'exec last 2>&1 |') || die "scan_last: can't run last";
+
+while (<Last>) {
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $_ = substr($_,0,19) . substr($_,23,100);
+#endif
+    next if /^$/;
+    (print),next if m|^/|;
+    $login  = substr($_,0,8);
+    $tty    = substr($_,10,7);
+    $from   = substr($_,19,15);
+    $day    = substr($_,36,3);
+    $mo     = substr($_,40,3);
+    $dt     = substr($_,44,2);
+    $hr     = substr($_,47,2);
+    $min    = substr($_,50,2);
+    $dash   = substr($_,53,1);
+    $tohr   = substr($_,55,2);
+    $tomin  = substr($_,58,2);
+    $durhr  = substr($_,63,2);
+    $durmin = substr($_,66,2);
+    
+    next unless $hr;
+    next if $login eq 'reboot  ';
+    next if $login eq 'shutdown';
+
+    if ($dt != $lastdt) {
+	if ($lastdt < $dt) {
+	    $seen += $dt - $lastdt;
+	}
+	else {
+	    $seen++;
+	}
+	$lastdt = $dt;
+    }
+
+    $inat = $hr + $min / 60;
+    if ($tohr =~ /^[a-z]/) {
+	$outat = 12;		# something innocuous
+    } else {
+	$outat = $tohr + $tomin / 60;
+    }
+
+  last if $seen + ($inat < 8) > 1;
+
+    if ($inat < 5 || $inat > 21 || $outat < 6 || $outat > 23) {
+	print;
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/scan/scan_messages b/gnu/usr.bin/perl/eg/scan/scan_messages
new file mode 100644
index 00000000000..136ea64a159
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_messages
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_messages,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This prints out extraordinary console messages.  You'll need to customize.
+
+chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
+
+$maxpos = `cat oldmsgs 2>&1`;
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Msgs, '/dev/null') || die "scan_messages: can't open messages";
+#else
+open(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages";
+#endif
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(Msgs);
+
+if ($size < $maxpos) {		# Did somebody truncate messages file?
+    $maxpos = 0;
+}
+
+seek(Msgs,$maxpos,0);		# Start where we left off last time.
+
+while (<Msgs>) {
+    s/\[(\d+)\]/#/ && s/$1/#/g;
+#ifdef vax
+    $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//;
+    next if /root@.*:/;
+    next if /^vmunix: 4.3 BSD UNIX/;
+    next if /^vmunix: Copyright/;
+    next if /^vmunix: avail mem =/;
+    next if /^vmunix: SBIA0 at /;
+    next if /^vmunix: disk ra81 is/;
+    next if /^vmunix: dmf. at uba/;
+    next if /^vmunix: dmf.:.*asynch/;
+    next if /^vmunix: ex. at uba/;
+    next if /^vmunix: ex.: HW/;
+    next if /^vmunix: il. at uba/;
+    next if /^vmunix: il.: hardware/;
+    next if /^vmunix: ra. at uba/;
+    next if /^vmunix: ra.: media/;
+    next if /^vmunix: real mem/;
+    next if /^vmunix: syncing disks/;
+    next if /^vmunix: tms/;
+    next if /^vmunix: tmscp. at uba/;
+    next if /^vmunix: uba. at /;
+    next if /^vmunix: uda. at /;
+    next if /^vmunix: uda.: unit . ONLIN/;
+    next if /^vmunix: .*buffers containing/;
+    next if /^syslogd: .*newslog/;
+#endif
+    next if /unknown service/;
+    next if /^\.\.\.$/;
+    if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) {
+	$pfx = '';
+	next;
+    }
+    next if /^[ \t]*$/;
+    next if /^[ 0-9]*done$/;
+    if (/^A/) {
+	next if /^Accounting [sr]/;
+    }
+    elsif (/^C/) {
+	next if /^Called from/;
+	next if /^Copyright/;
+    }
+    elsif (/^E/) {
+	next if /^End traceback/;
+	next if /^Ethernet address =/;
+    }
+    elsif (/^K/) {
+	next if /^KERNEL MODE/;
+    }
+    elsif (/^R/) {
+	next if /^Rebooting Unix/;
+    }
+    elsif (/^S/) {
+	next if /^Sun UNIX 4\.2 Release/;
+    }
+    elsif (/^W/) {
+	next if /^WARNING: clock gained/;
+    }
+    elsif (/^a/) {
+	next if /^arg /;
+	next if /^avail mem =/;
+    }
+    elsif (/^b/) {
+	next if /^bwtwo[0-9] at /;
+    }
+    elsif (/^c/) {
+	next if /^cgone[0-9] at /;
+	next if /^cdp[0-9] at /;
+	next if /^csr /;
+    }
+    elsif (/^d/) {
+	next if /^dcpa: init/;
+	next if /^done$/;
+	next if /^dts/;
+	next if /^dump i\/o error/;
+	next if /^dumping to dev/;
+	next if /^dump succeeded/;
+	$pfx = '*' if /^dev = /;
+    }
+    elsif (/^e/) {
+	next if /^end \*\*/;
+	next if /^error in copy/;
+    }
+    elsif (/^f/) {
+	next if /^found /;
+    }
+    elsif (/^i/) {
+	next if /^ib[0-9] at /;
+	next if /^ie[0-9] at /;
+    }
+    elsif (/^l/) {
+	next if /^le[0-9] at /;
+    }
+    elsif (/^m/) {
+	next if /^mem = /;
+	next if /^mt[0-9] at /;
+	next if /^mti[0-9] at /;
+	$pfx = '*' if /^mode = /;
+    }
+    elsif (/^n/) {
+	next if /^not found /;
+    }
+    elsif (/^p/) {
+	next if /^page map /;
+	next if /^pi[0-9] at /;
+	$pfx = '*' if /^panic/;
+    }
+    elsif (/^q/) {
+	next if /^qqq /;
+    }
+    elsif (/^r/) {
+	next if /^read  /;
+	next if /^revarp: Requesting/;
+	next if /^root [od]/;
+    }
+    elsif (/^s/) {
+	next if /^sc[0-9] at /;
+	next if /^sd[0-9] at /;
+	next if /^sd[0-9]: </;
+	next if /^si[0-9] at /;
+	next if /^si_getstatus/;
+	next if /^sk[0-9] at /;
+	next if /^skioctl/;
+	next if /^skopen/;
+	next if /^skprobe/;
+	next if /^skread/;
+	next if /^skwrite/;
+	next if /^sky[0-9] at /;
+	next if /^st[0-9] at /;
+	next if /^st0:.*load/;
+	next if /^stat1 = /;
+	next if /^syncing disks/;
+	next if /^syslogd: going down on signal 15/;
+    }
+    elsif (/^t/) {
+	next if /^timeout [0-9]/;
+	next if /^tm[0-9] at /;
+	next if /^tod[0-9] at /;
+	next if /^tv [0-9]/;
+	$pfx = '*' if /^trap address/;
+    }
+    elsif (/^u/) {
+	next if /^unit nsk/;
+	next if /^use one of/;
+	$pfx = '' if /^using/;
+	next if /^using [0-9]+ buffers/;
+    }
+    elsif (/^x/) {
+	next if /^xy[0-9] at /;
+	next if /^write [0-9]/;
+	next if /^xy[0-9]: </;
+	next if /^xyc[0-9] at /;
+    }
+    elsif (/^y/) {
+	next if /^yyy [0-9]/;
+    }
+    elsif (/^z/) {
+	next if /^zs[0-9] at /;
+    }
+    $pfx = '*' if /^[a-z]+:$/;
+    s/pid [0-9]+: //;
+    if (/last message repeated ([0-9]+) time/) {
+	$seen{$last} += $1;
+	next;
+    }
+    s/^/$pfx/ if $pfx;
+    unless ($seen{$_}++) {
+	push(@seen,$_);
+    }
+    $last = $_;
+}
+$max = tell(Msgs);
+
+open(tmp,'|sort >oldmsgs.tmp') || die "Can't create tmp file: $!\n";
+while ($_ = pop(@seen)) {
+    print tmp $_;
+}
+close(tmp);
+open(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n";
+while (<tmp>) {
+    if (/^nd:/) {
+	next if $seen{$_} < 20;
+    }
+    if (/NFS/) {
+	next if $seen{$_} < 20;
+    }
+    if (/no carrier/) {
+	next if $seen{$_} < 20;
+    }
+    if (/silo overflow/) {
+	next if $seen{$_} < 20;
+    }
+    print $seen{$_},":\t",$_;
+}
+
+print `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`;
diff --git a/gnu/usr.bin/perl/eg/scan/scan_passwd b/gnu/usr.bin/perl/eg/scan/scan_passwd
new file mode 100644
index 00000000000..6e4f3fc98c6
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_passwd
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+# $RCSfile: scan_passwd,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This scans passwd file for security holes.
+
+open(Pass,'/etc/passwd') || die "Can't open passwd file: $!\n";
+# $dotriv = (`date` =~ /^Mon/);
+$dotriv = 1;
+
+while (<Pass>) {
+    ($login,$pass,$uid,$gid,$gcos,$home,$shell) = split(/:/);
+    if ($shell eq '') {
+	print "Short: $_";
+    }
+    next if /^[+]/;
+    if ($pass eq '') {
+	if (index(":sync:lpq:+:", ":$login:") < 0) {
+	    print "No pass: $login\t$gcos\n";
+	}
+    }
+    elsif ($dotriv && crypt($login,substr($pass,0,2)) eq $pass) {
+	print "Trivial: $login\t$gcos\n";
+    }
+    if ($uid == 0) {
+	if ($login !~ /^.?root$/ && $pass ne '*') {
+	    print "Extra root: $_";
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/scan/scan_ps b/gnu/usr.bin/perl/eg/scan/scan_ps
new file mode 100644
index 00000000000..60ae1726d24
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_ps
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_ps,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This looks for looping processes.
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Ps, '/bin/ps -el|') || die "scan_ps: can't run ps";
+
+while (<Ps>) {
+    next if /rwhod/;
+    print if index(' T', substr($_,62,1)) < 0;
+}
+#else
+open(Ps, '/bin/ps auxww|') || die "scan_ps: can't run ps";
+
+while (<Ps>) {
+    next if /dataserver/;
+    next if /nfsd/;
+    next if /update/;
+    next if /ypserv/;
+    next if /rwhod/;
+    next if /routed/;
+    next if /pagedaemon/;
+#ifdef vax
+    ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$start,$time) = split;
+#else
+    ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$time) = split;
+#endif
+    print if length($time) > 4;
+}
+#endif
diff --git a/gnu/usr.bin/perl/eg/scan/scan_sudo b/gnu/usr.bin/perl/eg/scan/scan_sudo
new file mode 100644
index 00000000000..a8aae32f497
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_sudo
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_sudo,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:57 $
+
+# Analyze the sudo log.
+
+chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
+
+if (open(Oldsudo,'oldsudo')) {
+    $maxpos = <Oldsudo>;
+    close Oldsudo;
+}
+else {
+    $maxpos = 0;
+    `echo 0 >oldsudo`;
+}
+
+unless (open(Sudo, '/usr/adm/sudo.log')) {
+    print "Somebody removed sudo.log!!!\n" if $maxpos;
+    exit 0;
+}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(Sudo);
+
+if ($size < $maxpos) {
+    $maxpos = 0;
+    print "Somebody reset sudo.log!!!\n";
+}
+
+seek(Sudo,$maxpos,0);
+
+while (<Sudo>) {
+    s/^.* :[ \t]+//;
+    s/ipcrm.*/ipcrm/;
+    s/kill.*/kill/;
+    unless ($seen{$_}++) {
+	push(@seen,$_);
+    }
+    $last = $_;
+}
+$max = tell(Sudo);
+
+open(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file: $!\n";
+while ($_ = pop(@seen)) {
+    print tmp $_;
+}
+close(tmp);
+open(tmp,'oldsudo.tmp') || die "Can't reopen tmp file: $!\n";
+while (<tmp>) {
+    print $seen{$_},":\t",$_;
+}
+
+print `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`;
diff --git a/gnu/usr.bin/perl/eg/scan/scan_suid b/gnu/usr.bin/perl/eg/scan/scan_suid
new file mode 100644
index 00000000000..b4738feeb1a
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_suid
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_suid,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:57 $
+
+# Look for new setuid root files.
+
+chdir '/usr/adm/private/memories' || die "Can't cd to memories: $!\n";
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('oldsuid');
+if ($nlink) {
+    $lasttime = $mtime;
+    $tmp = $ctime - $atime;
+    if ($tmp <= 0 || $tmp >= 10) {
+	print "WARNING: somebody has read oldsuid!\n";
+    }
+    $tmp = $ctime - $mtime;
+    if ($tmp <= 0 || $tmp >= 10) {
+	print "WARNING: somebody has modified oldsuid!!!\n";
+    }
+} else {
+    $lasttime = time - 60 * 60 * 24;	# one day ago
+}
+$thistime = time;
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Find, 'find / -perm -04000 -print |') ||
+	die "scan_find: can't run find";
+#else
+open(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') ||
+	die "scan_find: can't run find";
+#endif
+
+open(suid, '>newsuid.tmp');
+
+while (<Find>) {
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $x = `/bin/ls -il $_`;
+    $_ = $x;
+    s/^ *//;
+    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split;
+#else
+    s/^ *//;
+    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split;
+#endif
+
+    if ($perm =~ /[sS]/ && $owner eq 'root') {
+	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+	   $blksize,$blocks) = stat($name);
+	$foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n",
+		$perm,$links,$owner,$group,$size,$month,$day,$name,$inode);
+	print suid $foo;
+	if ($ctime > $lasttime) {
+	    if ($ctime > $thistime) {
+		print "Future file: $foo";
+	    }
+	    else {
+		$ct .= $foo;
+	    }
+	}
+    }
+}
+close(suid);
+
+print `sort +7 -8 newsuid.tmp >newsuid 2>&1`;
+$foo = `/bin/diff oldsuid newsuid 2>&1`;
+print "Differences in suid info:\n",$foo if $foo;
+print `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`;
+print `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`;
+print `rm -f newsuid.tmp 2>&1`;
+
+@ct = split(/\n/,$ct);
+$ct = '';
+$* = 1;
+while ($#ct >= 0) {
+    $tmp = shift(@ct);
+    unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; }
+}
+
+print "Inode changed since last time:\n",$ct if $ct;
+
diff --git a/gnu/usr.bin/perl/eg/scan/scanner b/gnu/usr.bin/perl/eg/scan/scanner
new file mode 100644
index 00000000000..95e663bd3f7
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scanner
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+# $RCSfile: scanner,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:57 $
+
+# This runs all the scan_* routines on all the machines in /etc/ghosts.
+# We run this every morning at about 6 am:
+
+#	!/bin/sh
+#	cd /usr/adm/private
+#	decrypt scanner | perl >scan.out 2>&1
+#	mail admin <scan.out
+
+# Note that the scan_* files should be encrypted with the key "-inquire", and
+# scanner should be encrypted somehow so that people can't find that key.
+# I leave it up to you to figure out how to unencrypt it before executing.
+
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:.';
+
+$| = 1;		# command buffering on stdout
+
+print "Subject: bizarre happenings\n\n";
+
+(chdir '/usr/adm/private') || die "Can't cd to /usr/adm/private: $!\n";
+
+if ($#ARGV >= 0) {
+    @scanlist = @ARGV;
+} else {
+    @scanlist = split(/[ \t\n]+/,`echo scan_*`);
+}
+
+scan: while ($scan = shift(@scanlist)) {
+    print "\n********** $scan **********\n";
+    $showhost++;
+
+    $systype = 'all';
+
+    open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
+
+    $one_of_these = ":$systype:";
+    if ($systype =~ s/\+/[+]/g) {
+	$one_of_these =~ s/\+/:/g;
+    }
+
+    line: while (<ghosts>) {
+	s/[ \t]*\n//;
+	if (!$_ || /^#/) {
+	    next line;
+	}
+	if (/^([a-zA-Z_0-9]+)=(.+)/) {
+	    $name = $1; $repl = $2;
+	    $repl =~ s/\+/:/g;
+	    $one_of_these =~ s/:$name:/:$repl:/;
+	    next line;
+	}
+	@gh = split;
+	$host = $gh[0];
+	if ($showhost) { $showhost = "$host:\t"; }
+	class: while ($class = pop(gh)) {
+	    if (index($one_of_these,":$class:") >=0) {
+		$iter = 0;
+		`exec crypt -inquire <$scan >.x 2>/dev/null`;
+		unless (open(scan,'.x')) {
+		    print "Can't run $scan: $!\n";
+		    next scan;
+		}
+		$cmd = <scan>;
+		unless ($cmd =~ s/#!(.*)\n/$1/) {
+		    $cmd = '/usr/bin/perl';
+		}
+		close(scan);
+		if (open(PIPE,"exec rsh $host '$cmd' <.x|")) {
+		    sleep(5);
+		    unlink '.x';
+		    while (<PIPE>) {
+			last if $iter++ > 1000;		# must be looping
+			next if /^[0-9.]+u [0-9.]+s/;
+			print $showhost,$_;
+		    }
+		    close(PIPE);
+		} else {
+		    print "(Can't execute rsh: $!)\n";
+		}
+		last class;
+	    }
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/server b/gnu/usr.bin/perl/eg/server
new file mode 100644
index 00000000000..49a140a4c2c
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/server
@@ -0,0 +1,27 @@
+#!./perl
+
+$pat = 'S n C4 x8';
+$inet = 2;
+$echo = 7;
+$smtp = 25;
+$nntp = 119;
+
+$this = pack($pat,$inet,2345, 0,0,0,0);
+select(NS); $| = 1; select(stdout);
+
+if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
+if (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
+if (listen(S,5)) { print "listen ok\n"; } else { die $!; }
+for (;;) {
+    print "Listening again\n";
+    if ($addr = accept(NS,S)) { print "accept ok\n"; } else { die $!; }
+
+    @ary = unpack($pat,$addr);
+    $, = ' ';
+    print @ary; print "\n";
+
+    while (<NS>) {
+	print;
+	print NS;
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/shmkill b/gnu/usr.bin/perl/eg/shmkill
new file mode 100644
index 00000000000..3477f3297d5
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/shmkill
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+# $RCSfile: shmkill,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:54 $
+
+# A script to call from crontab periodically when people are leaving shared
+# memory sitting around unattached.
+
+open(ipcs,'ipcs -m -o|') || die "Can't run ipcs: $!";
+
+while (<ipcs>) {
+    $tmp = index($_,'NATTCH');
+    $pos = $tmp if $tmp >= 0;
+    if (/^m/) {
+	($m,$id,$key,$mode,$owner,$group,$attach) = split;
+	if ($attach != substr($_,$pos,6)) {
+	    die "Different ipcs format--can't parse!\n";
+	}
+	if ($attach == 0) {
+	    push(@goners,'-m',$id);
+	}
+    }
+}
+
+exec 'ipcrm', @goners if $#goners >= 0;
diff --git a/gnu/usr.bin/perl/eg/sysvipc/README b/gnu/usr.bin/perl/eg/sysvipc/README
new file mode 100644
index 00000000000..54094f1d85b
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/README
@@ -0,0 +1,9 @@
+FYEnjoyment, here are the test scripts I used while implementing SysV
+IPC in Perl.  Each of them must be run with the parameter "s" for
+"send" or "r" for "receive"; in each case, the receiver is the server
+and the sender is the client.
+
+-- 
+Chip Salzenberg at ComDev/TCT     <chip@tct.uucp>, <uunet!ateng!tct!chip>
+
+
diff --git a/gnu/usr.bin/perl/eg/sysvipc/ipcmsg b/gnu/usr.bin/perl/eg/sysvipc/ipcmsg
new file mode 100644
index 00000000000..317e027ea75
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/ipcmsg
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/msg.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/;
+$send = ($mode eq "s");
+
+$id = msgget(0x1234, ($send ? 0 : &IPC_CREAT) | 0644);
+die "Can't get message queue: $!\n" unless defined($id);
+print "message queue id: $id\n";
+
+if ($send) {
+	while (<STDIN>) {
+		chop;
+		unless (msgsnd($id, pack("LA*", $., $_), 0)) {
+			die "Can't send message: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		unless (msgrcv($id, $_, 512, 0, 0)) {
+			die "Can't receive message: $!\n";
+		}
+		($type, $message) = unpack("La*", $_);
+		printf "[%d] %s\n", $type, $message;
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$send) {
+		$x = msgctl($id, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove message queue: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/gnu/usr.bin/perl/eg/sysvipc/ipcsem b/gnu/usr.bin/perl/eg/sysvipc/ipcsem
new file mode 100644
index 00000000000..d72a2dd77c9
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/ipcsem
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/msg.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/;
+$signal = ($mode eq "s");
+
+$id = semget(0x1234, 1, ($signal ? 0 : &IPC_CREAT) | 0644);
+die "Can't get semaphore: $!\n" unless defined($id);
+print "semaphore id: $id\n";
+
+if ($signal) {
+	while (<STDIN>) {
+		print "Signalling\n";
+		unless (semop($id, 0, pack("sss", 0, 1, 0))) {
+			die "Can't signal semaphore: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		unless (semop($id, 0, pack("sss", 0, -1, 0))) {
+			die "Can't wait for semaphore: $!\n";
+		}
+		print "Unblocked\n";
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$signal) {
+		$x = semctl($id, 0, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove semaphore: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/gnu/usr.bin/perl/eg/sysvipc/ipcshm b/gnu/usr.bin/perl/eg/sysvipc/ipcshm
new file mode 100644
index 00000000000..d40e46b9450
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/ipcshm
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/shm.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcshm {r|s}\n" unless $mode =~ /^[rs]$/;
+$send = ($mode eq "s");
+
+$SIZE = 32;
+$id = shmget(0x1234, $SIZE, ($send ? 0 : &IPC_CREAT) | 0644);
+die "Can't get shared memory: $!\n" unless defined($id);
+print "shared memory id: $id\n";
+
+if ($send) {
+	while (<STDIN>) {
+		chop;
+		unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) {
+			die "Can't write to shared memory: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		$_ = <STDIN>;
+		unless (shmread($id, $_, 0, $SIZE)) {
+			die "Can't read shared memory: $!\n";
+		}
+		$len = unpack("L", $_);
+		$message = substr($_, length(pack("L",0)), $len);
+		printf "[%d] %s\n", $len, $message;
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$send) {
+		$x = shmctl($id, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove shared memory: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/gnu/usr.bin/perl/eg/travesty b/gnu/usr.bin/perl/eg/travesty
new file mode 100644
index 00000000000..7e6f983c7ce
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/travesty
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+while (<>) {
+    next if /^\./;
+    next if /^From / .. /^$/;
+    next if /^Path: / .. /^$/;
+    s/^\W+//;
+    push(@ary,split(' '));
+    while ($#ary > 1) {
+	$a = $p;
+	$p = $n;
+	$w = shift(@ary);
+	$n = $num{$w};
+	if ($n eq '') {
+	    push(@word,$w);
+	    $n = pack('S',$#word);
+	    $num{$w} = $n;
+	}
+	$lookup{$a . $p} .= $n;
+    }
+}
+
+for (;;) {
+    $n = $lookup{$a . $p};
+    ($foo,$n) = each(lookup) if $n eq '';
+    $n = substr($n,int(rand(length($n))) & 0177776,2);
+    $a = $p;
+    $p = $n;
+    ($w) = unpack('S',$n);
+    $w = $word[$w];
+    $col += length($w) + 1;
+    if ($col >= 65) {
+	$col = 0;
+	print "\n";
+    }
+    else {
+	print ' ';
+    }
+    print $w;
+    if ($w =~ /\.$/) {
+	if (rand() < .1) {
+	    print "\n";
+	    $col = 80;
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/unuc b/gnu/usr.bin/perl/eg/unuc
new file mode 100644
index 00000000000..ae5c65285db
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/unuc
@@ -0,0 +1,186 @@
+#!/usr/bin/perl
+
+print STDERR "Loading proper nouns...\n";
+open(DICT,"/usr/dict/words") || die "Can't find /usr/dict/words: $!\n";
+while (<DICT>) {
+    if (/^[A-Z]/) {
+	chop;
+	($lower = $_) =~ y/A-Z/a-z/;
+	$proper{$lower} = $_;
+    }
+}
+close DICT;
+print STDERR "Loading exceptions...\n";
+
+$prog = <<'EOT';
+while (<>) {
+    next if /[a-z]/;
+    y/A-Z/a-z/;
+    s/(\w+)/$proper{$1} ? $proper{$1} : $1/eg;
+    s/^(\s*)([a-z])/$1 . (($tmp = $2) =~ y:a-z:A-Z:,$tmp)/e;
+    s/([-.?!]["']?(\n\s*|  \s*)["']?)([a-z])/$1 . (($tmp = $3) =~ y:a-z:A-Z:,$tmp)/eg;
+    s/\b([b-df-hj-np-tv-xz]+)\b/(($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg;
+    s/([a-z])'([SDT])\b/$1 . "'" . (($tmp = $2) =~ y:A-Z:a-z:,$tmp)/eg;
+EOT
+while (<DATA>) {
+    chop;
+    next if /^$/;
+    next if /^#/;
+    if (! /;$/) {
+	$foo = $_;
+	$foo =~ y/A-Z/a-z/;
+	print STDERR "Dup $_\n" if $proper{$foo};
+	$foo =~ s/([^\w ])/\\$1/g;
+	$foo =~ s/ /(\\s+)/g;
+	$foo = "\\b" . $foo if $foo =~ /^\w/;	# XXX till patch 9
+	$foo .= "\\b" if $foo =~ /\w$/;
+	$i = 0;
+	($bar = $_) =~ s/ /'$' . ++$i/eg;
+	$_ = "s/$foo/$bar/gi;";
+    }
+    $prog .= '    ' . $_ . "\n";
+}
+$prog .= "}\ncontinue {\n    print;\n}\n";
+
+$/ = '';
+#print $prog;
+eval $prog; die $@ if $@;
+__END__
+A.M.
+Air Force
+Air Force Base
+Air Force Station
+American
+Apr.
+Ariane
+Aug.
+August
+Bureau of Labor Statistics
+CIT
+Caltech
+Cape Canaveral
+Challenger
+China
+Corporation
+Crippen
+Daily News in Brief
+Daniel Quayle
+Dec.
+Discovery
+Edwards
+Endeavour
+Feb.
+Ford Aerospace
+Fri.
+General Dynamics
+George Bush
+Headline News
+HOTOL
+I
+II
+III
+IV
+IX
+Institute of Technology
+JPL
+Jan.
+Jul.
+Jun.
+Kennedy Space Center
+LDEF
+Long Duration Exposure Facility
+Long March
+Mar.
+March
+Martin
+Martin Marietta
+Mercury
+Mon.
+in May
+s/\bmay (\d)/May $1/g;
+s/\boffice of (\w)/'Office of ' . (($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg;
+National Science Foundation
+NASA Select
+New Mexico
+Nov.
+OMB
+Oct.
+Office of Management and Budget
+President
+President Bush
+Richard Truly
+Rocketdyne
+Russian
+Russians
+Sat.
+Sep.
+Soviet
+Soviet Union
+Soviets
+Space Shuttle
+Sun.
+Thu.
+Tue.
+U.S.
+Union of Soviet Socialist Republics
+United States
+VI
+VII
+VIII
+Vice President
+Vice President Quayle
+Wed.
+White Sands
+Kaman Aerospace
+Aerospace Daily
+Aviation Week
+Space Technology
+Washington Post
+Los Angeles Times
+New York Times
+Aerospace Industries Association
+president of
+Johnson Space Center
+Space Services
+Inc.
+Co.
+Hughes Aircraft
+Company
+Orbital Sciences
+Swedish Space
+Arnauld
+Nicogosian
+Magellan
+Galileo
+Mir
+Jet Propulsion Laboratory
+University
+Department of Defense
+Orbital Science
+OMS
+United Press International
+United Press
+UPI
+Associated Press
+AP
+Cable News Network
+Cape York
+Zenit
+SYNCOM
+Eastern
+Western
+Test Range
+Jcsat
+Japanese Satellite Communications
+Defence Ministry
+Defense Ministry
+Skynet
+Fixed Service Structure
+Launch Processing System
+Asiasat
+Launch Control Center
+Earth
+CNES
+Glavkosmos
+Pacific
+Atlantic
diff --git a/gnu/usr.bin/perl/eg/uudecode b/gnu/usr.bin/perl/eg/uudecode
new file mode 100644
index 00000000000..3b3cb60a234
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/uudecode
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+while (<>) {
+    next unless ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
+    open(OUT,"> $file") || die "Can't create $file: $!\n";
+    while (<>) {
+	    last if /^end/;
+	    next if /[a-z]/;
+	    next unless int((((ord() - 32) & 077) + 2) / 3) ==
+		    int(length() / 4);
+	    print OUT unpack("u", $_);
+    }
+    chmod oct($mode), $file;
+    eof() && die "Missing end: $file may be truncated.\n";
+}
+
diff --git a/gnu/usr.bin/perl/eg/van/empty b/gnu/usr.bin/perl/eg/van/empty
new file mode 100644
index 00000000000..eb49bb10c96
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/empty
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# $RCSfile: empty,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:58 $
+
+# This script empties a trashcan.
+
+$recursive = shift if $ARGV[0] eq '-r';
+
+@ARGV = '.' if $#ARGV < 0;
+
+chop($pwd = `pwd`);
+
+dir: foreach $dir (@ARGV) {
+    unless (chdir $dir) {
+	print stderr "Can't find directory $dir: $!\n";
+	next dir;
+    }
+    if ($recursive) {
+	do cmd('find . -name .deleted -exec /bin/rm -rf {} ;');
+    }
+    else {
+	if (-d '.deleted') {
+	    do cmd('rm -rf .deleted');
+	}
+	else {
+	    if ($dir eq '.' && $pwd =~ m|/\.deleted$|) {
+		chdir '..';
+		do cmd('rm -rf .deleted');
+	    }
+	    else {
+		print stderr "No trashcan found in directory $dir\n";
+	    }
+	}
+    }
+}
+continue {
+    chdir $pwd;
+}
+
+# force direct execution with no shell
+
+sub cmd {
+    system split(' ',join(' ',@_));
+}
+
diff --git a/gnu/usr.bin/perl/eg/van/unvanish b/gnu/usr.bin/perl/eg/van/unvanish
new file mode 100644
index 00000000000..f158cd7d1e3
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/unvanish
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# $RCSfile: unvanish,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:58 $
+
+sub it {
+    if ($olddir ne '.') {
+	chop($pwd = `pwd`) if $pwd eq '';
+	(chdir $olddir) || die "Directory $olddir is not accesible";
+    }
+    unless ($olddir eq '.deleted') {
+	if (-d '.deleted') {
+	    chdir '.deleted' || die "Directory .deleted is not accesible";
+	}
+	else {
+	    chop($pwd = `pwd`) if $pwd eq '';
+	    die "Directory .deleted does not exist" unless $pwd =~ /\.deleted$/;
+	}
+    }
+    print `mv $startfiles$filelist..$force`;
+    if ($olddir ne '.') {
+	(chdir $pwd) || die "Can't get back to original directory $pwd: $!\n";
+    }
+}
+
+if ($#ARGV < 0) {
+    open(lastcmd,'.deleted/.lastcmd') || 
+	open(lastcmd,'.lastcmd') || 
+	    die "No previous vanish in this dir";
+    $ARGV = <lastcmd>;
+    close(lastcmd);
+    @ARGV = split(/[\n ]+/,$ARGV);
+}
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+    /^-f/ && ($force = ' >/dev/null 2>&1');
+    /^-i/ && ($interactive = 1);
+    if (/^-+$/) {
+	$startfiles = '- ';
+	last;
+    }
+}
+
+while ($file = shift) {
+    if ($file =~ s|^(.*)/||) {
+	$dir = $1;
+    }
+    else {
+	$dir = '.';
+    }
+
+    if ($dir ne $olddir) {
+	do it() if $olddir;
+	$olddir = $dir;
+    }
+
+    if ($interactive) {
+	print "unvanish: restore $dir/$file? ";
+	next unless <stdin> =~ /^y/i;
+    }
+
+    $filelist .= $file; $filelist .= ' ';
+
+}
+
+do it() if $olddir;
diff --git a/gnu/usr.bin/perl/eg/van/vanexp b/gnu/usr.bin/perl/eg/van/vanexp
new file mode 100644
index 00000000000..c17e509c015
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/vanexp
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $RCSfile: vanexp,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:58 $
+
+# This is for running from a find at night to expire old .deleteds
+
+$can = $ARGV[0];
+
+exit 1 unless $can =~ /.deleted$/;
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($can);
+
+exit 0 unless $size;
+
+if (time - $mtime > 2 * 24 * 60 * 60) {
+    `/bin/rm -rf $can`;
+}
+else {
+    `find $can -ctime +2 -exec rm -f {} \;`;
+}
diff --git a/gnu/usr.bin/perl/eg/van/vanish b/gnu/usr.bin/perl/eg/van/vanish
new file mode 100644
index 00000000000..a6feec3c1da
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/vanish
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# $RCSfile: vanish,v $$Revision: 1.1 $$Date: 1996/08/19 10:11:58 $
+
+sub it {
+    if ($olddir ne '.') {
+	chop($pwd = `pwd`) if $pwd eq '';
+	(chdir $olddir) || die "Directory $olddir is not accesible";
+    }
+    if (!-d .deleted) {
+	print `mkdir .deleted; chmod 775 .deleted`;
+	die "You can't remove files from $olddir" if $?;
+    }
+    $filelist =~ s/ $//;
+    $filelist =~ s/#/\\#/g;
+    if ($filelist !~ /^[ \t]*$/) {
+	open(lastcmd,'>.deleted/.lastcmd');
+	print lastcmd $filelist,"\n";
+	close(lastcmd);
+	print `/bin/mv $startfiles$filelist .deleted$force`;
+    }
+    if ($olddir ne '.') {
+	(chdir $pwd) || die "Can't get back to original directory $pwd: $!\n";
+    }
+}
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+    /^-f/ && ($force = ' >/dev/null 2>&1');
+    /^-i/ && ($interactive = 1);
+    if (/^-+$/) {
+	$startfiles = '- ';
+	last;
+    }
+}
+
+chop($pwd = `pwd`);
+
+while ($file = shift) {
+    if ($file =~ s|^(.*)/||) {
+	$dir = $1;
+    }
+    else {
+	$dir = '.';
+    }
+
+    if ($interactive) {
+	print "vanish: remove $dir/$file? ";
+	next unless <stdin> =~ /^y/i;
+    }
+
+    if ($file eq '.deleted') {
+	print stderr "To delete .deleted (the trashcan) use the 'empty' command.\n";
+	next;
+    }
+
+    if ($dir ne $olddir) {
+	do it() if $olddir;
+	$olddir = $dir;
+    }
+
+    $filelist .= $file; $filelist .= ' ';
+}
+
+do it() if $olddir;
diff --git a/gnu/usr.bin/perl/eg/who b/gnu/usr.bin/perl/eg/who
new file mode 100644
index 00000000000..ac15246c9fa
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/who
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+# This assumes your /etc/utmp file looks like ours
+open(UTMP,'/etc/utmp');
+@mo = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
+while (read(UTMP,$utmp,36)) {
+    ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp);
+    if ($name) {
+	$host = "($host)" if ord($host);
+	($sec,$min,$hour,$mday,$mon) = localtime($time);
+	printf "%-9s%-8s%s %2d %02d:%02d   %s\n",
+	  $name,$line,$mo[$mon],$mday,$hour,$min,$host;
+    }
+}   
diff --git a/gnu/usr.bin/perl/eg/wrapsuid b/gnu/usr.bin/perl/eg/wrapsuid
new file mode 100644
index 00000000000..8de9c6e7e49
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/wrapsuid
@@ -0,0 +1,107 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $Header: /cvs/OpenBSD/src/gnu/usr.bin/perl/eg/Attic/wrapsuid,v 1.1 1996/08/19 10:11:54 downsj Exp $
+#
+# $Log: wrapsuid,v $
+# Revision 1.1  1996/08/19 10:11:54  downsj
+# Initial revision
+#
+# Revision 1.1  90/08/11  13:51:29  lwall
+# Initial revision
+# 
+
+$xdev = '-xdev' unless -d '/dev/iop';
+
+if ($#ARGV >= 0) {
+    @list = @ARGV;
+    foreach $name (@ARGV) {
+	die "You must use absolute pathnames.\n" unless $name =~ m|^/|;
+    }
+}
+else {
+    open(DF,"/etc/mount|") || die "Can't run /etc/mount";
+
+    while (<DF>) {
+	chop;
+	$_ .= <DF> if length($_) < 50;
+	@ary = split;
+	push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|);
+    }
+}
+$fslist = join(' ',@list);
+
+die "Can't find local filesystems" unless $fslist;
+
+open(FIND,
+  "find $fslist $xdev -type f \\( -perm -04000 -o -perm -02000 \\) -print|");
+
+while (<FIND>) {
+    chop;
+    next unless -T;
+    print "Fixing ", $_, "\n";
+    ($dir,$file) = m|(.*)/(.*)|;
+    chdir $dir || die "Can't chdir to $dir";
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat($file);
+       die "Can't stat $_" unless $ino;
+    chmod $mode & 01777, $file;		# wipe out set[ug]id bits
+    rename($file,".$file");
+    open(C,">.tmp$$.c") || die "Can't write C program for $_";
+    $real = "$dir/.$file";
+    print C '
+main(argc,argv)
+int argc;
+char **argv;
+{
+    execv("' . $real . '",argv);
+}
+';
+    close C;
+    system '/bin/cc', ".tmp$$.c", '-o', $file;
+    die "Can't compile new $_" if $?;
+    chmod $mode, $file;
+    chown $uid, $gid, $file;
+    unlink ".tmp$$.c";
+    chdir '/';
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00;			# finish .ig
+ 
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+'; __END__ ############# From here on it's a standard manual page ############
+.TH SUIDSCRIPT 1 "July 30, 1990"
+.AT 3
+.SH NAME
+wrapsuid \- puts a compiled C wrapper around a setuid or setgid script
+.SH SYNOPSIS
+.B wrapsuid [dirlist]
+.SH DESCRIPTION
+.I Wrapsuid
+creates a small C program to execute a script with setuid or setgid privileges
+without having to set the setuid or setgid bit on the script, which is
+a security problem on many machines.
+Specify the list of directories or files that you wish to process.
+The names must be absolute pathnames.
+With no arguments it will attempt to process all the local directories
+for this machine.
+The scripts to be processed must have the setuid or setgid bit set.
+The wrapsuid program will delete the bits and set them on the wrapper.
+.PP
+Non-superusers may only process their own files.
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+None.
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+.SH DIAGNOSTICS
+.SH BUGS
+.ex