From 86b00b91adbc06e25e98c02d22e725e1888cb041 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 8 Aug 2000 19:01:51 +0000 Subject: [PATCH] Delete eg as agreed at TPC3 (yes, 3). Dusty, obsolete, non-w-clean. May be repopulated with fresh maintained examples. p4raw-id: //depot/perl@6556 --- MANIFEST | 86 +++-------- eg/ADB | 8 -- eg/README | 22 --- eg/changes | 34 ----- eg/client | 34 ----- eg/down | 30 ---- eg/dus | 22 --- eg/findcp | 53 ------- eg/findtar | 17 --- eg/g/gcp | 114 --------------- eg/g/gcp.man | 77 ---------- eg/g/ged | 21 --- eg/g/ghosts | 33 ----- eg/g/gsh | 117 --------------- eg/g/gsh.man | 80 ----------- eg/muck | 141 ------------------ eg/muck.man | 21 --- eg/myrup | 29 ---- eg/nih | 11 -- eg/relink | 82 ----------- eg/rename | 74 ---------- eg/rmfrom | 7 - eg/scan/scan_df | 51 ------- eg/scan/scan_last | 57 -------- eg/scan/scan_messages | 222 ----------------------------- eg/scan/scan_passwd | 30 ---- eg/scan/scan_ps | 32 ----- eg/scan/scan_sudo | 54 ------- eg/scan/scan_suid | 84 ----------- eg/scan/scanner | 87 ----------- eg/server | 27 ---- eg/shmkill | 24 ---- eg/sysvipc/README | 9 -- eg/sysvipc/ipcmsg | 47 ------ eg/sysvipc/ipcsem | 46 ------ eg/sysvipc/ipcshm | 50 ------- eg/travesty | 46 ------ eg/unuc | 186 ------------------------ eg/uudecode | 15 -- eg/van/empty | 45 ------ eg/van/unvanish | 66 --------- eg/van/vanexp | 21 --- eg/van/vanish | 65 --------- eg/who | 13 -- eg/wrapsuid | 104 -------------- {eg/cgi => lib/CGI/eg}/RunMeFirst | 0 {eg/cgi => lib/CGI/eg}/caution.xbm | 0 {eg/cgi => lib/CGI/eg}/clickable_image.cgi | 0 {eg/cgi => lib/CGI/eg}/cookie.cgi | 0 {eg/cgi => lib/CGI/eg}/crash.cgi | 0 {eg/cgi => lib/CGI/eg}/customize.cgi | 0 {eg/cgi => lib/CGI/eg}/diff_upload.cgi | 0 {eg/cgi => lib/CGI/eg}/dna_small_gif.uu | 0 {eg/cgi => lib/CGI/eg}/file_upload.cgi | 0 {eg/cgi => lib/CGI/eg}/frameset.cgi | 0 {eg/cgi => lib/CGI/eg}/index.html | 0 {eg/cgi => lib/CGI/eg}/internal_links.cgi | 0 {eg/cgi => lib/CGI/eg}/javascript.cgi | 0 {eg/cgi => lib/CGI/eg}/monty.cgi | 0 {eg/cgi => lib/CGI/eg}/multiple_forms.cgi | 0 {eg/cgi => lib/CGI/eg}/nph-clock.cgi | 0 {eg/cgi => lib/CGI/eg}/nph-multipart.cgi | 0 {eg/cgi => lib/CGI/eg}/popup.cgi | 0 {eg/cgi => lib/CGI/eg}/save_state.cgi | 0 {eg/cgi => lib/CGI/eg}/tryit.cgi | 0 {eg/cgi => lib/CGI/eg}/wilogo_gif.uu | 0 66 files changed, 21 insertions(+), 2473 deletions(-) delete mode 100644 eg/ADB delete mode 100644 eg/README delete mode 100644 eg/changes delete mode 100755 eg/client delete mode 100755 eg/down delete mode 100644 eg/dus delete mode 100644 eg/findcp delete mode 100644 eg/findtar delete mode 100644 eg/g/gcp delete mode 100644 eg/g/gcp.man delete mode 100644 eg/g/ged delete mode 100644 eg/g/ghosts delete mode 100644 eg/g/gsh delete mode 100644 eg/g/gsh.man delete mode 100644 eg/muck delete mode 100644 eg/muck.man delete mode 100644 eg/myrup delete mode 100644 eg/nih delete mode 100644 eg/relink delete mode 100755 eg/rename delete mode 100644 eg/rmfrom delete mode 100644 eg/scan/scan_df delete mode 100644 eg/scan/scan_last delete mode 100644 eg/scan/scan_messages delete mode 100644 eg/scan/scan_passwd delete mode 100644 eg/scan/scan_ps delete mode 100644 eg/scan/scan_sudo delete mode 100644 eg/scan/scan_suid delete mode 100644 eg/scan/scanner delete mode 100755 eg/server delete mode 100644 eg/shmkill delete mode 100644 eg/sysvipc/README delete mode 100644 eg/sysvipc/ipcmsg delete mode 100644 eg/sysvipc/ipcsem delete mode 100644 eg/sysvipc/ipcshm delete mode 100644 eg/travesty delete mode 100755 eg/unuc delete mode 100644 eg/uudecode delete mode 100644 eg/van/empty delete mode 100644 eg/van/unvanish delete mode 100644 eg/van/vanexp delete mode 100644 eg/van/vanish delete mode 100644 eg/who delete mode 100755 eg/wrapsuid rename {eg/cgi => lib/CGI/eg}/RunMeFirst (100%) rename {eg/cgi => lib/CGI/eg}/caution.xbm (100%) rename {eg/cgi => lib/CGI/eg}/clickable_image.cgi (100%) rename {eg/cgi => lib/CGI/eg}/cookie.cgi (100%) rename {eg/cgi => lib/CGI/eg}/crash.cgi (100%) rename {eg/cgi => lib/CGI/eg}/customize.cgi (100%) rename {eg/cgi => lib/CGI/eg}/diff_upload.cgi (100%) rename {eg/cgi => lib/CGI/eg}/dna_small_gif.uu (100%) rename {eg/cgi => lib/CGI/eg}/file_upload.cgi (100%) rename {eg/cgi => lib/CGI/eg}/frameset.cgi (100%) rename {eg/cgi => lib/CGI/eg}/index.html (100%) rename {eg/cgi => lib/CGI/eg}/internal_links.cgi (100%) rename {eg/cgi => lib/CGI/eg}/javascript.cgi (100%) rename {eg/cgi => lib/CGI/eg}/monty.cgi (100%) rename {eg/cgi => lib/CGI/eg}/multiple_forms.cgi (100%) rename {eg/cgi => lib/CGI/eg}/nph-clock.cgi (100%) rename {eg/cgi => lib/CGI/eg}/nph-multipart.cgi (100%) rename {eg/cgi => lib/CGI/eg}/popup.cgi (100%) rename {eg/cgi => lib/CGI/eg}/save_state.cgi (100%) rename {eg/cgi => lib/CGI/eg}/tryit.cgi (100%) rename {eg/cgi => lib/CGI/eg}/wilogo_gif.uu (100%) diff --git a/MANIFEST b/MANIFEST index 5dbb1b2..01c1941 100644 --- a/MANIFEST +++ b/MANIFEST @@ -88,71 +88,6 @@ doop.c Support code for various operations dosish.h Some defines for MS/DOSish machines dump.c Debugging output ebcdic.c EBCDIC support routines -eg/ADB An adb wrapper to put in your crash dir -eg/README Intro to example perl scripts -eg/cgi/RunMeFirst Setup script for CGI examples -eg/cgi/caution.xbm CGI example -eg/cgi/clickable_image.cgi CGI example -eg/cgi/cookie.cgi CGI example -eg/cgi/crash.cgi CGI example -eg/cgi/customize.cgi CGI example -eg/cgi/diff_upload.cgi CGI example -eg/cgi/dna_small_gif.uu Small image for CGI examples -eg/cgi/file_upload.cgi CGI example -eg/cgi/frameset.cgi CGI example -eg/cgi/index.html Index page for CGI examples -eg/cgi/internal_links.cgi CGI example -eg/cgi/javascript.cgi CGI example -eg/cgi/monty.cgi CGI example -eg/cgi/multiple_forms.cgi CGI example -eg/cgi/nph-clock.cgi CGI example -eg/cgi/nph-multipart.cgi CGI example -eg/cgi/popup.cgi CGI example -eg/cgi/save_state.cgi CGI example -eg/cgi/tryit.cgi CGI example -eg/cgi/wilogo_gif.uu Small image for CGI examples -eg/changes A program to list recently changed files -eg/client A sample client -eg/down A program to do things to subdirectories -eg/dus A program to do du -s on non-mounted dirs -eg/findcp A find wrapper that implements a -cp switch -eg/findtar A find wrapper that pumps out a tar file -eg/g/gcp A program to do a global rcp -eg/g/gcp.man Manual page for gcp -eg/g/ged A program to do a global edit -eg/g/ghosts A sample /etc/ghosts file -eg/g/gsh A program to do a global rsh -eg/g/gsh.man Manual page for gsh -eg/muck A program to find missing make dependencies -eg/muck.man Manual page for muck -eg/myrup A program to find lightly loaded machines -eg/nih Script to insert #! workaround -eg/relink A program to change symbolic links -eg/rename A program to rename files -eg/rmfrom A program to feed doomed filenames to -eg/scan/scan_df Scan for filesystem anomalies -eg/scan/scan_last Scan for login anomalies -eg/scan/scan_messages Scan for console message anomalies -eg/scan/scan_passwd Scan for passwd file anomalies -eg/scan/scan_ps Scan for process anomalies -eg/scan/scan_sudo Scan for sudo anomalies -eg/scan/scan_suid Scan for setuid anomalies -eg/scan/scanner An anomaly reporter -eg/server A sample server -eg/shmkill A program to remove unused shared memory -eg/sysvipc/README Intro to Sys V IPC examples -eg/sysvipc/ipcmsg Example of SYS V IPC message queues -eg/sysvipc/ipcsem Example of Sys V IPC semaphores -eg/sysvipc/ipcshm Example of Sys V IPC shared memory -eg/travesty A program to print travesties of its input text -eg/unuc Un-uppercases an all-uppercase text -eg/uudecode A version of uudecode -eg/van/empty A program to empty the trashcan -eg/van/unvanish A program to undo what vanish does -eg/van/vanexp A program to expire vanished files -eg/van/vanish A program to put files in a trashcan -eg/who A sample who program -eg/wrapsuid A setuid script wrapper generator emacs/cperl-mode.el An alternate perl-mode emacs/e2ctags.pl etags to ctags converter emacs/ptags Creates smart TAGS file @@ -575,6 +510,27 @@ lib/CGI/Pretty.pm Output nicely formatted HTML lib/CGI/Push.pm Support for server push lib/CGI/Switch.pm Simple interface for multiple server types lib/CGI/Util.pm Utility functions +lib/CGI/eg/RunMeFirst Setup script for CGI examples +lib/CGI/eg/caution.xbm CGI example +lib/CGI/eg/clickable_image.cgi CGI example +lib/CGI/eg/cookie.cgi CGI example +lib/CGI/eg/crash.cgi CGI example +lib/CGI/eg/customize.cgi CGI example +lib/CGI/eg/diff_upload.cgi CGI example +lib/CGI/eg/dna_small_gif.uu Small image for CGI examples +lib/CGI/eg/file_upload.cgi CGI example +lib/CGI/eg/frameset.cgi CGI example +lib/CGI/eg/index.html Index page for CGI examples +lib/CGI/eg/internal_links.cgi CGI example +lib/CGI/eg/javascript.cgi CGI example +lib/CGI/eg/monty.cgi CGI example +lib/CGI/eg/multiple_forms.cgi CGI example +lib/CGI/eg/nph-clock.cgi CGI example +lib/CGI/eg/nph-multipart.cgi CGI example +lib/CGI/eg/popup.cgi CGI example +lib/CGI/eg/save_state.cgi CGI example +lib/CGI/eg/tryit.cgi CGI example +lib/CGI/eg/wilogo_gif.uu Small image for CGI examples lib/CPAN.pm Interface to Comprehensive Perl Archive Network lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions diff --git a/eg/ADB b/eg/ADB deleted file mode 100644 index e8130e1..0000000 --- a/eg/ADB +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: ADB,v $$Revision: 4.1 $$Date: 92/08/07 17:20:06 $ - -# This script is only useful when used in your crash directory. - -$num = shift; -exec 'adb', '-k', "vmunix.$num", "vmcore.$num"; diff --git a/eg/README b/eg/README deleted file mode 100644 index 15eb655..0000000 --- a/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 ${1+"$@"}' - 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/eg/changes b/eg/changes deleted file mode 100644 index 901e1ed..0000000 --- a/eg/changes +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: changes,v $$Revision: 4.1 $$Date: 92/08/07 17:20:08 $ - -($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 () { - -#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/eg/client b/eg/client deleted file mode 100755 index 5900c90..0000000 --- a/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 () { - print S; - } - sleep 3; - do dokill(); -} -else { - while () { - print; - } -} - -sub dokill { kill 9,$child if $child; } diff --git a/eg/down b/eg/down deleted file mode 100755 index bbb0d06..0000000 --- a/eg/down +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -$| = 1; -if ($#ARGV >= 0) { - $cmd = join(' ',@ARGV); -} -else { - print "Command: "; - $cmd = ; - chop($cmd); - while ($cmd =~ s/\\$//) { - print "+ "; - $cmd .= ; - chop($cmd); - } -} -$cwd = `pwd`; chop($cwd); - -open(FIND,'find . -type d -print|') || die "Can't run find"; - -while () { - chop; - unless (chdir $_) { - print stderr "Can't cd to $_\n"; - next; - } - print "\t--> ",$_,"\n"; - system $cmd; - chdir $cwd; -} diff --git a/eg/dus b/eg/dus deleted file mode 100644 index 3025e2b..0000000 --- a/eg/dus +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: dus,v $$Revision: 4.1 $$Date: 92/08/07 17:20:11 $ - -# 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 () { - 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/eg/findcp b/eg/findcp deleted file mode 100644 index 5dba040..0000000 --- a/eg/findcp +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: findcp,v $$Revision: 4.1 $$Date: 92/08/07 17:20:12 $ - -# 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 () { - @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/eg/findtar b/eg/findtar deleted file mode 100644 index 6462f66..0000000 --- a/eg/findtar +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: findtar,v $$Revision: 4.1 $$Date: 92/08/07 17:20:13 $ - -# 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 () { - @x = split(' '); - if ($x[2] =~ /^d/) { print tar '-d ';} - print tar $x[10],"\n"; -} diff --git a/eg/g/gcp b/eg/g/gcp deleted file mode 100644 index d18b6f6..0000000 --- a/eg/g/gcp +++ /dev/null @@ -1,114 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: gcp,v $$Revision: 4.1 $$Date: 92/08/07 17:20:15 $ - -# 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/eg/g/gcp.man b/eg/g/gcp.man deleted file mode 100644 index 1198554..0000000 --- a/eg/g/gcp.man +++ /dev/null @@ -1,77 +0,0 @@ -.\" $RCSfile: gcp.man,v $$Revision: 4.1 $$Date: 92/08/07 17:20:17 $ -.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/eg/g/ged b/eg/g/ged deleted file mode 100644 index 07ac88f..0000000 --- a/eg/g/ged +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: ged,v $$Revision: 4.1 $$Date: 92/08/07 17:20:18 $ - -# 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 /tmp/gsh$$`; # get input into a handy place - $dist = " ) { # 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; ; $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/eg/g/gsh.man b/eg/g/gsh.man deleted file mode 100644 index 2958707..0000000 --- a/eg/g/gsh.man +++ /dev/null @@ -1,80 +0,0 @@ -.\" $RCSfile: gsh.man,v $$Revision: 4.1 $$Date: 92/08/07 17:20:22 $ -.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/eg/muck b/eg/muck deleted file mode 100644 index 873539b..0000000 --- a/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 () { - ($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/eg/muck.man b/eg/muck.man deleted file mode 100644 index 02ae428..0000000 --- a/eg/muck.man +++ /dev/null @@ -1,21 +0,0 @@ -.\" $RCSfile: muck.man,v $$Revision: 4.1 $$Date: 92/08/07 17:20:23 $ -.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/eg/myrup b/eg/myrup deleted file mode 100644 index 2cbdf75..0000000 --- a/eg/myrup +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: myrup,v $$Revision: 4.1 $$Date: 92/08/07 17:20:26 $ - -# 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 () { - 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 () { - ($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/eg/nih b/eg/nih deleted file mode 100644 index 4475c49..0000000 --- a/eg/nih +++ /dev/null @@ -1,11 +0,0 @@ -eval 'exec /usr/bin/perl -Spi.bak $0 ${1+"$@"}' - if $running_under_some_shell; - -# $RCSfile: nih,v $$Revision: 4.1 $$Date: 92/08/07 17:20:27 $ - -# 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 \${1+"\$@"}'\n\tif \$running_under_some_shell;] - if $. == 1; diff --git a/eg/relink b/eg/relink deleted file mode 100644 index 2c5793f..0000000 --- a/eg/relink +++ /dev/null @@ -1,82 +0,0 @@ -#!/usr/bin/perl -'di'; -'ig00'; -# -# $RCSfile: relink,v $$Revision: 4.1 $$Date: 92/08/07 17:20:29 $ -# -# $Log: relink,v $ - -($op = shift) || die "Usage: relink perlexpr [filenames]\n"; -if (!@ARGV) { - @ARGV = ; - 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/eg/rename b/eg/rename deleted file mode 100755 index 10e97f7..0000000 --- a/eg/rename +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl -'di'; -'ig00'; -# -# $RCSfile: rename,v $$Revision: 4.1 $$Date: 92/08/07 17:20:30 $ -# -# $Log: rename,v $ - -($op = shift) || die "Usage: rename perlexpr [filenames]\n"; -if (!@ARGV) { - @ARGV = ; - 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/eg/rmfrom b/eg/rmfrom deleted file mode 100644 index 7178e77..0000000 --- a/eg/rmfrom +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/perl -n - -# $RCSfile: rmfrom,v $$Revision: 4.1 $$Date: 92/08/07 17:20:31 $ - -# A handy (but dangerous) script to put after a find ... -print. - -chop; unlink; diff --git a/eg/scan/scan_df b/eg/scan/scan_df deleted file mode 100644 index c221cdc..0000000 --- a/eg/scan/scan_df +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: scan_df,v $$Revision: 4.1 $$Date: 92/08/07 17:20:33 $ - -# 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 () { - ($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 () { - ($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/eg/scan/scan_last b/eg/scan/scan_last deleted file mode 100644 index 4d15ca0..0000000 --- a/eg/scan/scan_last +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: scan_last,v $$Revision: 4.1 $$Date: 92/08/07 17:20:35 $ - -# 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 () { -#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/eg/scan/scan_messages b/eg/scan/scan_messages deleted file mode 100644 index 6cf0997..0000000 --- a/eg/scan/scan_messages +++ /dev/null @@ -1,222 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: scan_messages,v $$Revision: 4.1 $$Date: 92/08/07 17:20:37 $ - -# 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 () { - 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]: 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 () { - 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/eg/scan/scan_passwd b/eg/scan/scan_passwd deleted file mode 100644 index 50f6fc8..0000000 --- a/eg/scan/scan_passwd +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: scan_passwd,v $$Revision: 4.1 $$Date: 92/08/07 17:20:38 $ - -# This scans passwd file for security holes. - -open(Pass,'/etc/passwd') || die "Can't open passwd file: $!\n"; -# $dotriv = (`date` =~ /^Mon/); -$dotriv = 1; - -while () { - ($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/eg/scan/scan_ps b/eg/scan/scan_ps deleted file mode 100644 index 18b5cb2..0000000 --- a/eg/scan/scan_ps +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: scan_ps,v $$Revision: 4.1 $$Date: 92/08/07 17:20:40 $ - -# 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 () { - 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 () { - 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/eg/scan/scan_sudo b/eg/scan/scan_sudo deleted file mode 100644 index 5b143e9..0000000 --- a/eg/scan/scan_sudo +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: scan_sudo,v $$Revision: 4.1 $$Date: 92/08/07 17:20:42 $ - -# Analyze the sudo log. - -chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n"; - -if (open(Oldsudo,'oldsudo')) { - $maxpos = ; - 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 () { - 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 () { - print $seen{$_},":\t",$_; -} - -print `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`; diff --git a/eg/scan/scan_suid b/eg/scan/scan_suid deleted file mode 100644 index c10aa58..0000000 --- a/eg/scan/scan_suid +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/perl -P - -# $RCSfile: scan_suid,v $$Revision: 4.1 $$Date: 92/08/07 17:20:43 $ - -# 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 () { - -#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/eg/scan/scanner b/eg/scan/scanner deleted file mode 100644 index e73cdc8..0000000 --- a/eg/scan/scanner +++ /dev/null @@ -1,87 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: scanner,v $$Revision: 4.1 $$Date: 92/08/07 17:20:44 $ - -# 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 = 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 () { - 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 = ; - unless ($cmd =~ s/#!(.*)\n/$1/) { - $cmd = '/usr/bin/perl'; - } - close(scan); - if (open(PIPE,"exec rsh $host '$cmd' <.x|")) { - sleep(5); - unlink '.x'; - while () { - 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/eg/server b/eg/server deleted file mode 100755 index 49a140a..0000000 --- a/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 () { - print; - print NS; - } -} diff --git a/eg/shmkill b/eg/shmkill deleted file mode 100644 index b91ee6f..0000000 --- a/eg/shmkill +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: shmkill,v $$Revision: 4.1 $$Date: 92/08/07 17:20:45 $ - -# 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 () { - $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/eg/sysvipc/README b/eg/sysvipc/README deleted file mode 100644 index 54094f1..0000000 --- a/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 , - - diff --git a/eg/sysvipc/ipcmsg b/eg/sysvipc/ipcmsg deleted file mode 100644 index 646d8b6..0000000 --- a/eg/sysvipc/ipcmsg +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if $running_under_some_shell; - -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 () { - 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/eg/sysvipc/ipcsem b/eg/sysvipc/ipcsem deleted file mode 100644 index e0dc551..0000000 --- a/eg/sysvipc/ipcsem +++ /dev/null @@ -1,46 +0,0 @@ -#!/usr/bin/perl -eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if $running_under_some_shell; - -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 () { - print "Signalling\n"; - unless (semop($id, pack("sss", 0, 1, 0))) { - die "Can't signal semaphore: $!\n"; - } - } -} -else { - $SIG{'INT'} = $SIG{'QUIT'} = "leave"; - for (;;) { - unless (semop($id, 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/eg/sysvipc/ipcshm b/eg/sysvipc/ipcshm deleted file mode 100644 index ecc1ba4..0000000 --- a/eg/sysvipc/ipcshm +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if $running_under_some_shell; - -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 () { - chop; - unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) { - die "Can't write to shared memory: $!\n"; - } - } -} -else { - $SIG{'INT'} = $SIG{'QUIT'} = "leave"; - for (;;) { - $_ = ; - 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/eg/travesty b/eg/travesty deleted file mode 100644 index 7e6f983..0000000 --- a/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/eg/unuc b/eg/unuc deleted file mode 100755 index ae5c652..0000000 --- a/eg/unuc +++ /dev/null @@ -1,186 +0,0 @@ -#!/usr/bin/perl - -print STDERR "Loading proper nouns...\n"; -open(DICT,"/usr/dict/words") || die "Can't find /usr/dict/words: $!\n"; -while () { - 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 () { - 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/eg/uudecode b/eg/uudecode deleted file mode 100644 index 3b3cb60..0000000 --- a/eg/uudecode +++ /dev/null @@ -1,15 +0,0 @@ -#!/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/eg/van/empty b/eg/van/empty deleted file mode 100644 index d699319..0000000 --- a/eg/van/empty +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: empty,v $$Revision: 4.1 $$Date: 92/08/07 17:20:50 $ - -# 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/eg/van/unvanish b/eg/van/unvanish deleted file mode 100644 index acb1603..0000000 --- a/eg/van/unvanish +++ /dev/null @@ -1,66 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: unvanish,v $$Revision: 4.1 $$Date: 92/08/07 17:20:52 $ - -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 = ; - 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 =~ /^y/i; - } - - $filelist .= $file; $filelist .= ' '; - -} - -do it() if $olddir; diff --git a/eg/van/vanexp b/eg/van/vanexp deleted file mode 100644 index 415b73b..0000000 --- a/eg/van/vanexp +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: vanexp,v $$Revision: 4.1 $$Date: 92/08/07 17:20:53 $ - -# 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/eg/van/vanish b/eg/van/vanish deleted file mode 100644 index 09b9679..0000000 --- a/eg/van/vanish +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl - -# $RCSfile: vanish,v $$Revision: 4.1 $$Date: 92/08/07 17:20:54 $ - -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 =~ /^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/eg/who b/eg/who deleted file mode 100644 index ac15246..0000000 --- a/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; - } -} diff --git a/eg/wrapsuid b/eg/wrapsuid deleted file mode 100755 index 3b1fc6e..0000000 --- a/eg/wrapsuid +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/perl -'di'; -'ig00'; -# -# $Header: wrapsuid,v 1.1 90/08/11 13:51:29 lwall Locked $ -# -# $Log: wrapsuid,v $ -# 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 () { - chop; - $_ .= 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 () { - 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 diff --git a/eg/cgi/RunMeFirst b/lib/CGI/eg/RunMeFirst similarity index 100% rename from eg/cgi/RunMeFirst rename to lib/CGI/eg/RunMeFirst diff --git a/eg/cgi/caution.xbm b/lib/CGI/eg/caution.xbm similarity index 100% rename from eg/cgi/caution.xbm rename to lib/CGI/eg/caution.xbm diff --git a/eg/cgi/clickable_image.cgi b/lib/CGI/eg/clickable_image.cgi similarity index 100% rename from eg/cgi/clickable_image.cgi rename to lib/CGI/eg/clickable_image.cgi diff --git a/eg/cgi/cookie.cgi b/lib/CGI/eg/cookie.cgi similarity index 100% rename from eg/cgi/cookie.cgi rename to lib/CGI/eg/cookie.cgi diff --git a/eg/cgi/crash.cgi b/lib/CGI/eg/crash.cgi similarity index 100% rename from eg/cgi/crash.cgi rename to lib/CGI/eg/crash.cgi diff --git a/eg/cgi/customize.cgi b/lib/CGI/eg/customize.cgi similarity index 100% rename from eg/cgi/customize.cgi rename to lib/CGI/eg/customize.cgi diff --git a/eg/cgi/diff_upload.cgi b/lib/CGI/eg/diff_upload.cgi similarity index 100% rename from eg/cgi/diff_upload.cgi rename to lib/CGI/eg/diff_upload.cgi diff --git a/eg/cgi/dna_small_gif.uu b/lib/CGI/eg/dna_small_gif.uu similarity index 100% rename from eg/cgi/dna_small_gif.uu rename to lib/CGI/eg/dna_small_gif.uu diff --git a/eg/cgi/file_upload.cgi b/lib/CGI/eg/file_upload.cgi similarity index 100% rename from eg/cgi/file_upload.cgi rename to lib/CGI/eg/file_upload.cgi diff --git a/eg/cgi/frameset.cgi b/lib/CGI/eg/frameset.cgi similarity index 100% rename from eg/cgi/frameset.cgi rename to lib/CGI/eg/frameset.cgi diff --git a/eg/cgi/index.html b/lib/CGI/eg/index.html similarity index 100% rename from eg/cgi/index.html rename to lib/CGI/eg/index.html diff --git a/eg/cgi/internal_links.cgi b/lib/CGI/eg/internal_links.cgi similarity index 100% rename from eg/cgi/internal_links.cgi rename to lib/CGI/eg/internal_links.cgi diff --git a/eg/cgi/javascript.cgi b/lib/CGI/eg/javascript.cgi similarity index 100% rename from eg/cgi/javascript.cgi rename to lib/CGI/eg/javascript.cgi diff --git a/eg/cgi/monty.cgi b/lib/CGI/eg/monty.cgi similarity index 100% rename from eg/cgi/monty.cgi rename to lib/CGI/eg/monty.cgi diff --git a/eg/cgi/multiple_forms.cgi b/lib/CGI/eg/multiple_forms.cgi similarity index 100% rename from eg/cgi/multiple_forms.cgi rename to lib/CGI/eg/multiple_forms.cgi diff --git a/eg/cgi/nph-clock.cgi b/lib/CGI/eg/nph-clock.cgi similarity index 100% rename from eg/cgi/nph-clock.cgi rename to lib/CGI/eg/nph-clock.cgi diff --git a/eg/cgi/nph-multipart.cgi b/lib/CGI/eg/nph-multipart.cgi similarity index 100% rename from eg/cgi/nph-multipart.cgi rename to lib/CGI/eg/nph-multipart.cgi diff --git a/eg/cgi/popup.cgi b/lib/CGI/eg/popup.cgi similarity index 100% rename from eg/cgi/popup.cgi rename to lib/CGI/eg/popup.cgi diff --git a/eg/cgi/save_state.cgi b/lib/CGI/eg/save_state.cgi similarity index 100% rename from eg/cgi/save_state.cgi rename to lib/CGI/eg/save_state.cgi diff --git a/eg/cgi/tryit.cgi b/lib/CGI/eg/tryit.cgi similarity index 100% rename from eg/cgi/tryit.cgi rename to lib/CGI/eg/tryit.cgi diff --git a/eg/cgi/wilogo_gif.uu b/lib/CGI/eg/wilogo_gif.uu similarity index 100% rename from eg/cgi/wilogo_gif.uu rename to lib/CGI/eg/wilogo_gif.uu -- 1.8.3.1