diff options
author | Larry Wall <larry@wall.org> | 1989-10-18 00:00:00 +0000 |
---|---|---|
committer | Larry Wall <larry@wall.org> | 1989-10-18 00:00:00 +0000 |
commit | a687059cbaf2c6fdccb5e0fae2aee80ec15625a8 (patch) | |
tree | 674c8533b7bd942204f23782934c72f8624dd308 /eg | |
parent | 13281fa4f8547e0eb31d1986b865d9b7ec7d0dcc (diff) | |
download | perl-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/ADB | 2 | ||||
-rw-r--r-- | eg/changes | 2 | ||||
-rw-r--r-- | eg/down | 30 | ||||
-rw-r--r-- | eg/dus | 2 | ||||
-rw-r--r-- | eg/findcp | 6 | ||||
-rw-r--r-- | eg/findtar | 4 | ||||
-rw-r--r-- | eg/g/gcp | 4 | ||||
-rw-r--r-- | eg/g/gcp.man | 2 | ||||
-rw-r--r-- | eg/g/ged | 2 | ||||
-rw-r--r-- | eg/g/gsh | 6 | ||||
-rw-r--r-- | eg/g/gsh.man | 2 | ||||
-rw-r--r-- | eg/muck | 141 | ||||
-rw-r--r-- | eg/muck.man | 21 | ||||
-rw-r--r-- | eg/myrup | 6 | ||||
-rw-r--r-- | eg/nih | 2 | ||||
-rw-r--r-- | eg/rename | 13 | ||||
-rw-r--r-- | eg/rmfrom | 2 | ||||
-rw-r--r-- | eg/scan/scan_df | 4 | ||||
-rw-r--r-- | eg/scan/scan_last | 2 | ||||
-rw-r--r-- | eg/scan/scan_messages | 8 | ||||
-rw-r--r-- | eg/scan/scan_passwd | 4 | ||||
-rw-r--r-- | eg/scan/scan_ps | 2 | ||||
-rw-r--r-- | eg/scan/scan_sudo | 8 | ||||
-rw-r--r-- | eg/scan/scan_suid | 4 | ||||
-rw-r--r-- | eg/scan/scanner | 8 | ||||
-rw-r--r-- | eg/shmkill | 6 | ||||
-rw-r--r-- | eg/van/empty | 4 | ||||
-rw-r--r-- | eg/van/unvanish | 4 | ||||
-rw-r--r-- | eg/van/vanexp | 2 | ||||
-rw-r--r-- | eg/van/vanish | 4 | ||||
-rw-r--r-- | eg/who | 13 |
31 files changed, 269 insertions, 51 deletions
@@ -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; +} @@ -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. @@ -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(' '); @@ -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 @@ -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. # @@ -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. @@ -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>) { @@ -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 $_; +} @@ -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; + } +} |