Subject: v20i104: Perl, a language with features of C/sed/awk/shell/etc, Part21/24 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Larry Wall Posting-number: Volume 20, Issue 104 Archive-name: perl3.0/part21 #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 24 through sh. When all 24 kits have been run, read README. echo "This is perl 3.0 kit 21 (of 24). If kit 21 is complete, the line" echo '"'"End of kit 21 (of 24)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir eg eg/g eg/scan lib t x2p 2>/dev/null echo Extracting eg/scan/scan_messages sed >eg/scan/scan_messages <<'!STUFFY!FUNK!' -e 's/X//' X#!/usr/bin/perl -P X X# $Header: scan_messages,v 3.0 89/10/18 15:15:38 lwall Locked $ X X# This prints out extraordinary console messages. You'll need to customize. X Xchdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n"; X X$maxpos = `cat oldmsgs 2>&1`; X X#if defined(mc300) || defined(mc500) || defined(mc700) Xopen(Msgs, '/dev/null') || die "scan_messages: can't open messages"; X#else Xopen(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages"; X#endif X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat(Msgs); X Xif ($size < $maxpos) { # Did somebody truncate messages file? X $maxpos = 0; X} X Xseek(Msgs,$maxpos,0); # Start where we left off last time. X Xwhile () { X s/\[(\d+)\]/#/ && s/$1/#/g; X#ifdef vax X $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//; X next if /root@.*:/; X next if /^vmunix: 4.3 BSD UNIX/; X next if /^vmunix: Copyright/; X next if /^vmunix: avail mem =/; X next if /^vmunix: SBIA0 at /; X next if /^vmunix: disk ra81 is/; X next if /^vmunix: dmf. at uba/; X next if /^vmunix: dmf.:.*asynch/; X next if /^vmunix: ex. at uba/; X next if /^vmunix: ex.: HW/; X next if /^vmunix: il. at uba/; X next if /^vmunix: il.: hardware/; X next if /^vmunix: ra. at uba/; X next if /^vmunix: ra.: media/; X next if /^vmunix: real mem/; X next if /^vmunix: syncing disks/; X next if /^vmunix: tms/; X next if /^vmunix: tmscp. at uba/; X next if /^vmunix: uba. at /; X next if /^vmunix: uda. at /; X next if /^vmunix: uda.: unit . ONLIN/; X next if /^vmunix: .*buffers containing/; X next if /^syslogd: .*newslog/; X#endif X next if /unknown service/; X next if /^\.\.\.$/; X if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) { X $pfx = ''; X next; X } X next if /^[ \t]*$/; X next if /^[ 0-9]*done$/; X if (/^A/) { X next if /^Accounting [sr]/; X } X elsif (/^C/) { X next if /^Called from/; X next if /^Copyright/; X } X elsif (/^E/) { X next if /^End traceback/; X next if /^Ethernet address =/; X } X elsif (/^K/) { X next if /^KERNEL MODE/; X } X elsif (/^R/) { X next if /^Rebooting Unix/; X } X elsif (/^S/) { X next if /^Sun UNIX 4\.2 Release/; X } X elsif (/^W/) { X next if /^WARNING: clock gained/; X } X elsif (/^a/) { X next if /^arg /; X next if /^avail mem =/; X } X elsif (/^b/) { X next if /^bwtwo[0-9] at /; X } X elsif (/^c/) { X next if /^cgone[0-9] at /; X next if /^cdp[0-9] at /; X next if /^csr /; X } X elsif (/^d/) { X next if /^dcpa: init/; X next if /^done$/; X next if /^dts/; X next if /^dump i\/o error/; X next if /^dumping to dev/; X next if /^dump succeeded/; X $pfx = '*' if /^dev = /; X } X elsif (/^e/) { X next if /^end \*\*/; X next if /^error in copy/; X } X elsif (/^f/) { X next if /^found /; X } X elsif (/^i/) { X next if /^ib[0-9] at /; X next if /^ie[0-9] at /; X } X elsif (/^l/) { X next if /^le[0-9] at /; X } X elsif (/^m/) { X next if /^mem = /; X next if /^mt[0-9] at /; X next if /^mti[0-9] at /; X $pfx = '*' if /^mode = /; X } X elsif (/^n/) { X next if /^not found /; X } X elsif (/^p/) { X next if /^page map /; X next if /^pi[0-9] at /; X $pfx = '*' if /^panic/; X } X elsif (/^q/) { X next if /^qqq /; X } X elsif (/^r/) { X next if /^read /; X next if /^revarp: Requesting/; X next if /^root [od]/; X } X elsif (/^s/) { X next if /^sc[0-9] at /; X next if /^sd[0-9] at /; X next if /^sd[0-9]: oldmsgs.tmp') || die "Can't create tmp file: $!\n"; Xwhile ($_ = pop(@seen)) { X print tmp $_; X} Xclose(tmp); Xopen(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n"; Xwhile () { X if (/^nd:/) { X next if $seen{$_} < 20; X } X if (/NFS/) { X next if $seen{$_} < 20; X } X if (/no carrier/) { X next if $seen{$_} < 20; X } X if (/silo overflow/) { X next if $seen{$_} < 20; X } X print $seen{$_},":\t",$_; X} X Xprint `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`; !STUFFY!FUNK! echo Extracting t/op.stat sed >t/op.stat <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.stat,v 3.0 89/10/18 15:31:33 lwall Locked $ X Xprint "1..56\n"; X Xunlink "Op.stat.tmp"; Xopen(foo, ">Op.stat.tmp"); X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat(foo); Xif ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";} Xif ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";} X Xprint foo "Now is the time for all good men to come to.\n"; Xclose(foo); X X$base = time; Xwhile (time == $base) {} X X`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('Op.stat.tmp'); X Xif ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";} Xif ($mtime && $mtime != $ctime) {print "ok 4\n";} else {print "not ok 4\n";} Xprint "#4 :$mtime: != :$ctime:\n"; X X`cp /dev/null Op.stat.tmp`; X Xif (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";} Xif (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";} X X`echo hi >Op.stat.tmp`; Xif (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";} Xif (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";} X Xchmod 0,'Op.stat.tmp'; X$olduid = $>; # can't test -r if uid == 0 Xeval '$> = 1;'; # so switch uid (may not be implemented) Xif (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";} Xif (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";} Xeval '$> = $olduid;'; # switch uid back (may not be implemented) Xif (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";} X Xforeach ((12,13,14,15,16,17)) { X print "ok $_\n"; #deleted tests X} X Xchmod 0700,'Op.stat.tmp'; Xif (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";} Xif (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";} Xif (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";} X Xif (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";} Xif (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";} X Xif (-d '.') {print "ok 23\n";} else {print "not ok 23\n";} Xif (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";} X Xif (`ls -l perl` =~ /^l.*->/) { X if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";} X} Xelse { X print "ok 25\n"; X} X Xif (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";} X Xif (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";} X`rm -f Op.stat.tmp Op.stat.tmp2`; Xif (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} X Xif (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";} Xif (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";} X Xif (! -e '/dev/printer' || -S '/dev/printer') X {print "ok 31\n";} Xelse X {print "not ok 31\n";} Xif (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";} X Xif (! -e '/dev/mt0' || -b '/dev/mt0') X {print "ok 33\n";} Xelse X {print "not ok 33\n";} Xif (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} X X$cnt = $uid = 0; X Xwhile () { X $cnt++; X $uid++ if -u; X last if $uid && $uid < $cnt; X} X X# I suppose this is going to fail somewhere... Xif ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";} X Xunless (open(tty,"/dev/tty")) { X print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n"; X} Xif (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} Xif (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} Xclose(tty); Xif (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} Xopen(null,"/dev/null"); Xif (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";} Xclose(null); Xif (-t) {print "ok 40\n";} else {print "not ok 40\n";} X X# These aren't strictly "stat" calls, but so what? X Xif (-T 'op.stat') {print "ok 41\n";} else {print "not ok 41\n";} Xif (! -B 'op.stat') {print "ok 42\n";} else {print "not ok 42\n";} X Xif (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";} Xif (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";} X Xopen(foo,'op.stat'); Xif (-T foo) {print "ok 45\n";} else {print "not ok 45\n";} Xif (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";} X$_ = ; Xif (/perl/) {print "ok 47\n";} else {print "not ok 47\n";} Xif (-T foo) {print "ok 48\n";} else {print "not ok 48\n";} Xif (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";} Xclose(foo); X Xopen(foo,'op.stat'); X$_ = ; Xif (/perl/) {print "ok 50\n";} else {print "not ok 50\n";} Xif (-T foo) {print "ok 51\n";} else {print "not ok 51\n";} Xif (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";} Xseek(foo,0,0); Xif (-T foo) {print "ok 53\n";} else {print "not ok 53\n";} Xif (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";} Xclose(foo); X Xif (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";} Xif (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";} !STUFFY!FUNK! echo Extracting x2p/hash.c sed >x2p/hash.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: hash.c,v 3.0 89/10/18 15:34:50 lwall Locked $ X * X * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. X * X * $Log: hash.c,v $ X * Revision 3.0 89/10/18 15:34:50 lwall X * 3.0 baseline X * X */ X X#include X#include "EXTERN.h" X#include "handy.h" X#include "util.h" X#include "a2p.h" X XSTR * Xhfetch(tb,key) Xregister HASH *tb; Xchar *key; X{ X register char *s; X register int i; X register int hash; X register HENT *entry; X X if (!tb) X return Nullstr; X for (s=key, i=0, hash = 0; X /* while */ *s; X s++, i++, hash *= 5) { X hash += *s * coeff[i]; X } X entry = tb->tbl_array[hash & tb->tbl_max]; X for (; entry; entry = entry->hent_next) { X if (entry->hent_hash != hash) /* strings can't be equal */ X continue; X if (strNE(entry->hent_key,key)) /* is this it? */ X continue; X return entry->hent_val; X } X return Nullstr; X} X Xbool Xhstore(tb,key,val) Xregister HASH *tb; Xchar *key; XSTR *val; X{ X register char *s; X register int i; X register int hash; X register HENT *entry; X register HENT **oentry; X X if (!tb) X return FALSE; X for (s=key, i=0, hash = 0; X /* while */ *s; X s++, i++, hash *= 5) { X hash += *s * coeff[i]; X } X X oentry = &(tb->tbl_array[hash & tb->tbl_max]); X i = 1; X X for (entry = *oentry; entry; i=0, entry = entry->hent_next) { X if (entry->hent_hash != hash) /* strings can't be equal */ X continue; X if (strNE(entry->hent_key,key)) /* is this it? */ X continue; X safefree((char*)entry->hent_val); X entry->hent_val = val; X return TRUE; X } X entry = (HENT*) safemalloc(sizeof(HENT)); X X entry->hent_key = savestr(key); X entry->hent_val = val; X entry->hent_hash = hash; X entry->hent_next = *oentry; X *oentry = entry; X X if (i) { /* initial entry? */ X tb->tbl_fill++; X if ((tb->tbl_fill * 100 / (tb->tbl_max + 1)) > FILLPCT) X hsplit(tb); X } X X return FALSE; X} X X#ifdef NOTUSED Xbool Xhdelete(tb,key) Xregister HASH *tb; Xchar *key; X{ X register char *s; X register int i; X register int hash; X register HENT *entry; X register HENT **oentry; X X if (!tb) X return FALSE; X for (s=key, i=0, hash = 0; X /* while */ *s; X s++, i++, hash *= 5) { X hash += *s * coeff[i]; X } X X oentry = &(tb->tbl_array[hash & tb->tbl_max]); X entry = *oentry; X i = 1; X for (; entry; i=0, oentry = &entry->hent_next, entry = entry->hent_next) { X if (entry->hent_hash != hash) /* strings can't be equal */ X continue; X if (strNE(entry->hent_key,key)) /* is this it? */ X continue; X safefree((char*)entry->hent_val); X safefree(entry->hent_key); X *oentry = entry->hent_next; X safefree((char*)entry); X if (i) X tb->tbl_fill--; X return TRUE; X } X return FALSE; X} X#endif X Xhsplit(tb) XHASH *tb; X{ X int oldsize = tb->tbl_max + 1; X register int newsize = oldsize * 2; X register int i; X register HENT **a; X register HENT **b; X register HENT *entry; X register HENT **oentry; X X a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*)); X bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */ X tb->tbl_max = --newsize; X tb->tbl_array = a; X X for (i=0; ihent_hash & newsize) != i) { X *oentry = entry->hent_next; X entry->hent_next = *b; X if (!*b) X tb->tbl_fill++; X *b = entry; X continue; X } X else X oentry = &entry->hent_next; X } X if (!*a) /* everything moved */ X tb->tbl_fill--; X } X} X XHASH * Xhnew() X{ X register HASH *tb = (HASH*)safemalloc(sizeof(HASH)); X X tb->tbl_array = (HENT**) safemalloc(8 * sizeof(HENT*)); X tb->tbl_fill = 0; X tb->tbl_max = 7; X hiterinit(tb); /* so each() will start off right */ X bzero((char*)tb->tbl_array, 8 * sizeof(HENT*)); X return tb; X} X X#ifdef NOTUSED Xhshow(tb) Xregister HASH *tb; X{ X fprintf(stderr,"%5d %4d (%2d%%)\n", X tb->tbl_max+1, X tb->tbl_fill, X tb->tbl_fill * 100 / (tb->tbl_max+1)); X} X#endif X Xhiterinit(tb) Xregister HASH *tb; X{ X tb->tbl_riter = -1; X tb->tbl_eiter = Null(HENT*); X return tb->tbl_fill; X} X XHENT * Xhiternext(tb) Xregister HASH *tb; X{ X register HENT *entry; X X entry = tb->tbl_eiter; X do { X if (entry) X entry = entry->hent_next; X if (!entry) { X tb->tbl_riter++; X if (tb->tbl_riter > tb->tbl_max) { X tb->tbl_riter = -1; X break; X } X entry = tb->tbl_array[tb->tbl_riter]; X } X } while (!entry); X X tb->tbl_eiter = entry; X return entry; X} X Xchar * Xhiterkey(entry) Xregister HENT *entry; X{ X return entry->hent_key; X} X XSTR * Xhiterval(entry) Xregister HENT *entry; X{ X return entry->hent_val; X} !STUFFY!FUNK! echo Extracting array.c sed >array.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: array.c,v 3.0 89/10/18 15:08:33 lwall Locked $ X * X * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. X * X * $Log: array.c,v $ X * Revision 3.0 89/10/18 15:08:33 lwall X * 3.0 baseline X * X */ X X#include "EXTERN.h" X#include "perl.h" X XSTR * Xafetch(ar,key,lval) Xregister ARRAY *ar; Xint key; Xint lval; X{ X STR *str; X X if (key < 0 || key > ar->ary_fill) { X if (lval && key >= 0) { X if (ar->ary_flags & ARF_REAL) X str = Str_new(5,0); X else X str = str_static(&str_undef); X (void)astore(ar,key,str); X return str; X } X else X return Nullstr; X } X if (lval && !ar->ary_array[key]) { X str = Str_new(6,0); X (void)astore(ar,key,str); X return str; X } X return ar->ary_array[key]; X} X Xbool Xastore(ar,key,val) Xregister ARRAY *ar; Xint key; XSTR *val; X{ X int retval; X X if (key < 0) X return FALSE; X if (key > ar->ary_max) { X int newmax; X X if (ar->ary_alloc != ar->ary_array) { X retval = ar->ary_array - ar->ary_alloc; X Copy(ar->ary_array, ar->ary_alloc, ar->ary_max+1, STR*); X Zero(ar->ary_alloc+ar->ary_max+1, retval, STR*); X ar->ary_max += retval; X ar->ary_array -= retval; X if (key > ar->ary_max - 10) { X newmax = key + ar->ary_max; X goto resize; X } X } X else { X newmax = key + ar->ary_max / 5; X resize: X Renew(ar->ary_alloc,newmax+1, STR*); X Zero(&ar->ary_alloc[ar->ary_max+1], newmax - ar->ary_max, STR*); X ar->ary_array = ar->ary_alloc; X ar->ary_max = newmax; X } X } X if ((ar->ary_flags & ARF_REAL) && ar->ary_fill < key) { X while (++ar->ary_fill < key) { X if (ar->ary_array[ar->ary_fill] != Nullstr) { X str_free(ar->ary_array[ar->ary_fill]); X ar->ary_array[ar->ary_fill] = Nullstr; X } X } X } X retval = (ar->ary_array[key] != Nullstr); X if (retval && (ar->ary_flags & ARF_REAL)) X str_free(ar->ary_array[key]); X ar->ary_array[key] = val; X return retval; X} X XARRAY * Xanew(stab) XSTAB *stab; X{ X register ARRAY *ar; X X New(1,ar,1,ARRAY); X Newz(2,ar->ary_alloc,5,STR*); X ar->ary_array = ar->ary_alloc; X ar->ary_magic = Str_new(7,0); X str_magic(ar->ary_magic, stab, '#', Nullch, 0); X ar->ary_fill = -1; X ar->ary_index = -1; X ar->ary_max = 4; X ar->ary_flags = ARF_REAL; X return ar; X} X XARRAY * Xafake(stab,size,strp) XSTAB *stab; Xint size; XSTR **strp; X{ X register ARRAY *ar; X X New(3,ar,1,ARRAY); X New(4,ar->ary_alloc,size+1,STR*); X Copy(strp,ar->ary_alloc,size,STR*); X ar->ary_array = ar->ary_alloc; X ar->ary_magic = Str_new(8,0); X str_magic(ar->ary_magic, stab, '#', Nullch, 0); X ar->ary_fill = size - 1; X ar->ary_index = -1; X ar->ary_max = size - 1; X ar->ary_flags = 0; X return ar; X} X Xvoid Xaclear(ar) Xregister ARRAY *ar; X{ X register int key; X X if (!ar || !(ar->ary_flags & ARF_REAL)) X return; X if (key = ar->ary_array - ar->ary_alloc) { X ar->ary_max += key; X ar->ary_array -= key; X } X for (key = 0; key <= ar->ary_max; key++) X str_free(ar->ary_array[key]); X ar->ary_fill = -1; X Zero(ar->ary_array, ar->ary_max+1, STR*); X} X Xvoid Xafree(ar) Xregister ARRAY *ar; X{ X register int key; X X if (!ar) X return; X if (key = ar->ary_array - ar->ary_alloc) { X ar->ary_max += key; X ar->ary_array -= key; X } X if (ar->ary_flags & ARF_REAL) { X for (key = 0; key <= ar->ary_max; key++) X str_free(ar->ary_array[key]); X } X str_free(ar->ary_magic); X Safefree(ar->ary_alloc); X Safefree(ar); X} X Xbool Xapush(ar,val) Xregister ARRAY *ar; XSTR *val; X{ X return astore(ar,++(ar->ary_fill),val); X} X XSTR * Xapop(ar) Xregister ARRAY *ar; X{ X STR *retval; X X if (ar->ary_fill < 0) X return Nullstr; X retval = ar->ary_array[ar->ary_fill]; X ar->ary_array[ar->ary_fill--] = Nullstr; X return retval; X} X Xaunshift(ar,num) Xregister ARRAY *ar; Xregister int num; X{ X register int i; X register STR **sstr,**dstr; X X if (num <= 0) X return; X if (ar->ary_array - ar->ary_alloc >= num) { X ar->ary_max += num; X ar->ary_fill += num; X while (num--) X *--ar->ary_array = Nullstr; X } X else { X (void)astore(ar,ar->ary_fill+num,(STR*)0); /* maybe extend array */ X dstr = ar->ary_array + ar->ary_fill; X sstr = dstr - num; X for (i = ar->ary_fill; i >= 0; i--) { X *dstr-- = *sstr--; X } X Zero(ar->ary_array, num, STR*); X } X} X XSTR * Xashift(ar) Xregister ARRAY *ar; X{ X STR *retval; X X if (ar->ary_fill < 0) X return Nullstr; X retval = *ar->ary_array; X *(ar->ary_array++) = Nullstr; X ar->ary_max--; X ar->ary_fill--; X return retval; X} X Xint Xalen(ar) Xregister ARRAY *ar; X{ X return ar->ary_fill; X} X Xafill(ar, fill) Xregister ARRAY *ar; Xint fill; X{ X if (fill < 0) X fill = -1; X if (fill <= ar->ary_max) X ar->ary_fill = fill; X else X (void)astore(ar,fill,Nullstr); X} !STUFFY!FUNK! echo Extracting makelib.SH sed >makelib.SH <<'!STUFFY!FUNK!' -e 's/X//' Xcase $CONFIG in X'') X if test ! -f config.sh; then X ln ../config.sh . || \ X ln ../../config.sh . || \ X ln ../../../config.sh . || \ X (echo "Can't find config.sh."; exit 1) X fi X . config.sh X ;; Xesac X: This forces SH files to create target in same directory as SH file. X: This is so that make depend always knows where to find SH derivatives. Xcase "$0" in X*/*) cd `expr X$0 : 'X\(.*\)/'` ;; Xesac Xecho "Extracting makelib (with variable substitutions)" X: This section of the file will have variable substitutions done on it. X: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. X: Protect any dollar signs and backticks that you do not want interpreted X: by putting a backslash in front. You may delete these comments. X$spitshell >makelib <>makelib <<'!NO!SUBS!' X Xchdir '/usr/include' || die "Can't cd /usr/include"; X X%isatype = ('char',1,'short',1,'int',1,'long',1); X Xforeach $file (@ARGV) { X print $file,"\n"; X if ($file =~ m|^(.*)/|) { X $dir = $1; X if (!-d "$perlincl/$dir") { X mkdir("$perlincl/$dir",0777); X } X } X open(IN,"$file") || ((warn "Can't open $file: $!\n"),next); X open(OUT,">$perlincl/$file") || die "Can't create $file: $!\n"; X while () { X chop; X while (/\\$/) { X chop; X $_ .= ; X chop; X } X if (s:/\*:\200:g) { X s:\*/:\201:g; X s/\200[^\201]*\201//g; # delete single line comments X if (s/\200.*//) { # begin multi-line comment? X $_ .= '/*'; X $_ .= ; X redo; X } X } X if (s/^#\s*//) { X if (s/^define\s+(\w+)//) { X $name = $1; X $new = ''; X s/\s+$//; X if (s/^\(([\w,\s]*)\)//) { X $args = $1; X if ($args ne '') { X foreach $arg (split(/,\s*/,$args)) { X $curargs{$arg} = 1; X } X $args =~ s/\b(\w)/\$$1/g; X $args = "local($args) = \@_;\n$t "; X } X s/^\s+//; X do expr(); X $new =~ s/(["\\])/\\$1/g; X if ($t ne '') { X $new =~ s/(['\\])/\\$1/g; X print OUT $t, X "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n"; X } X else { X print OUT "sub $name {\n ${args}eval \"$new\";\n}\n"; X } X %curargs = (); X } X else { X s/^\s+//; X do expr(); X $new = 1 if $new eq ''; X if ($t ne '') { X $new =~ s/(['\\])/\\$1/g; X print OUT $t,"eval 'sub $name {",$new,";}';\n"; X } X else { X print OUT $t,"sub $name {",$new,";}\n"; X } X } X } X elsif (/^include <(.*)>/) { X print OUT $t,"do '$1' || die \"Can't include $1: \$!\";\n"; X } X elsif (/^ifdef\s+(\w+)/) { X print OUT $t,"if (defined &$1) {\n"; X $tab += 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X } X elsif (/^ifndef\s+(\w+)/) { X print OUT $t,"if (!defined &$1) {\n"; X $tab += 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X } X elsif (s/^if\s+//) { X $new = ''; X do expr(); X print OUT $t,"if ($new) {\n"; X $tab += 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X } X elsif (s/^elif\s+//) { X $new = ''; X do expr(); X $tab -= 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X print OUT $t,"}\n${t}elsif ($new) {\n"; X $tab += 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X } X elsif (/^else/) { X $tab -= 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X print OUT $t,"}\n${t}else {\n"; X $tab += 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X } X elsif (/^endif/) { X $tab -= 4; X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); X print OUT $t,"}\n"; X } X } X } X print OUT "1;\n"; X} X Xsub expr { X while ($_ ne '') { X s/^(\s+)// && do {$new .= ' '; next;}; X s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;}; X s/^(\d+)// && do {$new .= $1; next;}; X s/^("(\\"|[^"])*")// && do {$new .= $1; next;}; X s/^'((\\"|[^"])*)'// && do { X if ($curargs{$1}) { X $new .= "ord('\$$1')"; X } X else { X $new .= "ord('$1')"; X } X next; X }; X s/^(struct\s+\w+)// && do {$new .= "'$1'"; next;}; X s/^sizeof\s*\(([^)]+)\)/{$1}/ && do { X $new .= '$sizeof'; X next; X }; X s/^([_a-zA-Z]\w*)// && do { X $id = $1; X if ($curargs{$id}) { X $new .= '$' . $id; X } X elsif ($id eq 'defined') { X $new .= 'defined'; X } X elsif (/^\(/) { X s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/; # cheat X $new .= "&$id"; X } X elsif ($isatype{$id}) { X $new .= "'$id'"; X } X else { X $new .= '&' . $id; X } X next; X }; X s/^(.)// && do {$new .= $1; next;}; X } X} X!NO!SUBS! Xchmod 755 makelib X$eunicefix makelib !STUFFY!FUNK! echo Extracting makedepend.SH sed >makedepend.SH <<'!STUFFY!FUNK!' -e 's/X//' Xcase $CONFIG in X'') X if test ! -f config.sh; then X ln ../config.sh . || \ X ln ../../config.sh . || \ X ln ../../../config.sh . || \ X (echo "Can't find config.sh."; exit 1) X fi X . ./config.sh X ;; Xesac Xcase "$0" in X*/*) cd `expr X$0 : 'X\(.*\)/'` ;; Xesac Xecho "Extracting makedepend (with variable substitutions)" X$spitshell >makedepend <>makedepend <<'!NO!SUBS!' X X: the following weeds options from ccflags that are of no interest to cpp Xcase "$ccflags" in X'');; X*) set X $ccflags X ccflags='' X for flag do X case $flag in X -D*|-I*) ccflags="$ccflags $flag";; X esac X done X ;; Xesac X X$cat /dev/null >.deptmp X$rm -f *.c.c c/*.c.c Xif test -f Makefile; then X mf=Makefile Xelse X mf=makefile Xfi Xif test -f $mf; then X defrule=`<$mf sed -n \ X -e '/^\.c\.o:.*;/{' \ X -e 's/\$\*\.c//' \ X -e 's/^[^;]*;[ ]*//p' \ X -e q \ X -e '}' \ X -e '/^\.c\.o: *$/{' \ X -e N \ X -e 's/\$\*\.c//' \ X -e 's/^.*\n[ ]*//p' \ X -e q \ X -e '}'` Xfi Xcase "$defrule" in X'') defrule='$(CC) -c $(CFLAGS)' ;; Xesac X Xmake clist || ($echo "Searching for .c files..."; \ X $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist) Xfor file in `$cat .clist`; do X# for file in `cat /dev/null`; do X case "$file" in X *.c) filebase=`basename $file .c` ;; X *.y) filebase=`basename $file .c` ;; X esac X $echo "Finding dependencies for $filebase.o." X $sed -n <$file >$file.c \ X -e "/^${filebase}_init(/q" \ X -e '/^#/{' \ X -e 's|/\*.*$||' \ X -e 's|\\$||' \ X -e p \ X -e '}' X $cpp -I/usr/local/include -I. $ccflags $file.c | \ X $sed \ X -e '/^# *[0-9]/!d' \ X -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \ X -e 's|: \./|: |' \ X -e 's|\.c\.c|.c|' | \ X $uniq | $sort | $uniq >> .deptmp Xdone X X$sed Makefile.new -e '1,/^# AUTOMATICALLY/!d' X Xmake shlist || ($echo "Searching for .SH files..."; \ X $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist) Xif $test -s .deptmp; then X for file in `cat .shlist`; do X $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \ X /bin/sh $file >> .deptmp X done X $echo "Updating Makefile..." X $echo "# If this runs make out of memory, delete /usr/include lines." \ X >> Makefile.new X $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ X >>Makefile.new Xelse X make hlist || ($echo "Searching for .h files..."; \ X $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist) X $echo "You don't seem to have a proper C preprocessor. Using grep instead." X $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp X $echo "Updating Makefile..." X <.clist $sed -n \ X -e '/\//{' \ X -e 's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p" \ X -e d \ X -e '}' \ X -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new X <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed X <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \ X $sed 's|^[^;]*/||' | \ X $sed -f .hsed >> Makefile.new X <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \ X >> Makefile.new X <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \ X $sed -f .hsed >> Makefile.new X <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \ X >> Makefile.new X for file in `$cat .shlist`; do X $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \ X /bin/sh $file >> Makefile.new X done Xfi X$rm -f Makefile.old X$cp Makefile Makefile.old X$cp Makefile.new Makefile X$rm Makefile.new X$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile X$rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed X X!NO!SUBS! X$eunicefix makedepend Xchmod +x makedepend Xcase `pwd` in X*SH) X $rm -f ../makedepend X ln makedepend ../makedepend X ;; Xesac !STUFFY!FUNK! echo Extracting t/op.subst sed >t/op.subst <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.subst,v 3.0 89/10/18 15:31:43 lwall Locked $ X Xprint "1..42\n"; X X$x = 'foo'; X$_ = "x"; Xs/x/\$x/; Xprint "#1\t:$_: eq :\$x:\n"; Xif ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";} X X$_ = "x"; Xs/x/$x/; Xprint "#2\t:$_: eq :foo:\n"; Xif ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";} X X$_ = "x"; Xs/x/\$x $x/; Xprint "#3\t:$_: eq :\$x foo:\n"; Xif ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";} X X$b = 'cd'; X($a = 'abcdef') =~ s'(b${b}e)'\n$1'; Xprint "#4\t:$1: eq :bcde:\n"; Xprint "#4\t:$a: eq :a\\n\$1f:\n"; Xif ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";} X X$a = 'abacada'; Xif (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx') X {print "ok 5\n";} else {print "not ok 5\n";} X Xif (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx') X {print "ok 6\n";} else {print "not ok 6 $a\n";} X Xif (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx') X {print "ok 7\n";} else {print "not ok 7 $a\n";} X X$_ = 'ABACADA'; Xif (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";} X X$_ = '\\' x 4; Xif (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";} Xs/\\/\\\\/g; Xif ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10\n";} X X$_ = '\/' x 4; Xif (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";} Xs/\//\/\//g; Xif ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";} Xif (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";} X X$_ = 'aaaXXXXbbb'; Xs/^a//; Xprint $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n"; X X$_ = 'aaaXXXXbbb'; Xs/a//; Xprint $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n"; X X$_ = 'aaaXXXXbbb'; Xs/^a/b/; Xprint $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n"; X X$_ = 'aaaXXXXbbb'; Xs/a/b/; Xprint $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n"; X X$_ = 'aaaXXXXbbb'; Xs/aa//; Xprint $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n"; X X$_ = 'aaaXXXXbbb'; Xs/aa/b/; Xprint $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n"; X X$_ = 'aaaXXXXbbb'; Xs/b$//; Xprint $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n"; X X$_ = 'aaaXXXXbbb'; Xs/b//; Xprint $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n"; X X$_ = 'aaaXXXXbbb'; Xs/bb//; Xprint $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n"; X X$_ = 'aaaXXXXbbb'; Xs/aX/y/; Xprint $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n"; X X$_ = 'aaaXXXXbbb'; Xs/Xb/z/; Xprint $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n"; X X$_ = 'aaaXXXXbbb'; Xs/aaX.*Xbb//; Xprint $_ eq 'ab' ? "ok 25\n" : "not ok 25\n"; X X$_ = 'aaaXXXXbbb'; Xs/bb/x/; Xprint $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n"; X X# now for some unoptimized versions of the same. X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/^a//; Xprint $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/a//; Xprint $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/^a/b/; Xprint $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/a/b/; Xprint $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/aa//; Xprint $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/aa/b/; Xprint $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/b$//; Xprint $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/b//; Xprint $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/bb//; Xprint $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/aX/y/; Xprint $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/Xb/z/; Xprint $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/aaX.*Xbb//; Xprint $_ eq 'ab' ? "ok 38\n" : "not ok 38\n"; X X$_ = 'aaaXXXXbbb'; X$x ne $x || s/bb/x/; Xprint $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n"; X X$_ = 'abc123xyz'; Xs/\d+/$&*2/e; # yields 'abc246xyz' Xprint $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n"; Xs/\d+/sprintf("%5d",$&)/e; # yields 'abc 246xyz' Xprint $_ eq 'abc 246xyz' ? "ok 41\n" : "not ok 41\n"; Xs/\w/$& x 2/eg; # yields 'aabbcc 224466xxyyzz' Xprint $_ eq 'aabbcc 224466xxyyzz' ? "ok 42\n" : "not ok 42\n"; !STUFFY!FUNK! echo Extracting cmd.h sed >cmd.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: cmd.h,v 3.0 89/10/18 15:09:15 lwall Locked $ X * X * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. X * X * $Log: cmd.h,v $ X * Revision 3.0 89/10/18 15:09:15 lwall X * 3.0 baseline X * X */ X X#define C_NULL 0 X#define C_IF 1 X#define C_ELSE 2 X#define C_WHILE 3 X#define C_BLOCK 4 X#define C_EXPR 5 X#define C_NEXT 6 X#define C_ELSIF 7 /* temporary--turns into an IF + ELSE */ X#define C_CSWITCH 8 /* created by switch optimization in block_head() */ X#define C_NSWITCH 9 /* likewise */ X X#ifdef DEBUGGING X#ifndef DOINIT Xextern char *cmdname[]; X#else Xchar *cmdname[] = { X "NULL", X "IF", X "ELSE", X "WHILE", X "BLOCK", X "EXPR", X "NEXT", X "ELSIF", X "CSWITCH", X "NSWITCH", X "10" X}; X#endif X#endif /* DEBUGGING */ X X#define CF_OPTIMIZE 077 /* type of optimization */ X#define CF_FIRSTNEG 0100/* conditional is ($register NE 'string') */ X#define CF_NESURE 0200 /* if short doesn't match we're sure */ X#define CF_EQSURE 0400 /* if short does match we're sure */ X#define CF_COND 01000 /* test c_expr as conditional first, if not null. */ X /* Set for everything except do {} while currently */ X#define CF_LOOP 02000 /* loop on the c_expr conditional (loop modifiers) */ X#define CF_INVERT 04000 /* it's an "unless" or an "until" */ X#define CF_ONCE 010000 /* we've already pushed the label on the stack */ X#define CF_FLIP 020000 /* on a match do flipflop */ X#define CF_TERM 040000 /* value of this cmd might be returned */ X X#define CFT_FALSE 0 /* c_expr is always false */ X#define CFT_TRUE 1 /* c_expr is always true */ X#define CFT_REG 2 /* c_expr is a simple register */ X#define CFT_ANCHOR 3 /* c_expr is an anchored search /^.../ */ X#define CFT_STROP 4 /* c_expr is a string comparison */ X#define CFT_SCAN 5 /* c_expr is an unanchored search /.../ */ X#define CFT_GETS 6 /* c_expr is */ X#define CFT_EVAL 7 /* c_expr is not optimized, so call eval() */ X#define CFT_UNFLIP 8 /* 2nd half of range not optimized */ X#define CFT_CHOP 9 /* c_expr is a chop on a register */ X#define CFT_ARRAY 10 /* this is a foreach loop */ X#define CFT_INDGETS 11 /* c_expr is <$variable> */ X#define CFT_NUMOP 12 /* c_expr is a numeric comparison */ X#define CFT_CCLASS 13 /* c_expr must start with one of these characters */ X X#ifdef DEBUGGING X#ifndef DOINIT Xextern char *cmdopt[]; X#else Xchar *cmdopt[] = { X "FALSE", X "TRUE", X "REG", X "ANCHOR", X "STROP", X "SCAN", X "GETS", X "EVAL", X "UNFLIP", X "CHOP", X "ARRAY", X "INDGETS", X "NUMOP", X "CCLASS", X "14" X}; X#endif X#endif /* DEBUGGING */ X Xstruct acmd { X STAB *ac_stab; /* a symbol table entry */ X ARG *ac_expr; /* any associated expression */ X}; X Xstruct ccmd { X CMD *cc_true; /* normal code to do on if and while */ X CMD *cc_alt; /* else cmd ptr or continue code */ X}; X Xstruct scmd { X CMD **sc_next; /* array of pointers to commands */ X short sc_offset; /* first value - 1 */ X short sc_max; /* last value + 1 */ X}; X Xstruct cmd { X CMD *c_next; /* the next command at this level */ X ARG *c_expr; /* conditional expression */ X CMD *c_head; /* head of this command list */ X STR *c_short; /* string to match as shortcut */ X STAB *c_stab; /* a symbol table entry, mostly for fp */ X SPAT *c_spat; /* pattern used by optimization */ X char *c_label; /* label for this construct */ X union ucmd { X struct acmd acmd; /* normal command */ X struct ccmd ccmd; /* compound command */ X struct scmd scmd; /* switch command */ X } ucmd; X short c_slen; /* len of c_short, if not null */ X short c_flags; /* optimization flags--see above */ X char *c_file; /* file the following line # is from */ X line_t c_line; /* line # of this command */ X char c_type; /* what this command does */ X}; X X#define Nullcmd Null(CMD*) X XEXT CMD *main_root INIT(Nullcmd); XEXT CMD *eval_root INIT(Nullcmd); X Xstruct compcmd { X CMD *comp_true; X CMD *comp_alt; X}; X Xvoid opt_arg(); Xvoid evalstatic(); Xint cmd_exec(); !STUFFY!FUNK! echo Extracting ioctl.pl sed >ioctl.pl <<'!STUFFY!FUNK!' -e 's/X//' X$TIOCGSIZE = 0x40087468; X$TIOCSSIZE = 0x80087467; X$IOCPARM_MASK = 0x1fff; X$IOCPARM_MAX = 0x200; X$IOC_VOID = 0x20000000; X$IOC_OUT = 0x40000000; X$IOC_IN = 0x80000000; X$IOC_INOUT = 0xC0000000; X$IOC_DIRMASK = 0xe0000000; X$TIOCGETD = 0x40047400; X$TIOCSETD = 0x80047401; X$TIOCHPCL = 0x20007402; X$TIOCMODG = 0x40047403; X$TIOCMODS = 0x80047404; X$TIOCM_LE = 0001; X$TIOCM_DTR = 0002; X$TIOCM_RTS = 0004; X$TIOCM_ST = 0010; X$TIOCM_SR = 0020; X$TIOCM_CTS = 0040; X$TIOCM_CAR = 0100; X$TIOCM_CD = 0x40; X$TIOCM_RNG = 0200; X$TIOCM_RI = 0x80; X$TIOCM_DSR = 0400; X$TIOCGETP = 0x40067408; X$TIOCSETP = 0x80067409; X$TIOCSETN = 0x8006740A; X$TIOCEXCL = 0x2000740D; X$TIOCNXCL = 0x2000740E; X$TIOCFLUSH = 0x80047410; X$TIOCSETC = 0x80067411; X$TIOCGETC = 0x40067412; X$TANDEM = 0x00000001; X$CBREAK = 0x00000002; X$LCASE = 0x00000004; X$ECHO = 0x00000008; X$CRMOD = 0x00000010; X$RAW = 0x00000020; X$ODDP = 0x00000040; X$EVENP = 0x00000080; X$ANYP = 0x000000c0; X$NLDELAY = 0x00000300; X$NL0 = 0x00000000; X$NL1 = 0x00000100; X$NL2 = 0x00000200; X$NL3 = 0x00000300; X$TBDELAY = 0x00000c00; X$TAB0 = 0x00000000; X$TAB1 = 0x00000400; X$TAB2 = 0x00000800; X$XTABS = 0x00000c00; X$CRDELAY = 0x00003000; X$CR0 = 0x00000000; X$CR1 = 0x00001000; X$CR2 = 0x00002000; X$CR3 = 0x00003000; X$VTDELAY = 0x00004000; X$FF0 = 0x00000000; X$FF1 = 0x00004000; X$BSDELAY = 0x00008000; X$BS0 = 0x00000000; X$BS1 = 0x00008000; X$ALLDELAY = 0xFF00; X$CRTBS = 0x00010000; X$PRTERA = 0x00020000; X$CRTERA = 0x00040000; X$TILDE = 0x00080000; X$MDMBUF = 0x00100000; X$LITOUT = 0x00200000; X$TOSTOP = 0x00400000; X$FLUSHO = 0x00800000; X$NOHANG = 0x01000000; X$L001000 = 0x02000000; X$CRTKIL = 0x04000000; X$PASS8 = 0x08000000; X$CTLECH = 0x10000000; X$PENDIN = 0x20000000; X$DECCTQ = 0x40000000; X$NOFLSH = 0x80000000; X$TIOCLBIS = 0x8004747F; X$TIOCLBIC = 0x8004747E; X$TIOCLSET = 0x8004747D; X$TIOCLGET = 0x4004747C; X$LCRTBS = 0x1; X$LPRTERA = 0x2; X$LCRTERA = 0x4; X$LTILDE = 0x8; X$LMDMBUF = 0x10; X$LLITOUT = 0x20; X$LTOSTOP = 0x40; X$LFLUSHO = 0x80; X$LNOHANG = 0x100; X$LCRTKIL = 0x400; X$LPASS8 = 0x800; X$LCTLECH = 0x1000; X$LPENDIN = 0x2000; X$LDECCTQ = 0x4000; X$LNOFLSH = 0xFFFF8000; X$TIOCSBRK = 0x2000747B; X$TIOCCBRK = 0x2000747A; X$TIOCSDTR = 0x20007479; X$TIOCCDTR = 0x20007478; X$TIOCGPGRP = 0x40047477; X$TIOCSPGRP = 0x80047476; X$TIOCSLTC = 0x80067475; X$TIOCGLTC = 0x40067474; X$TIOCOUTQ = 0x40047473; X$TIOCSTI = 0x80017472; X$TIOCNOTTY = 0x20007471; X$TIOCPKT = 0x80047470; X$TIOCPKT_DATA = 0x00; X$TIOCPKT_FLUSHREAD = 0x01; X$TIOCPKT_FLUSHWRITE = 0x02; X$TIOCPKT_STOP = 0x04; X$TIOCPKT_START = 0x08; X$TIOCPKT_NOSTOP = 0x10; X$TIOCPKT_DOSTOP = 0x20; X$TIOCSTOP = 0x2000746F; X$TIOCSTART = 0x2000746E; X$TIOCMSET = 0x8004746D; X$TIOCMBIS = 0x8004746C; X$TIOCMBIC = 0x8004746B; X$TIOCMGET = 0x4004746A; X$TIOCREMOTE = 0x80047469; X$TIOCGWINSZ = 0x40087468; X$TIOCSWINSZ = 0x80087467; X$TIOCUCNTL = 0x80047466; X$TIOCSSOFTC = 0x80047465; X$TIOCGSOFTC = 0x40047464; X$TIOCSCARR = 0x80047463; X$TIOCWCARR = 0x20007462; X$OTTYDISC = 0; X$NETLDISC = 1; X$NTTYDISC = 2; X$TABLDISC = 3; X$SLIPDISC = 4; X$FIOCLEX = 0x20006601; X$FIONCLEX = 0x20006602; X$FIONREAD = 0x4004667F; X$FIONBIO = 0x8004667E; X$FIOASYNC = 0x8004667D; X$FIOSETOWN = 0x8004667C; X$FIOGETOWN = 0x4004667B; X$SIOCSHIWAT = 0x80047300; X$SIOCGHIWAT = 0x40047301; X$SIOCSLOWAT = 0x80047302; X$SIOCGLOWAT = 0x40047303; X$SIOCATMARK = 0x40047307; X$SIOCSPGRP = 0x80047308; X$SIOCGPGRP = 0x40047309; X$SIOCADDRT = 0x8030720A; X$SIOCDELRT = 0x8030720B; X$SIOCSIFADDR = 0x8020690C; X$SIOCGIFADDR = 0xC020690D; X$SIOCSIFDSTADDR = 0x8020690E; X$SIOCGIFDSTADDR = 0xC020690F; X$SIOCSIFFLAGS = 0x80206910; X$SIOCGIFFLAGS = 0xC0206911; X$SIOCGIFBRDADDR = 0xC0206912; X$SIOCSIFBRDADDR = 0x80206913; X$SIOCGIFCONF = 0xC0086914; X$SIOCGIFNETMASK = 0xC0206915; X$SIOCSIFNETMASK = 0x80206916; X$SIOCGIFMETRIC = 0xC0206917; X$SIOCSIFMETRIC = 0x80206918; X$SIOCSARP = 0x8024691E; X$SIOCGARP = 0xC024691F; X$SIOCDARP = 0x80246920; !STUFFY!FUNK! echo Extracting lib/validate.pl sed >lib/validate.pl <<'!STUFFY!FUNK!' -e 's/X//' X;# $Header: validate.pl,v 3.0 89/10/18 15:20:04 lwall Locked $ X X;# The validate routine takes a single multiline string consisting of X;# lines containing a filename plus a file test to try on it. (The X;# file test may also be a 'cd', causing subsequent relative filenames X;# to be interpreted relative to that directory.) After the file test X;# you may put '|| die' to make it a fatal error if the file test fails. X;# The default is '|| warn'. The file test may optionally have a ! prepended X;# to test for the opposite condition. If you do a cd and then list some X;# relative filenames, you may want to indent them slightly for readability. X;# If you supply your own "die" or "warn" message, you can use $file to X;# interpolate the filename. X X;# Filetests may be bunched: -rwx tests for all of -r, -w and -x. X;# Only the first failed test of the bunch will produce a warning. X X;# The routine returns the number of warnings issued. X X;# Usage: X;# $warnings += do validate(' X;# /vmunix -e || die X;# /boot -e || die X;# /bin cd X;# csh -ex X;# csh !-ug X;# sh -ex X;# sh !-ug X;# /usr -d || warn "What happened to $file?\n" X;# '); X Xsub validate { X local($file,$test,$warnings,$oldwarnings); X foreach $check (split(/\n/,$_[0])) { X next if $check =~ /^#/; X next if $check =~ /^$/; X ($file,$test) = split(' ',$check,2); X if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) { X $testlist = $2; X @testlist = split(//,$testlist); X } X else { X @testlist = ('Z'); X } X $oldwarnings = $warnings; X foreach $one (@testlist) { X $this = $test; X $this =~ s/(-\w\b)/$1 \$file/g; X $this =~ s/-Z/-$one/; X $this .= ' || warn' unless $this =~ /\|\|/; X $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/; X $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g; X eval $this; X last if $warnings > $oldwarnings; X } X } X $warnings; X} X Xsub valmess { X local($disposition,$this) = @_; X $file = $cwd . '/' . $file unless $file =~ m|^/|; X if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) { X $neg = $1; X $tmp = $2; X $tmp eq 'r' && ($mess = "$file is not readable by uid $>."); X $tmp eq 'w' && ($mess = "$file is not writable by uid $>."); X $tmp eq 'x' && ($mess = "$file is not executable by uid $>."); X $tmp eq 'o' && ($mess = "$file is not owned by uid $>."); X $tmp eq 'R' && ($mess = "$file is not readable by you."); X $tmp eq 'W' && ($mess = "$file is not writable by you."); X $tmp eq 'X' && ($mess = "$file is not executable by you."); X $tmp eq 'O' && ($mess = "$file is not owned by you."); X $tmp eq 'e' && ($mess = "$file does not exist."); X $tmp eq 'z' && ($mess = "$file does not have zero size."); X $tmp eq 's' && ($mess = "$file does not have non-zero size."); X $tmp eq 'f' && ($mess = "$file is not a plain file."); X $tmp eq 'd' && ($mess = "$file is not a directory."); X $tmp eq 'l' && ($mess = "$file is not a symbolic link."); X $tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO)."); X $tmp eq 'S' && ($mess = "$file is not a socket."); X $tmp eq 'b' && ($mess = "$file is not a block special file."); X $tmp eq 'c' && ($mess = "$file is not a character special file."); X $tmp eq 'u' && ($mess = "$file does not have the setuid bit set."); X $tmp eq 'g' && ($mess = "$file does not have the setgid bit set."); X $tmp eq 'k' && ($mess = "$file does not have the sticky bit set."); X $tmp eq 'T' && ($mess = "$file is not a text file."); X $tmp eq 'B' && ($mess = "$file is not a binary file."); X if ($neg eq '!') { X $mess =~ s/ is not / should not be / || X $mess =~ s/ does not / should not / || X $mess =~ s/ not / /; X } X print stderr $mess,"\n"; X } X else { X $this =~ s/\$file/'$file'/g; X print stderr "Can't do $this.\n"; X } X if ($disposition eq 'die') { exit 1; } X ++$warnings; X} X X1; !STUFFY!FUNK! echo Extracting eg/g/gsh.man sed >eg/g/gsh.man <<'!STUFFY!FUNK!' -e 's/X//' X.\" $Header: gsh.man,v 3.0 89/10/18 15:14:42 lwall Locked $ X.TH GSH 8 "13 May 1988" X.SH NAME Xgsh \- global shell X.SH SYNOPSIS X.B gsh X[options] X.I host X[options] X.I command X.SH DESCRIPTION X.I gsh Xworks just like rsh(1C) except that you may specify a set of hosts to execute Xthe command on. XThe host sets are defined in the file /etc/ghosts. X(An individual host name can be used as a set containing one member.) XYou can give a command like X X gsh sun /etc/mungmotd X Xto run /etc/mungmotd on all your Suns. X.P XYou may specify the union of two or more sets by using + as follows: X X gsh 750+mc /etc/mungmotd X Xwhich will run mungmotd on all 750's and Masscomps. X.P XCommonly used sets should be defined in /etc/ghosts. XFor example, you could add a line that says X X pep=manny+moe+jack X XAnother way to do that would be to add the word "pep" after each of the host Xentries: X X manny sun3 pep X.br X moe sun3 pep X.br X jack sun3 pep X XHosts and sets of host can also be excluded: X X foo=sun-sun2 X XAny host so excluded will never be included, even if a subsequent set on the Xline includes it: X X foo=abc+def X bar=xyz-abc+foo X Xcomes out to xyz+def. X XYou can define private host sets by creating .ghosts in your current directory Xwith entries just like /etc/ghosts. XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts Xfrom the last gsh or gcp that didn't succeed everywhere. X XOptions include all those defined by rsh, as well as X X.IP "\-d" 8 XCauses gsh to collect input till end of file, and then distribute that input Xto each invokation of rsh. X.IP "\-h" 8 XRather than print out the command followed by the output, merely prepends the Xhost name to each line of output. X.IP "\-s" 8 XDo work silently. X.PP XInterrupting with a SIGINT will cause the rsh to the current host to be skipped Xand execution resumed with the next host. XTo stop completely, send a SIGQUIT. X.SH SEE ALSO Xrsh(1C) X.SH BUGS XAll the bugs of rsh, since it calls rsh. X XAlso, will not properly return data from the remote execution that contains Xnull characters. !STUFFY!FUNK! echo "" echo "End of kit 21 (of 24)" cat /dev/null >kit21isdone run='' config='' for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do if test -f kit${iskit}isdone; then run="$run $iskit" else todo="$todo $iskit" fi done case $todo in '') echo "You have run all your kits. Please read README and then type Configure." chmod 755 Configure ;; *) echo "You have run$run." echo "You still need to run$todo." ;; esac : Someone might mail this, so... exit