lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (01/12/91)
System: perl version 3.0 Patch #: 44 Priority: Subject: patch #42, continued Description: See patch #42. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: mv config.sh config.sh.old Configure -d make depend make make test make install If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 43 1c1 < #define PATCHLEVEL 43 --- > #define PATCHLEVEL 44 Index: perl_man.1 Prereq: 3.0.1.10 *** perl_man.1.old Fri Jan 11 18:43:41 1991 --- perl_man.1 Fri Jan 11 18:43:48 1991 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl_man.1,v 3.0.1.10 90/11/10 01:45:16 lwall Locked $ ''' ''' $Log: perl_man.1,v $ ''' Revision 3.0.1.10 90/11/10 01:45:16 lwall ''' patch38: random cleanup ''' --- 1,10 ---- .rn '' }` ! ''' $Header: perl_man.1,v 3.0.1.11 91/01/11 18:15:46 lwall Locked $ ''' ''' $Log: perl_man.1,v $ + ''' Revision 3.0.1.11 91/01/11 18:15:46 lwall + ''' patch42: added -0 option + ''' ''' Revision 3.0.1.10 90/11/10 01:45:16 lwall ''' patch38: random cleanup ''' *************** *** 179,184 **** --- 182,203 ---- .fi Options include: + .TP 5 + .BI \-0 digits + specifies the record separator ($/) as an octal number. + If there are no digits, the null character is the separator. + Other switches may precede or follow the digits. + For example, if you have a version of + .I find + which can print filenames terminated by the null character, you can say this: + .nf + + find . \-name '*.bak' \-print0 | perl \-n0e unlink + + .fi + The special value 00 will cause Perl to slurp files in paragraph mode. + The value 0777 will cause Perl to slurp files whole since there is no + legal character with that value. .TP 5 .B \-a turns on autosplit mode when used with a Index: perl_man.2 Prereq: 3.0.1.10 *** perl_man.2.old Fri Jan 11 18:44:04 1991 --- perl_man.2 Fri Jan 11 18:44:11 1991 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl_man.2,v 3.0.1.10 90/11/10 01:46:29 lwall Locked $ ''' ''' $Log: perl_man.2,v $ ''' Revision 3.0.1.10 90/11/10 01:46:29 lwall ''' patch38: random cleanup ''' patch38: added alarm function --- 1,10 ---- ''' Beginning of part 2 ! ''' $Header: perl_man.2,v 3.0.1.11 91/01/11 18:17:08 lwall Locked $ ''' ''' $Log: perl_man.2,v $ + ''' Revision 3.0.1.11 91/01/11 18:17:08 lwall + ''' patch42: fixed some man page entries + ''' ''' Revision 3.0.1.10 90/11/10 01:46:29 lwall ''' patch38: random cleanup ''' patch38: added alarm function *************** *** 88,95 **** timer, and an argument of 0 may be supplied to cancel the previous timer without starting a new one. The returned value is the amount of time remaining on the previous timer. ! .Ip "atan2(X,Y)" 8 2 ! Returns the arctangent of X/Y in the range .if t \-\(*p to \(*p. .if n \-PI to PI. .Ip "bind(SOCKET,NAME)" 8 2 --- 91,98 ---- timer, and an argument of 0 may be supplied to cancel the previous timer without starting a new one. The returned value is the amount of time remaining on the previous timer. ! .Ip "atan2(Y,X)" 8 2 ! Returns the arctangent of Y/X in the range .if t \-\(*p to \(*p. .if n \-PI to PI. .Ip "bind(SOCKET,NAME)" 8 2 *************** *** 653,658 **** --- 656,662 ---- .Ip "flock(FILEHANDLE,OPERATION)" 8 4 Calls flock(2) on FILEHANDLE. See manual page for flock(2) for definition of OPERATION. + Returns true for success, false on failure. Will produce a fatal error if used on a machine that doesn't implement flock(2). Here's a mailbox appender for BSD systems. *************** *** 957,963 **** @keys = keys %ENV; @values = values %ENV; while ($#keys >= 0) { ! print pop(keys), \'=\', pop(values), "\en"; } or how about sorted by key: --- 961,967 ---- @keys = keys %ENV; @values = values %ENV; while ($#keys >= 0) { ! print pop(@keys), \'=\', pop(@values), "\en"; } or how about sorted by key: Index: perl_man.3 Prereq: 3.0.1.11 *** perl_man.3.old Fri Jan 11 18:44:31 1991 --- perl_man.3 Fri Jan 11 18:44:40 1991 *************** *** 1,7 **** ''' Beginning of part 3 ! ''' $Header: perl_man.3,v 3.0.1.11 90/11/10 01:48:21 lwall Locked $ ''' ''' $Log: perl_man.3,v $ ''' Revision 3.0.1.11 90/11/10 01:48:21 lwall ''' patch38: random cleanup ''' patch38: documented tr///cds --- 1,10 ---- ''' Beginning of part 3 ! ''' $Header: perl_man.3,v 3.0.1.12 91/01/11 18:18:15 lwall Locked $ ''' ''' $Log: perl_man.3,v $ + ''' Revision 3.0.1.12 91/01/11 18:18:15 lwall + ''' patch42: added binary and hex pack/unpack options + ''' ''' Revision 3.0.1.11 90/11/10 01:48:21 lwall ''' patch38: random cleanup ''' patch38: documented tr///cds *************** *** 291,301 **** X Back up a byte. @ Null fill to absolute position. u A uuencoded string. .fi Each letter may optionally be followed by a number which gives a repeat count. ! With all types except "a" and "A" the pack function will gobble up that many values from the LIST. A * for the repeat count means to use however many items are left. The "a" and "A" types gobble just one value, but pack it as a string of length --- 294,309 ---- X Back up a byte. @ Null fill to absolute position. u A uuencoded string. + b A bit string (ascending bit order, like vec()). + B A bit string (descending bit order). + h A hex string (low nybble first). + H A hex string (high nybble first). .fi Each letter may optionally be followed by a number which gives a repeat count. ! With all types except "a", "A", "b", "B", "h" and "H", ! the pack function will gobble up that many values from the LIST. A * for the repeat count means to use however many items are left. The "a" and "A" types gobble just one value, but pack it as a string of length *************** *** 302,307 **** --- 310,317 ---- count, padding with nulls or spaces as necessary. (When unpacking, "A" strips trailing spaces and nulls, but "a" does not.) + Likewise, the "b" and "B" fields pack a string that many bits long. + The "h" and "H" fields pack a string that many nybbles long. Real numbers (floats and doubles) are in the native machine format only; due to the multiplicity of floating formats around, and the lack of a standard \*(L"network\*(R" representation, no facility for *************** *** 342,347 **** --- 352,360 ---- $foo = pack("i9pl", gmtime); # a real struct tm (on my system anyway) + sub bintodec { + unpack("N", pack("B32", substr("0" x 32 . shift, -32))); + } .fi The same template may generally also be used in the unpack function. .Ip "pipe(READHANDLE,WRITEHANDLE)" 8 3 *************** *** 1358,1363 **** --- 1371,1385 ---- strings. This interpretation is not enabled unless there is at least one vec() in your program, to protect older programs. + .Sp + To transform a bit vector into a string or array of 0's and 1's, use these: + .nf + + $bits = unpack("b*", $vector); + @bits = split(//, unpack("b*", $vector)); + + .fi + If you know the exact length in bits, it can be used in place of the *. .Ip "wait" 8 6 Waits for a child process to terminate and returns the pid of the deceased process, or -1 if there are no child processes. Index: perl_man.4 Prereq: 3.0.1.13 *** perl_man.4.old Fri Jan 11 18:45:07 1991 --- perl_man.4 Fri Jan 11 18:45:18 1991 *************** *** 1,7 **** ''' Beginning of part 4 ! ''' $Header: perl_man.4,v 3.0.1.13 90/11/10 01:51:00 lwall Locked $ ''' ''' $Log: perl_man.4,v $ ''' Revision 3.0.1.13 90/11/10 01:51:00 lwall ''' patch38: random cleanup ''' --- 1,10 ---- ''' Beginning of part 4 ! ''' $Header: perl_man.4,v 3.0.1.14 91/01/11 18:18:53 lwall Locked $ ''' ''' $Log: perl_man.4,v $ + ''' Revision 3.0.1.14 91/01/11 18:18:53 lwall + ''' patch42: started an addendum and errata section in the man page + ''' ''' Revision 3.0.1.13 90/11/10 01:51:00 lwall ''' patch38: random cleanup ''' *************** *** 407,412 **** --- 410,416 ---- right justification, or centering. As an alternate form of right justification, you may also use # characters (with an optional .) to specify a numeric field. + (Use of ^ instead of @ causes the field to be blanked if undefined.) If any of the values supplied for these fields contains a newline, only the text up to the newline is printed. The special field @* can be used for printing multi-line values. *************** *** 1556,1561 **** --- 1560,1577 ---- The arguments are available via @ARGV, not $1, $2, etc. .Ip * 4 2 The environment is not automatically made available as variables. + .SH ERRATA\0AND\0ADDENDA + The Perl book, + .I Programming\0Perl , + has the following omissions and goofs. + .PP + The + .B \-0 + switch was added to Perl after the book went to press. + .PP + The new @###.## format was omitted accidentally. + .PP + It wasn't known at press time that s///ee caused multiple evaluations. .SH BUGS .PP .I Perl Index: lib/perldb.pl Prereq: 3.0.1.5 *** lib/perldb.pl.old Fri Jan 11 18:42:32 1991 --- lib/perldb.pl Fri Jan 11 18:42:35 1991 *************** *** 1,6 **** package DB; ! $header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. --- 1,6 ---- package DB; ! $header = '$Header: perldb.pl,v 3.0.1.6 91/01/11 18:08:58 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. *************** *** 10,15 **** --- 10,18 ---- # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. # # $Log: perldb.pl,v $ + # Revision 3.0.1.6 91/01/11 18:08:58 lwall + # patch42: @_ couldn't be accessed from debugger + # # Revision 3.0.1.5 90/11/10 01:40:26 lwall # patch38: the debugger wouldn't stop correctly or do action routines # *************** *** 62,68 **** $signal |= 1; } else { ! &eval("\$DB'signal |= do {$stop;}"); $dbline{$line} =~ s/;9($|\0)/$1/; } } --- 65,71 ---- $signal |= 1; } else { ! $evalarg = "\$DB'signal |= do {$stop;}"; &eval; $dbline{$line} =~ s/;9($|\0)/$1/; } } *************** *** 74,82 **** print OUT "$sub($filename:$i):\t",$dbline[$i]; } } ! &eval($action) if $action; if ($single || $signal) { ! &eval($pre) if $pre; print OUT $#stack . " levels deep in subroutine calls!\n" if $single & 4; $start = $line; --- 77,85 ---- print OUT "$sub($filename:$i):\t",$dbline[$i]; } } ! $evalarg = $action, &eval if $action; if ($single || $signal) { ! $evalarg = $pre, &eval if $pre; print OUT $#stack . " levels deep in subroutine calls!\n" if $single & 4; $start = $line; *************** *** 452,462 **** }; }; next; }; ! &eval($cmd); print OUT "\n"; } if ($post) { ! &eval($post); } } ($@, $!, $[, $,, $/, $\) = @saved; --- 455,465 ---- }; }; next; }; ! $evalarg = $cmd; &eval; print OUT "\n"; } if ($post) { ! $evalarg = $post; &eval; } } ($@, $!, $[, $,, $/, $\) = @saved; *************** *** 467,474 **** $[ = 0; $, = ""; $/ = "\n"; $\ = ""; } sub eval { ! eval "$usercontext $_[0]; &DB'save"; print OUT $@; } --- 470,479 ---- $[ = 0; $, = ""; $/ = "\n"; $\ = ""; } + # The following takes its argument via $evalarg to preserve current @_ + sub eval { ! eval "$usercontext $evalarg; &DB'save"; print OUT $@; } Index: perly.c Prereq: 3.0.1.9 *** perly.c.old Fri Jan 11 18:45:32 1991 --- perly.c Fri Jan 11 18:45:37 1991 *************** *** 1,4 **** ! char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! char rcsid[] = "$Header: perly.c,v 3.0.1.10 91/01/11 18:22:48 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perly.c,v $ + * Revision 3.0.1.10 91/01/11 18:22:48 lwall + * patch42: added -0 option + * patch42: ANSIfied the stat mode checking + * patch42: executables for multiple versions may now coexist + * * Revision 3.0.1.9 90/11/10 01:53:26 lwall * patch38: random cleanup * patch38: more msdos/os2 upgrades *************** *** 82,87 **** --- 87,93 ---- static char* cddir; extern char **environ; static bool minus_c; + static char patchlevel[6]; main(argc,argv,env) register int argc; *************** *** 110,115 **** --- 116,122 ---- euid = (int)geteuid(); gid = (int)getgid(); egid = (int)getegid(); + sprintf(patchlevel,"%3.3s%2.2d", rcsid+19, PATCHLEVEL); #ifdef MSDOS /* * There is no way we can refer to them from Perl so close them to save *************** *** 147,152 **** --- 154,160 ---- s = argv[0]+1; reswitch: switch (*s) { + case '0': case 'a': case 'c': case 'd': *************** *** 287,294 **** #endif if (stat(tokenbuf,&statbuf) < 0) /* not there? */ continue; ! if ((statbuf.st_mode & S_IFMT) == S_IFREG ! && cando(S_IREAD,TRUE,&statbuf) && cando(S_IEXEC,TRUE,&statbuf)) { xfound = tokenbuf; /* bingo! */ break; } --- 295,302 ---- #endif if (stat(tokenbuf,&statbuf) < 0) /* not there? */ continue; ! if (S_ISREG(statbuf.st_mode) ! && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) { xfound = tokenbuf; /* bingo! */ break; } *************** *** 303,309 **** } fdpid = anew(Nullstab); /* for remembering popen pids by fd */ ! pidstatus = hnew(Nullstab); /* for remembering status of dead pids */ origfilename = savestr(argv[0]); curcmd->c_filestab = fstab(origfilename); --- 311,317 ---- } fdpid = anew(Nullstab); /* for remembering popen pids by fd */ ! pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */ origfilename = savestr(argv[0]); curcmd->c_filestab = fstab(origfilename); *************** *** 360,366 **** #ifndef IAMSUID /* in case script is not readable before setuid */ if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { ! (void)sprintf(buf, "%s/%s", BIN, "suidperl"); execv(buf, origargv); /* try again */ fatal("Can't do setuid\n"); } --- 368,374 ---- #ifndef IAMSUID /* in case script is not readable before setuid */ if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { ! (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel); execv(buf, origargv); /* try again */ fatal("Can't do setuid\n"); } *************** *** 378,389 **** * in perl will not fix that problem, but if you have disabled setuid * scripts in the kernel, this will attempt to emulate setuid and setgid * on scripts that have those now-otherwise-useless bits set. The setuid ! * root version must be called suidperl. If regular perl discovers that ! * it has opened a setuid script, it calls suidperl with the same argv ! * that it had. If suidperl finds that the script it has just opened ! * is NOT setuid root, it sets the effective uid back to the uid. We ! * don't just make perl setuid root because that loses the effective ! * uid we had before invoking perl, if it was different from the uid. * * DOSUID must be defined in both perl and suidperl, and IAMSUID must * be defined in suidperl only. suidperl must be setuid root. The --- 386,398 ---- * in perl will not fix that problem, but if you have disabled setuid * scripts in the kernel, this will attempt to emulate setuid and setgid * on scripts that have those now-otherwise-useless bits set. The setuid ! * root version must be called suidperl or sperlN.NNN. If regular perl ! * discovers that it has opened a setuid script, it calls suidperl with ! * the same argv that it had. If suidperl finds that the script it has ! * just opened is NOT setuid root, it sets the effective uid back to the ! * uid. We don't just make perl setuid root because that loses the ! * effective uid we had before invoking perl, if it was different from the ! * uid. * * DOSUID must be defined in both perl and suidperl, and IAMSUID must * be defined in suidperl only. suidperl must be setuid root. The *************** *** 394,400 **** * on these set-id scripts, but don't want to have the overhead of * them in normal perl, and can't use suidperl because it will lose * the effective uid info, so we have an additional non-setuid root ! * version called taintperl that just does the TAINT checks. */ #ifdef DOSUID --- 403,409 ---- * on these set-id scripts, but don't want to have the overhead of * them in normal perl, and can't use suidperl because it will lose * the effective uid info, so we have an additional non-setuid root ! * version called taintperl or tperlN.NNN that just does the TAINT checks. */ #ifdef DOSUID *************** *** 445,459 **** } if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid) fatal("Can't reswap uid and euid"); ! if (!cando(S_IEXEC,FALSE,&statbuf)) /* can real uid exec? */ fatal("Permission denied\n"); } #endif /* SETREUID */ #endif /* IAMSUID */ ! if ((statbuf.st_mode & S_IFMT) != S_IFREG) fatal("Permission denied"); ! if ((statbuf.st_mode >> 6) & S_IWRITE) fatal("Setuid/gid script is writable by world"); doswitches = FALSE; /* -s is insecure in suid */ curcmd->c_line++; --- 454,468 ---- } if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid) fatal("Can't reswap uid and euid"); ! if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */ fatal("Permission denied\n"); } #endif /* SETREUID */ #endif /* IAMSUID */ ! if (!S_ISREG(statbuf.st_mode)) fatal("Permission denied"); ! if (statbuf.st_mode & S_IWOTH) fatal("Setuid/gid script is writable by world"); doswitches = FALSE; /* -s is insecure in suid */ curcmd->c_line++; *************** *** 463,469 **** s = tokenbuf+2; if (*s == ' ') s++; while (!isspace(*s)) s++; ! if (strnNE(s-4,"perl",4)) /* sanity check */ fatal("Not a perl script"); while (*s == ' ' || *s == '\t') s++; /* --- 472,478 ---- s = tokenbuf+2; if (*s == ' ') s++; while (!isspace(*s)) s++; ! if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */ fatal("Not a perl script"); while (*s == ' ' || *s == '\t') s++; /* *************** *** 487,493 **** if (euid) { /* oops, we're not the setuid root perl */ (void)fclose(rsfp); #ifndef IAMSUID ! (void)sprintf(buf, "%s/%s", BIN, "suidperl"); execv(buf, origargv); /* try again */ #endif fatal("Can't do setuid\n"); --- 496,502 ---- if (euid) { /* oops, we're not the setuid root perl */ (void)fclose(rsfp); #ifndef IAMSUID ! (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel); execv(buf, origargv); /* try again */ #endif fatal("Can't do setuid\n"); *************** *** 529,535 **** euid = (int)geteuid(); gid = (int)getgid(); egid = (int)getegid(); ! if (!cando(S_IEXEC,TRUE,&statbuf)) fatal("Permission denied\n"); /* they can't do this */ } #ifdef IAMSUID --- 538,544 ---- euid = (int)geteuid(); gid = (int)getgid(); egid = (int)getegid(); ! if (!cando(S_IXUSR,TRUE,&statbuf)) fatal("Permission denied\n"); /* they can't do this */ } #ifdef IAMSUID *************** *** 542,548 **** /* script has a wrapper--can't run suidperl or we lose euid */ else if (euid != uid || egid != gid) { (void)fclose(rsfp); ! (void)sprintf(buf, "%s/%s", BIN, "taintperl"); execv(buf, origargv); /* try again */ fatal("Can't run setuid script with taint checks"); } --- 551,557 ---- /* script has a wrapper--can't run suidperl or we lose euid */ else if (euid != uid || egid != gid) { (void)fclose(rsfp); ! (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel); execv(buf, origargv); /* try again */ fatal("Can't run setuid script with taint checks"); } *************** *** 563,569 **** #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */ /* not set-id, must be wrapped */ (void)fclose(rsfp); ! (void)sprintf(buf, "%s/%s", BIN, "taintperl"); execv(buf, origargv); /* try again */ fatal("Can't run setuid script with taint checks"); } --- 572,578 ---- #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */ /* not set-id, must be wrapped */ (void)fclose(rsfp); ! (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel); execv(buf, origargv); /* try again */ fatal("Can't run setuid script with taint checks"); } *************** *** 677,685 **** if (tmpstab = stabent("]",allstabs)) { str = STAB_STR(tmpstab); str_set(str,rcsid); ! strncpy(tokenbuf,rcsid+19,3); ! sprintf(tokenbuf+3,"%2.2d",PATCHLEVEL); ! str->str_u.str_nval = atof(tokenbuf); str->str_nok = 1; } str_nset(stab_val(stabent("\"", TRUE)), " ", 1); --- 686,692 ---- if (tmpstab = stabent("]",allstabs)) { str = STAB_STR(tmpstab); str_set(str,rcsid); ! str->str_u.str_nval = atof(patchlevel); str->str_nok = 1; } str_nset(stab_val(stabent("\"", TRUE)), " ", 1); *************** *** 1024,1029 **** --- 1031,1045 ---- { reswitch: switch (*s) { + case '0': + record_separator = 0; + if (s[1] == '0' && !isdigit(s[2])) + rslen = 0; + while (*s >= '0' && *s <= '7') { + record_separator <<= 3; + record_separator += *s++ & 7; + } + return s; case 'a': minus_a = TRUE; s++; Index: lib/pwd.pl Prereq: 3.0.1.1 *** lib/pwd.pl.old Fri Jan 11 18:42:46 1991 --- lib/pwd.pl Fri Jan 11 18:42:47 1991 *************** *** 1,8 **** ;# pwd.pl - keeps track of current working directory in PWD environment var ;# ! ;# $Header: pwd.pl,v 3.0.1.1 90/08/09 04:01:24 lwall Locked $ ;# ;# $Log: pwd.pl,v $ ;# Revision 3.0.1.1 90/08/09 04:01:24 lwall ;# patch19: Initial revision ;# --- 1,11 ---- ;# pwd.pl - keeps track of current working directory in PWD environment var ;# ! ;# $Header: pwd.pl,v 3.0.1.2 91/01/11 18:09:24 lwall Locked $ ;# ;# $Log: pwd.pl,v $ + ;# Revision 3.0.1.2 91/01/11 18:09:24 lwall + ;# patch42: some .pl files were missing their trailing 1; + ;# ;# Revision 3.0.1.1 90/08/09 04:01:24 lwall ;# patch19: Initial revision ;# *************** *** 46,48 **** --- 49,52 ---- } } + 1; Index: x2p/s2p.SH Prereq: 3.0.1.6 *** x2p/s2p.SH.old Fri Jan 11 18:48:13 1991 --- x2p/s2p.SH Fri Jan 11 18:48:17 1991 *************** *** 7,12 **** --- 7,13 ---- '') if test ! -f config.sh; then ln ../config.sh . || \ + ln -s ../config.sh . || \ ln ../../config.sh . || \ ln ../../../config.sh . || \ (echo "Can't find config.sh."; exit 1) *************** *** 28,36 **** : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0.1.6 90/10/20 02:21:43 lwall Locked $ # # $Log: s2p.SH,v $ # Revision 3.0.1.6 90/10/20 02:21:43 lwall # patch37: changed some ". config.sh" to ". ./config.sh" # --- 29,40 ---- : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0.1.7 91/01/11 18:36:44 lwall Locked $ # # $Log: s2p.SH,v $ + # Revision 3.0.1.7 91/01/11 18:36:44 lwall + # patch42: x2p/s2p.SH blew up on /afs misfeature + # # Revision 3.0.1.6 90/10/20 02:21:43 lwall # patch37: changed some ". config.sh" to ". ./config.sh" # Index: stab.c Prereq: 3.0.1.10 *** stab.c.old Fri Jan 11 18:45:54 1991 --- stab.c Fri Jan 11 18:45:56 1991 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0.1.10 90/11/10 02:02:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.11 91/01/11 18:23:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.c,v $ + * Revision 3.0.1.11 91/01/11 18:23:44 lwall + * patch42: added -0 option + * * Revision 3.0.1.10 90/11/10 02:02:05 lwall * patch38: random cleanup * *************** *** 170,176 **** break; #endif case '/': ! if (record_separator != 12345) { *tokenbuf = record_separator; tokenbuf[1] = '\0'; str_nset(stab_val(stab),tokenbuf,rslen); --- 173,179 ---- break; #endif case '/': ! if (record_separator != 0777) { *tokenbuf = record_separator; tokenbuf[1] = '\0'; str_nset(stab_val(stab),tokenbuf,rslen); *************** *** 401,407 **** rslen = str->str_cur; } else { ! record_separator = 12345; /* fake a non-existent char */ rslen = 1; } break; --- 404,410 ---- rslen = str->str_cur; } else { ! record_separator = 0777; /* fake a non-existent char */ rslen = 1; } break; Index: str.c Prereq: 3.0.1.11 *** str.c.old Fri Jan 11 18:46:12 1991 --- str.c Fri Jan 11 18:46:19 1991 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.11 90/11/13 15:27:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.12 91/01/11 18:26:54 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * Revision 3.0.1.12 91/01/11 18:26:54 lwall + * patch42: s/^foo/bar/ occasionally brought on core dumps + * patch42: undid unwarranted assumptions about memcmp() return value + * patch42: ('a' .. 'z') could lose its value in a loop + * * Revision 3.0.1.11 90/11/13 15:27:14 lwall * patch41: fixed a couple of malloc/free problems * *************** *** 285,292 **** sstr->str_pok = 0; /* wipe out any weird flags */ sstr->str_state = 0; /* so sstr frees uneventfully */ } ! else /* have to copy actual string */ str_nset(dstr,sstr->str_ptr,sstr->str_cur); if (dstr->str_nok = sstr->str_nok) dstr->str_u.str_nval = sstr->str_u.str_nval; else { --- 290,303 ---- sstr->str_pok = 0; /* wipe out any weird flags */ sstr->str_state = 0; /* so sstr frees uneventfully */ } ! else { /* have to copy actual string */ ! if (dstr->str_ptr) { ! if (dstr->str_state == SS_INCR) { ! Str_Grow(dstr,0); ! } ! } str_nset(dstr,sstr->str_ptr,sstr->str_cur); + } if (dstr->str_nok = sstr->str_nok) dstr->str_u.str_nval = sstr->str_u.str_nval; else { *************** *** 738,749 **** if (str1->str_cur < str2->str_cur) { if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) ! return retval; else return -1; } else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) ! return retval; else if (str1->str_cur == str2->str_cur) return 0; else --- 749,760 ---- if (str1->str_cur < str2->str_cur) { if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) ! return retval < 0 ? -1 : 1; else return -1; } else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) ! return retval < 0 ? -1 : 1; else if (str1->str_cur == str2->str_cur) return 0; else *************** *** 804,809 **** --- 815,821 ---- if (get_paragraph && oldbp) obpx = oldbp - str->str_ptr; bpx = bp - str->str_ptr; /* prepare for possible relocation */ + str->str_cur = bpx; STR_GROW(str, str->str_len + append + cnt + 2); bp = str->str_ptr + bpx; /* reconstitute our pointer */ if (get_paragraph && oldbp) *************** *** 1373,1380 **** if (new->str_ptr) Safefree(new->str_ptr); Copy(old,new,1,STR); ! if (old->str_ptr) new->str_ptr = nsavestr(old->str_ptr,old->str_len); return new; } --- 1385,1394 ---- if (new->str_ptr) Safefree(new->str_ptr); Copy(old,new,1,STR); ! if (old->str_ptr) { new->str_ptr = nsavestr(old->str_ptr,old->str_len); + new->str_pok &= ~SP_TEMP; + } return new; } Index: toke.c Prereq: 3.0.1.11 *** toke.c.old Fri Jan 11 18:46:56 1991 --- toke.c Fri Jan 11 18:47:04 1991 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.11 90/11/10 02:13:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.12 91/01/11 18:31:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.12 91/01/11 18:31:45 lwall + * patch42: eval'ed formats without proper termination blew up + * patch42: whitespace now allowed after terminating . of format + * * Revision 3.0.1.11 90/11/10 02:13:44 lwall * patch38: added alarm function * patch38: tr was busted in metacharacters on signed char machines *************** *** 2341,2347 **** Zero(&froot, 1, FCMD); s = bufptr; ! while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) { curcmd->c_line++; if (in_eval && !rsfp) { eol = index(s,'\n'); --- 2345,2351 ---- Zero(&froot, 1, FCMD); s = bufptr; ! while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) { curcmd->c_line++; if (in_eval && !rsfp) { eol = index(s,'\n'); *************** *** 2356,2364 **** str_nset(tmpstr, s, eol-s); astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr); } ! if (strnEQ(s,".\n",2)) { ! bufptr = s; ! return froot.f_next; } if (*s == '#') { s = eol; --- 2360,2371 ---- str_nset(tmpstr, s, eol-s); astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr); } ! if (*s == '.') { ! for (t = s+1; *t == ' ' || *t == '\t'; t++) ; ! if (*t == '\n') { ! bufptr = s; ! return froot.f_next; ! } } if (*s == '#') { s = eol; *************** *** 2456,2462 **** } if (flinebeg) { again: ! if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch) goto badform; curcmd->c_line++; if (in_eval && !rsfp) { --- 2463,2470 ---- } if (flinebeg) { again: ! if (s >= bufend && ! (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) ) goto badform; curcmd->c_line++; if (in_eval && !rsfp) { Index: util.c Prereq: 3.0.1.10 *** util.c.old Fri Jan 11 18:47:25 1991 --- util.c Fri Jan 11 18:47:33 1991 *************** *** 1,4 **** ! /* $Header: util.c,v 3.0.1.10 90/11/10 02:19:28 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.c,v 3.0.1.11 91/01/11 18:33:10 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ + * Revision 3.0.1.11 91/01/11 18:33:10 lwall + * patch42: die could exit with 0 value on some machines + * patch42: Configure checks typecasting behavior better + * * Revision 3.0.1.10 90/11/10 02:19:28 lwall * patch38: random cleanup * patch38: sequence of s/^x//; s/x$//; could screw up malloc *************** *** 855,861 **** if (e_fp) (void)UNLINK(e_tmpname); statusvalue >>= 8; ! exit(errno?errno:(statusvalue?statusvalue:255)); } /*VARARGS1*/ --- 859,865 ---- if (e_fp) (void)UNLINK(e_tmpname); statusvalue >>= 8; ! exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255))); } /*VARARGS1*/ *************** *** 959,965 **** if (e_fp) (void)UNLINK(e_tmpname); statusvalue >>= 8; ! exit((int)(errno?errno:(statusvalue?statusvalue:255))); } /*VARARGS0*/ --- 963,969 ---- if (e_fp) (void)UNLINK(e_tmpname); statusvalue >>= 8; ! exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255))); } /*VARARGS0*/ *************** *** 1458,1464 **** { long along; ! #ifdef mips # define BIGDOUBLE 2147483648.0 if (f >= BIGDOUBLE) return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000; --- 1462,1468 ---- { long along; ! #if CASTFLAGS & 2 # define BIGDOUBLE 2147483648.0 if (f >= BIGDOUBLE) return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000; Index: Configure Prereq: 3.0.1.13 *** Configure.old Fri Jan 11 21:58:11 1991 --- Configure Fri Jan 11 21:58:20 1991 *************** *** 8,14 **** # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # ! # $Header: Configure,v 3.0.1.13 91/01/11 17:01:32 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than --- 8,14 ---- # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # ! # $Header: Configure,v 3.0.1.14 91/01/11 21:56:38 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than *************** *** 1321,1335 **** exit(result); } EOCP ! if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then ! d_castneg="$define" ! castflags=0 echo "Yup, it does." ! else ! d_castneg="$undef" ! castflags=$? echo "Nope, it doesn't." ! fi $rm -f try.* : see how we invoke the C preprocessor --- 1321,1336 ---- exit(result); } EOCP ! $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try ! castflags=$? ! case "$castflags" in ! 0) d_castneg="$define" echo "Yup, it does." ! ;; ! *) d_castneg="$undef" echo "Nope, it doesn't." ! ;; ! esac $rm -f try.* : see how we invoke the C preprocessor Index: perl.y Prereq: 3.0.1.10 *** perl.y.old Fri Jan 11 21:58:40 1991 --- perl.y Fri Jan 11 21:58:45 1991 *************** *** 1,4 **** ! /* $Header: perl.y,v 3.0.1.10 91/01/11 18:14:28 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.y,v 3.0.1.11 91/01/11 21:57:40 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.y,v $ + * Revision 3.0.1.11 91/01/11 21:57:40 lwall + * patch42: addendum + * * Revision 3.0.1.10 91/01/11 18:14:28 lwall * patch42: package didn't create symbol tables that could be reset * patch42: split with no arguments could wipe out next operator *************** *** 672,678 **** | SPLIT %prec '(' { static char p[]="/\\s+/"; char *oldend = bufend; ! int oldarg = yylval.arg; bufend=p+5; (void)scanpat(p); --- 675,681 ---- | SPLIT %prec '(' { static char p[]="/\\s+/"; char *oldend = bufend; ! ARG *oldarg = yylval.arg; bufend=p+5; (void)scanpat(p); *** End of Patch 44 ***
piet@cs.ruu.nl (Piet van Oostrum) (01/15/91)
>>>>> In message <11029@jpl-devvax.JPL.NASA.GOV>, lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (LW) writes:
LW> System: perl version 3.0
LW> Patch #: 44
LW> Priority:
LW> Subject: patch #42, continued
LW> Description:
LW> See patch #42.
LW> Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
LW> directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
LW> If you don't have the patch program, apply the following by hand,
LW> or get patch (version 2.0, latest patchlevel).
LW> After patching:
LW> mv config.sh config.sh.old
^^
Shouldn't that be cp?
--
Piet* van Oostrum, Dept of Computer Science, Utrecht University,
Padualaan 14, P.O. Box 80.089, 3508 TB Utrecht, The Netherlands.
Telephone: +31 30 531806 Uucp: uunet!mcsun!ruuinf!piet
Telefax: +31 30 513791 Internet: piet@cs.ruu.nl (*`Pete')lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (01/16/91)
In article <4662@ruuinf.cs.ruu.nl> piet@cs.ruu.nl (Piet van Oostrum) writes: : >>>>> In message <11029@jpl-devvax.JPL.NASA.GOV>, lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (LW) writes: : : LW> After patching: : LW> mv config.sh config.sh.old : ^^ : Shouldn't that be cp? No, the intent was to discard certain wrong values in some people's config.sh. There's no good mechanism for overriding bad config.sh values currently. I could make Configure just ignore the default value, but I really only want Configure to ignore the default value *once*. Larry
ronald@robobar.co.uk (Ronald S H Khoo) (01/17/91)
lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) writes: > In article <4662@ruuinf.cs.ruu.nl> piet@cs.ruu.nl (Piet van Oostrum) writes: > There's no good mechanism for overriding bad config.sh values currently. > I could make Configure just ignore the default value, but I really only want > Configure to ignore the default value *once*. Why not write the patchlevel out into config.sh ? -- Ronald Khoo <ronald@robobar.co.uk> +44 81 991 1142 (O) +44 71 229 7741 (H)