diff options
Diffstat (limited to 'gnu/usr.bin/perl/eg')
42 files changed, 0 insertions, 2135 deletions
diff --git a/gnu/usr.bin/perl/eg/ADB b/gnu/usr.bin/perl/eg/ADB deleted file mode 100644 index 09b93c3..0000000 --- a/gnu/usr.bin/perl/eg/ADB +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/ADB,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index 87cfc33..0000000 --- a/gnu/usr.bin/perl/eg/README +++ /dev/null @@ -1,22 +0,0 @@ -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 deleted file mode 100644 index 9835e1b..0000000 --- a/gnu/usr.bin/perl/eg/changes +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/changes,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -($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 deleted file mode 100644 index 5900c90..0000000 --- a/gnu/usr.bin/perl/eg/client +++ /dev/null @@ -1,34 +0,0 @@ -#!./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 deleted file mode 100644 index bbb0d06..0000000 --- a/gnu/usr.bin/perl/eg/down +++ /dev/null @@ -1,30 +0,0 @@ -#!/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 deleted file mode 100644 index 94c648b..0000000 --- a/gnu/usr.bin/perl/eg/dus +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/dus,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index 47e4438..0000000 --- a/gnu/usr.bin/perl/eg/findcp +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/findcp,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index a60f10f..0000000 --- a/gnu/usr.bin/perl/eg/findtar +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/findtar,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index 3e44a9c..0000000 --- a/gnu/usr.bin/perl/eg/g/gcp +++ /dev/null @@ -1,114 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gcp,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index 8985742..0000000 --- a/gnu/usr.bin/perl/eg/g/gcp.man +++ /dev/null @@ -1,77 +0,0 @@ -.\" $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gcp.man,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ -.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 deleted file mode 100644 index d296a84..0000000 --- a/gnu/usr.bin/perl/eg/g/ged +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/ged,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index 96ec771..0000000 --- a/gnu/usr.bin/perl/eg/g/ghosts +++ /dev/null @@ -1,33 +0,0 @@ -# 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 deleted file mode 100644 index 3322a02..0000000 --- a/gnu/usr.bin/perl/eg/g/gsh +++ /dev/null @@ -1,117 +0,0 @@ -#! /usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gsh,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index 00eafb6..0000000 --- a/gnu/usr.bin/perl/eg/g/gsh.man +++ /dev/null @@ -1,80 +0,0 @@ -.\" $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gsh.man,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ -.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 deleted file mode 100644 index 873539b..0000000 --- a/gnu/usr.bin/perl/eg/muck +++ /dev/null @@ -1,141 +0,0 @@ -#!../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 deleted file mode 100644 index 1b45ee0..0000000 --- a/gnu/usr.bin/perl/eg/muck.man +++ /dev/null @@ -1,21 +0,0 @@ -.\" $Header: /home/cvs/386BSD/ports/lang/perl/eg/muck.man,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ -.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 deleted file mode 100644 index b318589..0000000 --- a/gnu/usr.bin/perl/eg/myrup +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/myrup,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index a376142..0000000 --- a/gnu/usr.bin/perl/eg/nih +++ /dev/null @@ -1,10 +0,0 @@ -eval "exec /usr/bin/perl -Spi.bak $0 $*" - if $running_under_some_shell; - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/nih,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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/perlsh b/gnu/usr.bin/perl/eg/perlsh deleted file mode 100644 index 2b2cccd..0000000 --- a/gnu/usr.bin/perl/eg/perlsh +++ /dev/null @@ -1,15 +0,0 @@ -#!/usr/bin/perl - -# Poor man's perl shell. - -# Simply type two carriage returns every time you want to evaluate. -# Note that it must be a complete perl statement--don't type double -# carriage return in the middle of a loop. - -$/ = "\n\n"; # set paragraph mode -$SHlinesep = "\n"; -while ($SHcmd = <>) { - $/ = $SHlinesep; - eval $SHcmd; print $@ || "\n"; - $SHlinesep = $/; $/ = ''; -} diff --git a/gnu/usr.bin/perl/eg/relink b/gnu/usr.bin/perl/eg/relink deleted file mode 100644 index 69956c9..0000000 --- a/gnu/usr.bin/perl/eg/relink +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl -'di'; -'ig00'; -# -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/relink,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ -# -# $Log: relink,v $ -# Revision 1.1.1.1 1993/08/23 21:29:43 nate -# PERL! -# -# Revision 4.0 91/03/20 01:11:40 lwall -# 4.0 baseline. -# -# Revision 3.0.1.2 90/08/09 03:17:44 lwall -# patch19: added man page for relink and rename -# - -($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 deleted file mode 100644 index b568406..0000000 --- a/gnu/usr.bin/perl/eg/rename +++ /dev/null @@ -1,83 +0,0 @@ -#!/usr/bin/perl -'di'; -'ig00'; -# -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/rename,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ -# -# $Log: rename,v $ -# Revision 1.1.1.1 1993/08/23 21:29:43 nate -# PERL! -# -# Revision 4.0 91/03/20 01:11:53 lwall -# 4.0 baseline. -# -# Revision 3.0.1.2 90/08/09 03:17:57 lwall -# patch19: added man page for relink and rename -# - -($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 deleted file mode 100644 index 0c8fa2c..0000000 --- a/gnu/usr.bin/perl/eg/rmfrom +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/perl -n - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/rmfrom,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index 6887387..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_df +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_df,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index 6621120..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_last +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_last,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -# 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 deleted file mode 100644 index a28cda8..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_messages +++ /dev/null @@ -1,222 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_messages,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index f9c53c7d..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_passwd +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_passwd,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -# 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 deleted file mode 100644 index b0480d5..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_ps +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_ps,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -# 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 deleted file mode 100644 index a95a609..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_sudo +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_sudo,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -# 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 deleted file mode 100644 index a730e0a..0000000 --- a/gnu/usr.bin/perl/eg/scan/scan_suid +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/perl -P - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_suid,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index f773e87..0000000 --- a/gnu/usr.bin/perl/eg/scan/scanner +++ /dev/null @@ -1,87 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scanner,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $ - -# 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 deleted file mode 100644 index 49a140a..0000000 --- a/gnu/usr.bin/perl/eg/server +++ /dev/null @@ -1,27 +0,0 @@ -#!./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 deleted file mode 100644 index e8d1b11..0000000 --- a/gnu/usr.bin/perl/eg/shmkill +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/shmkill,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $ - -# 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 deleted file mode 100644 index 54094f1..0000000 --- a/gnu/usr.bin/perl/eg/sysvipc/README +++ /dev/null @@ -1,9 +0,0 @@ -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 deleted file mode 100644 index 317e027..0000000 --- a/gnu/usr.bin/perl/eg/sysvipc/ipcmsg +++ /dev/null @@ -1,47 +0,0 @@ -#!/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 deleted file mode 100644 index d72a2dd..0000000 --- a/gnu/usr.bin/perl/eg/sysvipc/ipcsem +++ /dev/null @@ -1,46 +0,0 @@ -#!/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 deleted file mode 100644 index d40e46b..0000000 --- a/gnu/usr.bin/perl/eg/sysvipc/ipcshm +++ /dev/null @@ -1,50 +0,0 @@ -#!/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 deleted file mode 100644 index 7e6f983..0000000 --- a/gnu/usr.bin/perl/eg/travesty +++ /dev/null @@ -1,46 +0,0 @@ -#!/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/van/empty b/gnu/usr.bin/perl/eg/van/empty deleted file mode 100644 index ee656e6..0000000 --- a/gnu/usr.bin/perl/eg/van/empty +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/empty,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -# 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 deleted file mode 100644 index 5045982..0000000 --- a/gnu/usr.bin/perl/eg/van/unvanish +++ /dev/null @@ -1,66 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/unvanish,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -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 deleted file mode 100644 index 79b7885..0000000 --- a/gnu/usr.bin/perl/eg/van/vanexp +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/vanexp,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -# 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 deleted file mode 100644 index b79776a..0000000 --- a/gnu/usr.bin/perl/eg/van/vanish +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl - -# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/vanish,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $ - -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 deleted file mode 100644 index ac15246..0000000 --- a/gnu/usr.bin/perl/eg/who +++ /dev/null @@ -1,13 +0,0 @@ -#!/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; - } -} |
