summaryrefslogtreecommitdiff
path: root/eg
diff options
context:
space:
mode:
authorLarry Wall <larry@wall.org>1989-10-18 00:00:00 +0000
committerLarry Wall <larry@wall.org>1989-10-18 00:00:00 +0000
commita687059cbaf2c6fdccb5e0fae2aee80ec15625a8 (patch)
tree674c8533b7bd942204f23782934c72f8624dd308 /eg
parent13281fa4f8547e0eb31d1986b865d9b7ec7d0dcc (diff)
downloadperl-a687059cbaf2c6fdccb5e0fae2aee80ec15625a8.tar.gz
perl 3.0: (no announcement message available)perl-3.000
A few of the new features: (18 Oct) * Perl can now handle binary data correctly and has functions to pack and unpack binary structures into arrays or lists. You can now do arbitrary ioctl functions. * You can now pass things to subroutines by reference. * Debugger enhancements. * An array or associative array may now appear in a local() list. * Array values may now be interpolated into strings. * Subroutine names are now distinguished by prefixing with &. You can call subroutines without using do, and without passing any argument list at all. * You can use the new -u switch to cause perl to dump core so that you can run undump and produce a binary executable image. Alternately you can use the "dump" operator after initializing any variables and such. * You can now chop lists. * Perl now uses /bin/csh to do filename globbing, if available. This means that filenames with spaces or other strangenesses work right. * New functions: mkdir and rmdir, getppid, getpgrp and setpgrp, getpriority and setpriority, chroot, ioctl and fcntl, flock, readlink, lstat, rindex, pack and unpack, read, warn, dbmopen and dbmclose, dump, reverse, defined, undef.
Diffstat (limited to 'eg')
-rw-r--r--eg/ADB2
-rw-r--r--eg/changes2
-rw-r--r--eg/down30
-rw-r--r--eg/dus2
-rw-r--r--eg/findcp6
-rw-r--r--eg/findtar4
-rw-r--r--eg/g/gcp4
-rw-r--r--eg/g/gcp.man2
-rw-r--r--eg/g/ged2
-rw-r--r--eg/g/gsh6
-rw-r--r--eg/g/gsh.man2
-rw-r--r--eg/muck141
-rw-r--r--eg/muck.man21
-rw-r--r--eg/myrup6
-rw-r--r--eg/nih2
-rw-r--r--eg/rename13
-rw-r--r--eg/rmfrom2
-rw-r--r--eg/scan/scan_df4
-rw-r--r--eg/scan/scan_last2
-rw-r--r--eg/scan/scan_messages8
-rw-r--r--eg/scan/scan_passwd4
-rw-r--r--eg/scan/scan_ps2
-rw-r--r--eg/scan/scan_sudo8
-rw-r--r--eg/scan/scan_suid4
-rw-r--r--eg/scan/scanner8
-rw-r--r--eg/shmkill6
-rw-r--r--eg/van/empty4
-rw-r--r--eg/van/unvanish4
-rw-r--r--eg/van/vanexp2
-rw-r--r--eg/van/vanish4
-rw-r--r--eg/who13
31 files changed, 269 insertions, 51 deletions
diff --git a/eg/ADB b/eg/ADB
index 1a43b90380..ef54d6d2dd 100644
--- a/eg/ADB
+++ b/eg/ADB
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: ADB,v 2.0 88/06/05 00:16:39 root Exp $
+# $Header: ADB,v 3.0 89/10/18 15:13:04 lwall Locked $
# This script is only useful when used in your crash directory.
diff --git a/eg/changes b/eg/changes
index db9b7b1d53..7cdc4cd3bb 100644
--- a/eg/changes
+++ b/eg/changes
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $Header: changes,v 2.0 88/06/05 00:16:41 root Exp $
+# $Header: changes,v 3.0 89/10/18 15:13:23 lwall Locked $
($dir, $days) = @ARGV;
$dir = '/' if $dir eq '';
diff --git a/eg/down b/eg/down
new file mode 100644
index 0000000000..bbb0d062cb
--- /dev/null
+++ b/eg/down
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+$| = 1;
+if ($#ARGV >= 0) {
+ $cmd = join(' ',@ARGV);
+}
+else {
+ print "Command: ";
+ $cmd = <stdin>;
+ chop($cmd);
+ while ($cmd =~ s/\\$//) {
+ print "+ ";
+ $cmd .= <stdin>;
+ chop($cmd);
+ }
+}
+$cwd = `pwd`; chop($cwd);
+
+open(FIND,'find . -type d -print|') || die "Can't run find";
+
+while (<FIND>) {
+ chop;
+ unless (chdir $_) {
+ print stderr "Can't cd to $_\n";
+ next;
+ }
+ print "\t--> ",$_,"\n";
+ system $cmd;
+ chdir $cwd;
+}
diff --git a/eg/dus b/eg/dus
index 8c7ff94340..3f6e7744f1 100644
--- a/eg/dus
+++ b/eg/dus
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: dus,v 2.0 88/06/05 00:16:44 root Exp $
+# $Header: dus,v 3.0 89/10/18 15:13:43 lwall Locked $
# This script does a du -s on any directories in the current directory that
# are not mount points for another filesystem.
diff --git a/eg/findcp b/eg/findcp
index 57cac2e367..537264ef7c 100644
--- a/eg/findcp
+++ b/eg/findcp
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: findcp,v 2.0 88/06/05 00:16:47 root Exp $
+# $Header: findcp,v 3.0 89/10/18 15:13:47 lwall Locked $
# 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.
@@ -14,7 +14,7 @@ sub copy {
$sourcedir = $ARGV[0];
if ($sourcedir =~ /^\//) {
$ARGV[0] = '.';
- unless (chdir($sourcedir)) { die "Can't find directory: $sourcedir"; }
+ unless (chdir($sourcedir)) { die "Can't find directory $sourcedir: $!"; }
}
$args = join(' ',@ARGV);
@@ -32,7 +32,7 @@ else {
die("No destination specified");
}
-open(find,"find $args |") || die "Can't run find for you.";
+open(find,"find $args |") || die "Can't run find for you: $!";
while (<find>) {
@x = split(' ');
diff --git a/eg/findtar b/eg/findtar
index 8b604b396f..4fdcdad268 100644
--- a/eg/findtar
+++ b/eg/findtar
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: findtar,v 2.0 88/06/05 00:16:49 root Exp $
+# $Header: findtar,v 3.0 89/10/18 15:13:52 lwall Locked $
# 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.
@@ -8,7 +8,7 @@
$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.";
+open(tar,"| /bin/tar cIf - -") || die "Can't run tar for you: $!";
while (<find>) {
@x = split(' ');
diff --git a/eg/g/gcp b/eg/g/gcp
index 6b4a9a79f7..9485772c5f 100644
--- a/eg/g/gcp
+++ b/eg/g/gcp
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: gcp,v 2.0 88/06/05 00:17:02 root Exp $
+# $Header: gcp,v 3.0 89/10/18 15:13:59 lwall Locked $
# Here is a script to do global rcps. See man page.
@@ -98,7 +98,7 @@ line: while (<>) {
if ($remainder) {
chop($remainder);
- open(grem,">.grem") || (printf stderr "Can't create .grem\n");
+ open(grem,">.grem") || (printf stderr "Can't create .grem: $!\n");
print grem 'rem=', $remainder, "\n";
close(grem);
print 'rem=', $remainder, "\n";
diff --git a/eg/g/gcp.man b/eg/g/gcp.man
index 83c5d85ca4..e14534beb8 100644
--- a/eg/g/gcp.man
+++ b/eg/g/gcp.man
@@ -1,4 +1,4 @@
-.\" $Header: gcp.man,v 2.0 88/06/05 00:17:05 root Exp $
+.\" $Header: gcp.man,v 3.0 89/10/18 15:14:09 lwall Locked $
.TH GCP 1C "13 May 1988"
.SH NAME
gcp \- global file copy
diff --git a/eg/g/ged b/eg/g/ged
index bb7c222b3a..ef1867a20d 100644
--- a/eg/g/ged
+++ b/eg/g/ged
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: ged,v 2.0 88/06/05 00:17:08 root Exp $
+# $Header: ged,v 3.0 89/10/18 15:14:22 lwall Locked $
# Does inplace edits on a set of files on a set of machines.
#
diff --git a/eg/g/gsh b/eg/g/gsh
index 50ce1f7b00..b60deb20b7 100644
--- a/eg/g/gsh
+++ b/eg/g/gsh
@@ -1,6 +1,6 @@
#!/bin/perl
-# $Header: gsh,v 2.0 88/06/05 00:17:20 root Exp $
+# $Header: gsh,v 3.0 89/10/18 15:14:36 lwall Locked $
# Do rsh globally--see man page
@@ -85,8 +85,8 @@ line: while (<>) { # for each line of ghosts
}
close(pipe);
} else {
+ print "(Can't execute rsh: $!)\n";
$SIG{'INT'} = 'cont';
- print "(Can't execute rsh.)\n";
}
}
}
@@ -95,7 +95,7 @@ unlink "/tmp/gsh$$" if $dodist;
if ($remainder) {
chop($remainder);
- open(grem,">.grem") || (printf stderr "Can't make a .grem file\n");
+ open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n");
print grem 'rem=', $remainder, "\n";
close(grem);
print 'rem=', $remainder, "\n";
diff --git a/eg/g/gsh.man b/eg/g/gsh.man
index 4522129df0..08bed19978 100644
--- a/eg/g/gsh.man
+++ b/eg/g/gsh.man
@@ -1,4 +1,4 @@
-.\" $Header: gsh.man,v 2.0 88/06/05 00:17:23 root Exp $
+.\" $Header: gsh.man,v 3.0 89/10/18 15:14:42 lwall Locked $
.TH GSH 8 "13 May 1988"
.SH NAME
gsh \- global shell
diff --git a/eg/muck b/eg/muck
new file mode 100644
index 0000000000..873539b10c
--- /dev/null
+++ b/eg/muck
@@ -0,0 +1,141 @@
+#!../perl
+
+$M = '-M';
+$M = '-m' if -d '/usr/uts' && -f '/etc/master';
+
+do 'getopt.pl';
+do Getopt('f');
+
+if ($opt_f) {
+ $makefile = $opt_f;
+}
+elsif (-f 'makefile') {
+ $makefile = 'makefile';
+}
+elsif (-f 'Makefile') {
+ $makefile = 'Makefile';
+}
+else {
+ die "No makefile\n";
+}
+
+$MF = 'mf00';
+
+while(($key,$val) = each(ENV)) {
+ $mac{$key} = $val;
+}
+
+do scan($makefile);
+
+$co = $action{'.c.o'};
+$co = ' ' unless $co;
+
+$missing = "Missing dependencies:\n";
+foreach $key (sort keys(o)) {
+ if ($oc{$key}) {
+ $src = $oc{$key};
+ $action = $action{$key};
+ }
+ else {
+ $action = '';
+ }
+ if (!$action) {
+ if ($co && ($c = $key) =~ s/\.o$/.c/ && -f $c) {
+ $src = $c;
+ $action = $co;
+ }
+ else {
+ print "No source found for $key $c\n";
+ next;
+ }
+ }
+ $I = '';
+ $D = '';
+ $I .= $1 while $action =~ s/(-I\S+\s*)//;
+ $D .= $1 . ' ' while $action =~ s/(-D\w+)//;
+ if ($opt_v) {
+ $cmd = "Checking $key: cc $M $D $I $src";
+ $cmd =~ s/\s\s+/ /g;
+ print stderr $cmd,"\n";
+ }
+ open(CPP,"cc $M $D $I $src|") || die "Can't run C preprocessor: $!";
+ while (<CPP>) {
+ ($name,$dep) = split;
+ $dep =~ s|^\./||;
+ (print $missing,"$key: $dep\n"),($missing='')
+ unless ($dep{"$key: $dep"} += 2) > 2;
+ }
+}
+
+$extra = "\nExtraneous dependencies:\n";
+foreach $key (sort keys(dep)) {
+ if ($key =~ /\.o: .*\.h$/ && $dep{$key} == 1) {
+ print $extra,$key,"\n";
+ $extra = '';
+ }
+}
+
+sub scan {
+ local($makefile) = @_;
+ local($MF) = $MF;
+ print stderr "Analyzing $makefile.\n" if $opt_v;
+ $MF++;
+ open($MF,$makefile) || die "Can't open $makefile: $!";
+ while (<$MF>) {
+ chop;
+ chop($_ = $_ . <$MF>) while s/\\$//;
+ next if /^#/;
+ next if /^$/;
+ s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg;
+ s/\$\((\w+)\)/$mac{$1}/eg;
+ $mac{$1} = $2, next if /^(\w+)\s*=\s*(.*)/;
+ if (/^include\s+(.*)/) {
+ do scan($1);
+ print stderr "Continuing $makefile.\n" if $opt_v;
+ next;
+ }
+ if (/^([^:]+):\s*(.*)/) {
+ $left = $1;
+ $right = $2;
+ if ($right =~ /^([^;]*);(.*)/) {
+ $right = $1;
+ $action = $2;
+ }
+ else {
+ $action = '';
+ }
+ while (<$MF>) {
+ last unless /^\t/;
+ chop;
+ chop($_ = $_ . <$MF>) while s/\\$//;
+ next if /^#/;
+ last if /^$/;
+ s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg;
+ s/\$\((\w+)\)/$mac{$1}/eg;
+ $action .= $_;
+ }
+ foreach $targ (split(' ',$left)) {
+ $targ =~ s|^\./||;
+ foreach $src (split(' ',$right)) {
+ $src =~ s|^\./||;
+ $deplist{$targ} .= ' ' . $src;
+ $dep{"$targ: $src"} = 1;
+ $o{$src} = 1 if $src =~ /\.o$/;
+ $oc{$targ} = $src if $targ =~ /\.o$/ && $src =~ /\.[yc]$/;
+ }
+ $action{$targ} .= $action;
+ }
+ redo if $_;
+ }
+ }
+ close($MF);
+}
+
+sub subst {
+ local($foo,$from,$to) = @_;
+ $foo = $mac{$foo};
+ $from =~ s/\./[.]/;
+ y/a/a/;
+ $foo =~ s/\b$from\b/$to/g;
+ $foo;
+}
diff --git a/eg/muck.man b/eg/muck.man
new file mode 100644
index 0000000000..e4327150fd
--- /dev/null
+++ b/eg/muck.man
@@ -0,0 +1,21 @@
+.\" $Header: muck.man,v 3.0 89/10/18 15:14:55 lwall Locked $
+.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
index c32c99ccd2..f7d64dbd2f 100644
--- a/eg/myrup
+++ b/eg/myrup
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: myrup,v 2.0 88/06/05 00:16:51 root Exp $
+# $Header: myrup,v 3.0 89/10/18 15:15:06 lwall Locked $
# 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
@@ -9,7 +9,7 @@
print "node load (u)\n------- --------\n";
-open(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts";
+open(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts: $!";
line: while (<ghosts>) {
next line if /^#/;
next line if /^$/;
@@ -18,7 +18,7 @@ line: while (<ghosts>) {
$wanted{$host} = 1;
}
-open(ruptime,'ruptime|') || die "Can't run ruptime";
+open(ruptime,'ruptime|') || die "Can't run ruptime: $!";
open(sort,'|sort +1n');
while (<ruptime>) {
diff --git a/eg/nih b/eg/nih
index 15cb60f496..67f25cdddf 100644
--- a/eg/nih
+++ b/eg/nih
@@ -1,7 +1,7 @@
eval "exec /usr/bin/perl -Spi.bak $0 $*"
if $running_under_some_shell;
-# $Header: nih,v 2.0 88/06/05 00:16:54 root Exp $
+# $Header: nih,v 3.0 89/10/18 15:15:12 lwall Locked $
# This script makes #! scripts directly executable on machines that don't
# support #!. It edits in place any scripts mentioned on the command line.
diff --git a/eg/rename b/eg/rename
new file mode 100644
index 0000000000..1708d35def
--- /dev/null
+++ b/eg/rename
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+($op = shift) || die "Usage: rename perlexpr [filenames]\n";
+if ($#ARGV < 0) {
+ @ARGV = <stdin>;
+ chop(@ARGV);
+}
+for (@ARGV) {
+ $was = $_;
+ eval $op;
+ die $@ if $@;
+ rename($was,$_) unless $was eq $_;
+}
diff --git a/eg/rmfrom b/eg/rmfrom
index 0fca30413e..43ce1058ae 100644
--- a/eg/rmfrom
+++ b/eg/rmfrom
@@ -1,6 +1,6 @@
#!/usr/bin/perl -n
-# $Header: rmfrom,v 2.0 88/06/05 00:16:57 root Exp $
+# $Header: rmfrom,v 3.0 89/10/18 15:15:20 lwall Locked $
# A handy (but dangerous) script to put after a find ... -print.
diff --git a/eg/scan/scan_df b/eg/scan/scan_df
index ca316425e4..27ee81af1a 100644
--- a/eg/scan/scan_df
+++ b/eg/scan/scan_df
@@ -1,10 +1,10 @@
#!/usr/bin/perl -P
-# $Header: scan_df,v 2.0 88/06/05 00:17:56 root Exp $
+# $Header: scan_df,v 3.0 89/10/18 15:15:26 lwall Locked $
# This report points out filesystems that are in danger of overflowing.
-(chdir '/usr/adm/private/memories') || die "Can't cd.";
+(chdir '/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
`df >newdf`;
open(Df, 'olddf');
diff --git a/eg/scan/scan_last b/eg/scan/scan_last
index 25d7843e30..65a07fe377 100644
--- a/eg/scan/scan_last
+++ b/eg/scan/scan_last
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $Header: scan_last,v 2.0 88/06/05 00:17:58 root Exp $
+# $Header: scan_last,v 3.0 89/10/18 15:15:31 lwall Locked $
# This reports who was logged on at weird hours
diff --git a/eg/scan/scan_messages b/eg/scan/scan_messages
index 6f8ab2b58b..ae641a9c25 100644
--- a/eg/scan/scan_messages
+++ b/eg/scan/scan_messages
@@ -1,10 +1,10 @@
#!/usr/bin/perl -P
-# $Header: scan_messages,v 2.0 88/06/05 00:17:46 root Exp $
+# $Header: scan_messages,v 3.0 89/10/18 15:15:38 lwall Locked $
# This prints out extraordinary console messages. You'll need to customize.
-chdir('/usr/adm/private/memories') || die "Can't cd.";
+chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
$maxpos = `cat oldmsgs 2>&1`;
@@ -197,12 +197,12 @@ while (<Msgs>) {
}
$max = tell(Msgs);
-open(tmp,'|sort >oldmsgs.tmp') || die "Can't create tmp file.";
+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.";
+open(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n";
while (<tmp>) {
if (/^nd:/) {
next if $seen{$_} < 20;
diff --git a/eg/scan/scan_passwd b/eg/scan/scan_passwd
index 62ef1e7794..f49b1a9d00 100644
--- a/eg/scan/scan_passwd
+++ b/eg/scan/scan_passwd
@@ -1,10 +1,10 @@
#!/usr/bin/perl
-# $Header: scan_passwd,v 2.0 88/06/05 00:17:49 root Exp $
+# $Header: scan_passwd,v 3.0 89/10/18 15:15:43 lwall Locked $
# This scans passwd file for security holes.
-open(Pass,'/etc/passwd') || die "Can't open passwd file";
+open(Pass,'/etc/passwd') || die "Can't open passwd file: $!\n";
# $dotriv = (`date` =~ /^Mon/);
$dotriv = 1;
diff --git a/eg/scan/scan_ps b/eg/scan/scan_ps
index bb33b87ae8..a70f360b9f 100644
--- a/eg/scan/scan_ps
+++ b/eg/scan/scan_ps
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $Header: scan_ps,v 2.0 88/06/05 00:17:51 root Exp $
+# $Header: scan_ps,v 3.0 89/10/18 15:15:47 lwall Locked $
# This looks for looping processes.
diff --git a/eg/scan/scan_sudo b/eg/scan/scan_sudo
index e0a99ee0c3..bfbebe2821 100644
--- a/eg/scan/scan_sudo
+++ b/eg/scan/scan_sudo
@@ -1,10 +1,10 @@
#!/usr/bin/perl -P
-# $Header: scan_sudo,v 2.0 88/06/05 00:18:01 root Exp $
+# $Header: scan_sudo,v 3.0 89/10/18 15:15:52 lwall Locked $
# Analyze the sudo log.
-chdir('/usr/adm/private/memories') || die "Can't cd.";
+chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
if (open(Oldsudo,'oldsudo')) {
$maxpos = <Oldsudo>;
@@ -41,12 +41,12 @@ while (<Sudo>) {
}
$max = tell(Sudo);
-open(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file.";
+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.";
+open(tmp,'oldsudo.tmp') || die "Can't reopen tmp file: $!\n";
while (<tmp>) {
print $seen{$_},":\t",$_;
}
diff --git a/eg/scan/scan_suid b/eg/scan/scan_suid
index 4f62705504..1ebca0bdbe 100644
--- a/eg/scan/scan_suid
+++ b/eg/scan/scan_suid
@@ -1,10 +1,10 @@
#!/usr/bin/perl -P
-# $Header: scan_suid,v 2.0 88/06/05 00:17:54 root Exp $
+# $Header: scan_suid,v 3.0 89/10/18 15:15:57 lwall Locked $
# Look for new setuid root files.
-chdir '/usr/adm/private/memories' || die "Can't cd.";
+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');
diff --git a/eg/scan/scanner b/eg/scan/scanner
index 25e953d402..8ef7fe8f5d 100644
--- a/eg/scan/scanner
+++ b/eg/scan/scanner
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: scanner,v 2.0 88/06/05 00:17:42 root Exp $
+# $Header: scanner,v 3.0 89/10/18 15:16:02 lwall Locked $
# This runs all the scan_* routines on all the machines in /etc/ghosts.
# We run this every morning at about 6 am:
@@ -20,7 +20,7 @@ $| = 1; # command buffering on stdout
print "Subject: bizarre happenings\n\n";
-(chdir '/usr/adm/private') || die "Can't cd.";
+(chdir '/usr/adm/private') || die "Can't cd to /usr/adm/private: $!\n";
if ($#ARGV >= 0) {
@scanlist = @ARGV;
@@ -60,7 +60,7 @@ scan: while ($scan = shift(@scanlist)) {
$iter = 0;
`exec crypt -inquire <$scan >.x 2>/dev/null`;
unless (open(scan,'.x')) {
- print "Can't run $scan.";
+ print "Can't run $scan: $!\n";
next scan;
}
$cmd = <scan>;
@@ -78,7 +78,7 @@ scan: while ($scan = shift(@scanlist)) {
}
close(pipe);
} else {
- print "(Can't execute rsh.)\n";
+ print "(Can't execute rsh: $!)\n";
}
last class;
}
diff --git a/eg/shmkill b/eg/shmkill
index ba288d8e0d..f3d4aecb18 100644
--- a/eg/shmkill
+++ b/eg/shmkill
@@ -1,11 +1,11 @@
#!/usr/bin/perl
-# $Header: shmkill,v 2.0 88/06/05 00:16:59 root Exp $
+# $Header: shmkill,v 3.0 89/10/18 15:16:09 lwall Locked $
# 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";
+open(ipcs,'ipcs -m -o|') || die "Can't run ipcs: $!";
while (<ipcs>) {
$tmp = index($_,'NATTCH');
@@ -13,7 +13,7 @@ while (<ipcs>) {
if (/^m/) {
($m,$id,$key,$mode,$owner,$group,$attach) = split;
if ($attach != substr($_,$pos,6)) {
- die "Different ipcs format--can't parse!";
+ die "Different ipcs format--can't parse!\n";
}
if ($attach == 0) {
push(@goners,'-m',$id);
diff --git a/eg/van/empty b/eg/van/empty
index 11a55583e1..0f3d9e321f 100644
--- a/eg/van/empty
+++ b/eg/van/empty
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: empty,v 2.0 88/06/05 00:17:39 root Exp $
+# $Header: empty,v 3.0 89/10/18 15:16:28 lwall Locked $
# This script empties a trashcan.
@@ -12,7 +12,7 @@ chop($pwd = `pwd`);
dir: foreach $dir (@ARGV) {
unless (chdir $dir) {
- print stderr "Can't find directory $dir\n";
+ print stderr "Can't find directory $dir: $!\n";
next dir;
}
if ($recursive) {
diff --git a/eg/van/unvanish b/eg/van/unvanish
index 4a83c81232..5c0dab07a2 100644
--- a/eg/van/unvanish
+++ b/eg/van/unvanish
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: unvanish,v 2.0 88/06/05 00:17:30 root Exp $
+# $Header: unvanish,v 3.0 89/10/18 15:16:35 lwall Locked $
sub it {
if ($olddir ne '.') {
@@ -18,7 +18,7 @@ sub it {
}
print `mv $startfiles$filelist..$force`;
if ($olddir ne '.') {
- (chdir $pwd) || die "Can't get back to original directory: $pwd";
+ (chdir $pwd) || die "Can't get back to original directory $pwd: $!\n";
}
}
diff --git a/eg/van/vanexp b/eg/van/vanexp
index 29b42e8edf..ef31882e22 100644
--- a/eg/van/vanexp
+++ b/eg/van/vanexp
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: vanexp,v 2.0 88/06/05 00:17:34 root Exp $
+# $Header: vanexp,v 3.0 89/10/18 15:16:41 lwall Locked $
# This is for running from a find at night to expire old .deleteds
diff --git a/eg/van/vanish b/eg/van/vanish
index b665e7c8d9..e49c0528c7 100644
--- a/eg/van/vanish
+++ b/eg/van/vanish
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Header: vanish,v 2.0 88/06/05 00:17:36 root Exp $
+# $Header: vanish,v 3.0 89/10/18 15:16:46 lwall Locked $
sub it {
if ($olddir ne '.') {
@@ -20,7 +20,7 @@ sub it {
print `/bin/mv $startfiles$filelist .deleted$force`;
}
if ($olddir ne '.') {
- (chdir $pwd) || die "Can't get back to original directory: $pwd";
+ (chdir $pwd) || die "Can't get back to original directory $pwd: $!\n";
}
}
diff --git a/eg/who b/eg/who
new file mode 100644
index 0000000000..6543908853
--- /dev/null
+++ b/eg/who
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+# This assumes your /etc/utmp file looks like ours
+open(utmp,'/etc/utmp');
+@mo = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
+while (read(utmp,$utmp,36)) {
+ ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp);
+ if ($name) {
+ $host = "($host)" if $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;
+ }
+}