May be repopulated with fresh maintained examples.
p4raw-id: //depot/perl@6556
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
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
+++ /dev/null
-#!/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";
+++ /dev/null
-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??
+++ /dev/null
-#!/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 (<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);
-}
-
+++ /dev/null
-#!./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; }
+++ /dev/null
-#!/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;
-}
+++ /dev/null
-#!/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 (<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;
+++ /dev/null
-#!/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 (<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();
-}
+++ /dev/null
-#!/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 (<find>) {
- @x = split(' ');
- if ($x[2] =~ /^d/) { print tar '-d ';}
- print tar $x[10],"\n";
-}
+++ /dev/null
-#!/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+";
-}
+++ /dev/null
-.\" $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.
+++ /dev/null
-#!/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 <perlcmds\n" unless $files;
-
-exec "gsh", $class, "-d", "perl -pi.bak - $files";
-
-die "Couldn't execute gsh for some reason, stopped";
+++ /dev/null
-# 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
+++ /dev/null
-#! /usr/bin/perl
-
-# $RCSfile: gsh,v $$Revision: 4.1 $$Date: 92/08/07 17:20:20 $
-
-# 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, $$;
-}
+++ /dev/null
-.\" $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.
+++ /dev/null
-#!../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;
-}
+++ /dev/null
-.\" $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.
+++ /dev/null
-#!/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 (<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;
- }
-}
+++ /dev/null
-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;
+++ /dev/null
-#!/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 = <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
+++ /dev/null
-#!/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 = <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
+++ /dev/null
-#!/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;
+++ /dev/null
-#!/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 (<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');
+++ /dev/null
-#!/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 (<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;
- }
-}
+++ /dev/null
-#!/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 (<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`;
+++ /dev/null
-#!/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 (<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: $_";
- }
- }
-}
+++ /dev/null
-#!/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 (<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
+++ /dev/null
-#!/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 = <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`;
+++ /dev/null
-#!/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 (<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;
-
+++ /dev/null
-#!/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 <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;
- }
- }
- }
-}
+++ /dev/null
-#!./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;
- }
-}
+++ /dev/null
-#!/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 (<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;
+++ /dev/null
-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>
-
-
+++ /dev/null
-#!/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 (<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;
-}
+++ /dev/null
-#!/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 (<STDIN>) {
- 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;
-}
+++ /dev/null
-#!/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 (<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;
-}
+++ /dev/null
-#!/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;
- }
- }
-}
+++ /dev/null
-#!/usr/bin/perl
-
-print STDERR "Loading proper nouns...\n";
-open(DICT,"/usr/dict/words") || die "Can't find /usr/dict/words: $!\n";
-while (<DICT>) {
- if (/^[A-Z]/) {
- chop;
- ($lower = $_) =~ y/A-Z/a-z/;
- $proper{$lower} = $_;
- }
-}
-close DICT;
-print STDERR "Loading exceptions...\n";
-
-$prog = <<'EOT';
-while (<>) {
- next if /[a-z]/;
- y/A-Z/a-z/;
- s/(\w+)/$proper{$1} ? $proper{$1} : $1/eg;
- s/^(\s*)([a-z])/$1 . (($tmp = $2) =~ y:a-z:A-Z:,$tmp)/e;
- s/([-.?!]["']?(\n\s*| \s*)["']?)([a-z])/$1 . (($tmp = $3) =~ y:a-z:A-Z:,$tmp)/eg;
- s/\b([b-df-hj-np-tv-xz]+)\b/(($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg;
- s/([a-z])'([SDT])\b/$1 . "'" . (($tmp = $2) =~ y:A-Z:a-z:,$tmp)/eg;
-EOT
-while (<DATA>) {
- chop;
- next if /^$/;
- next if /^#/;
- if (! /;$/) {
- $foo = $_;
- $foo =~ y/A-Z/a-z/;
- print STDERR "Dup $_\n" if $proper{$foo};
- $foo =~ s/([^\w ])/\\$1/g;
- $foo =~ s/ /(\\s+)/g;
- $foo = "\\b" . $foo if $foo =~ /^\w/; # XXX till patch 9
- $foo .= "\\b" if $foo =~ /\w$/;
- $i = 0;
- ($bar = $_) =~ s/ /'$' . ++$i/eg;
- $_ = "s/$foo/$bar/gi;";
- }
- $prog .= ' ' . $_ . "\n";
-}
-$prog .= "}\ncontinue {\n print;\n}\n";
-
-$/ = '';
-#print $prog;
-eval $prog; die $@ if $@;
-__END__
-A.M.
-Air Force
-Air Force Base
-Air Force Station
-American
-Apr.
-Ariane
-Aug.
-August
-Bureau of Labor Statistics
-CIT
-Caltech
-Cape Canaveral
-Challenger
-China
-Corporation
-Crippen
-Daily News in Brief
-Daniel Quayle
-Dec.
-Discovery
-Edwards
-Endeavour
-Feb.
-Ford Aerospace
-Fri.
-General Dynamics
-George Bush
-Headline News
-HOTOL
-I
-II
-III
-IV
-IX
-Institute of Technology
-JPL
-Jan.
-Jul.
-Jun.
-Kennedy Space Center
-LDEF
-Long Duration Exposure Facility
-Long March
-Mar.
-March
-Martin
-Martin Marietta
-Mercury
-Mon.
-in May
-s/\bmay (\d)/May $1/g;
-s/\boffice of (\w)/'Office of ' . (($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg;
-National Science Foundation
-NASA Select
-New Mexico
-Nov.
-OMB
-Oct.
-Office of Management and Budget
-President
-President Bush
-Richard Truly
-Rocketdyne
-Russian
-Russians
-Sat.
-Sep.
-Soviet
-Soviet Union
-Soviets
-Space Shuttle
-Sun.
-Thu.
-Tue.
-U.S.
-Union of Soviet Socialist Republics
-United States
-VI
-VII
-VIII
-Vice President
-Vice President Quayle
-Wed.
-White Sands
-Kaman Aerospace
-Aerospace Daily
-Aviation Week
-Space Technology
-Washington Post
-Los Angeles Times
-New York Times
-Aerospace Industries Association
-president of
-Johnson Space Center
-Space Services
-Inc.
-Co.
-Hughes Aircraft
-Company
-Orbital Sciences
-Swedish Space
-Arnauld
-Nicogosian
-Magellan
-Galileo
-Mir
-Jet Propulsion Laboratory
-University
-Department of Defense
-Orbital Science
-OMS
-United Press International
-United Press
-UPI
-Associated Press
-AP
-Cable News Network
-Cape York
-Zenit
-SYNCOM
-Eastern
-Western
-Test Range
-Jcsat
-Japanese Satellite Communications
-Defence Ministry
-Defense Ministry
-Skynet
-Fixed Service Structure
-Launch Processing System
-Asiasat
-Launch Control Center
-Earth
-CNES
-Glavkosmos
-Pacific
-Atlantic
+++ /dev/null
-#!/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";
-}
-
+++ /dev/null
-#!/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(' ',@_));
-}
-
+++ /dev/null
-#!/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 = <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;
+++ /dev/null
-#!/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 {} \;`;
-}
+++ /dev/null
-#!/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 <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;
+++ /dev/null
-#!/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;
- }
-}
+++ /dev/null
-#!/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 (<DF>) {
- chop;
- $_ .= <DF> if length($_) < 50;
- @ary = split;
- push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|);
- }
-}
-$fslist = join(' ',@list);
-
-die "Can't find local filesystems" unless $fslist;
-
-open(FIND,
- "find $fslist $xdev -type f \\( -perm -04000 -o -perm -02000 \\) -print|");
-
-while (<FIND>) {
- chop;
- next unless -T;
- print "Fixing ", $_, "\n";
- ($dir,$file) = m|(.*)/(.*)|;
- chdir $dir || die "Can't chdir to $dir";
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat($file);
- die "Can't stat $_" unless $ino;
- chmod $mode & 01777, $file; # wipe out set[ug]id bits
- rename($file,".$file");
- open(C,">.tmp$$.c") || die "Can't write C program for $_";
- $real = "$dir/.$file";
- print C '
-main(argc,argv)
-int argc;
-char **argv;
-{
- execv("' . $real . '",argv);
-}
-';
- close C;
- system '/bin/cc', ".tmp$$.c", '-o', $file;
- die "Can't compile new $_" if $?;
- chmod $mode, $file;
- chown $uid, $gid, $file;
- unlink ".tmp$$.c";
- chdir '/';
-}
-##############################################################################
-
- # These next few lines are legal in both Perl and nroff.
-
-.00; # finish .ig
-
-'di \" finish diversion--previous line must be blank
-.nr nl 0-1 \" fake up transition to first page again
-.nr % 0 \" start at page 1
-'; __END__ ############# From here on it's a standard manual page ############
-.TH SUIDSCRIPT 1 "July 30, 1990"
-.AT 3
-.SH NAME
-wrapsuid \- puts a compiled C wrapper around a setuid or setgid script
-.SH SYNOPSIS
-.B wrapsuid [dirlist]
-.SH DESCRIPTION
-.I Wrapsuid
-creates a small C program to execute a script with setuid or setgid privileges
-without having to set the setuid or setgid bit on the script, which is
-a security problem on many machines.
-Specify the list of directories or files that you wish to process.
-The names must be absolute pathnames.
-With no arguments it will attempt to process all the local directories
-for this machine.
-The scripts to be processed must have the setuid or setgid bit set.
-The wrapsuid program will delete the bits and set them on the wrapper.
-.PP
-Non-superusers may only process their own files.
-.SH ENVIRONMENT
-No environment variables are used.
-.SH FILES
-None.
-.SH AUTHOR
-Larry Wall
-.SH "SEE ALSO"
-.SH DIAGNOSTICS
-.SH BUGS
-.ex
projects / platform / upstream / perl.git / commitdiff