str.c

   1 /* $Header: str.c,v 3.0.1.9 90/10/16 10:41:21 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        str.c,v $
   9  * Revision 3.0.1.9  90/10/16  10:41:21  lwall
  10  * patch29: the undefined value could get defined by devious means
  11  * patch29: undefined values compared inconsistently
  12  * patch29: taintperl now checks for world writable PATH components
  13  *
  14  * Revision 3.0.1.8  90/08/09  05:22:18  lwall
  15  * patch19: the number to string converter wasn't allocating enough space
  16  * patch19: tainting didn't work on setgid scripts
  17  *
  18  * Revision 3.0.1.7  90/03/27  16:24:11  lwall
  19  * patch16: strings with prefix chopped off sometimes freed wrong
  20  * patch16: taint check blows up on undefined array element
  21  *
  22  * Revision 3.0.1.6  90/03/12  17:02:14  lwall
  23  * patch13: substr as lvalue didn't invalidate old numeric value
  24  *
  25  * Revision 3.0.1.5  90/02/28  18:30:38  lwall
  26  * patch9: you may now undef $/ to have no input record separator
  27  * patch9: nested evals clobbered their longjmp environment
  28  * patch9: sometimes perl thought ordinary data was a symbol table entry
  29  * patch9: insufficient space allocated for numeric string on sun4
  30  * patch9: underscore in an array name in a double-quoted string not recognized
  31  * patch9: "@foo{}" not recognized unless %foo defined
  32  * patch9: "$foo[$[]" gives error
  33  *
  34  * Revision 3.0.1.4  89/12/21  20:21:35  lwall
  35  * patch7: errno may now be a macro with an lvalue
  36  * patch7: made nested or recursive foreach work right
  37  *
  38  * Revision 3.0.1.3  89/11/17  15:38:23  lwall
  39  * patch5: some machines typedef unchar too
  40  * patch5: substitution on leading components occasionally caused <> corruption
  41  *
  42  * Revision 3.0.1.2  89/11/11  04:56:22  lwall
  43  * patch2: uchar gives Crays fits
  44  *
  45  * Revision 3.0.1.1  89/10/26  23:23:41  lwall
  46  * patch1: string ordering tests were wrong
  47  * patch1: $/ now works even when STDSTDIO undefined
  48  *
  49  * Revision 3.0  89/10/18  15:23:38  lwall
  50  * 3.0 baseline
  51  *
  52  */
  53
  54 #include "EXTERN.h"
  55 #include "perl.h"
  56 #include "perly.h"
  57
  58 extern char **environ;
  59
  60 #ifndef str_get
  61 char *
  62 str_get(str)
  63 STR *str;
  64 {
  65 #ifdef TAINT
  66     tainted |= str->str_tainted;
  67 #endif
  68     return str->str_pok ? str->str_ptr : str_2ptr(str);
  69 }
  70 #endif
  71
  72 /* dlb ... guess we have a "crippled cc".
  73  * dlb the following functions are usually macros.
  74  */
  75 #ifndef str_true
  76 str_true(Str)
  77 STR *Str;
  78 {
  79         if (Str->str_pok) {
  80             if (*Str->str_ptr > '0' ||
  81               Str->str_cur > 1 ||
  82               (Str->str_cur && *Str->str_ptr != '0'))
  83                 return 1;
  84             return 0;
  85         }
  86         if (Str->str_nok)
  87                 return (Str->str_u.str_nval != 0.0);
  88         return 0;
  89 }
  90 #endif /* str_true */
  91
  92 #ifndef str_gnum
  93 double str_gnum(Str)
  94 STR *Str;
  95 {
  96 #ifdef TAINT
  97         tainted |= Str->str_tainted;
  98 #endif /* TAINT*/
  99         if (Str->str_nok)
 100                 return Str->str_u.str_nval;
 101         return str_2num(Str);
 102 }
 103 #endif /* str_gnum */
 104 /* dlb ... end of crutch */
 105
 106 char *
 107 str_grow(str,newlen)
 108 register STR *str;
 109 #ifndef MSDOS
 110 register int newlen;
 111 #else
 112 unsigned long newlen;
 113 #endif
 114 {
 115     register char *s = str->str_ptr;
 116
 117 #ifdef MSDOS
 118     if (newlen >= 0x10000) {
 119         fprintf(stderr, "Allocation too large: %lx\n", newlen);
 120         exit(1);
 121     }
 122 #endif /* MSDOS */
 123     if (str->str_state == SS_INCR) {            /* data before str_ptr? */
 124         str->str_len += str->str_u.str_useful;
 125         str->str_ptr -= str->str_u.str_useful;
 126         str->str_u.str_useful = 0L;
 127         bcopy(s, str->str_ptr, str->str_cur+1);
 128         s = str->str_ptr;
 129         str->str_state = SS_NORM;                       /* normal again */
 130         if (newlen > str->str_len)
 131             newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
 132     }
 133     if (newlen > str->str_len) {                /* need more room? */
 134         if (str->str_len)
 135             Renew(s,newlen,char);
 136         else
 137             New(703,s,newlen,char);
 138         str->str_ptr = s;
 139         str->str_len = newlen;
 140     }
 141     return s;
 142 }
 143
 144 str_numset(str,num)
 145 register STR *str;
 146 double num;
 147 {
 148     if (str->str_pok) {
 149         str->str_pok = 0;       /* invalidate pointer */
 150         if (str->str_state == SS_INCR)
 151             Str_Grow(str,0);
 152     }
 153     str->str_u.str_nval = num;
 154     str->str_state = SS_NORM;
 155     str->str_nok = 1;                   /* validate number */
 156 #ifdef TAINT
 157     str->str_tainted = tainted;
 158 #endif
 159 }
 160
 161 char *
 162 str_2ptr(str)
 163 register STR *str;
 164 {
 165     register char *s;
 166     int olderrno;
 167
 168     if (!str)
 169         return "";
 170     if (str->str_nok) {
 171         STR_GROW(str, 30);
 172         s = str->str_ptr;
 173         olderrno = errno;       /* some Xenix systems wipe out errno here */
 174 #if defined(scs) && defined(ns32000)
 175         gcvt(str->str_u.str_nval,20,s);
 176 #else
 177 #ifdef apollo
 178         if (str->str_u.str_nval == 0.0)
 179             (void)strcpy(s,"0");
 180         else
 181 #endif /*apollo*/
 182         (void)sprintf(s,"%.20g",str->str_u.str_nval);
 183 #endif /*scs*/
 184         errno = olderrno;
 185         while (*s) s++;
 186 #ifdef hcx
 187         if (s[-1] == '.')
 188             s--;
 189 #endif
 190     }
 191     else {
 192         if (str == &str_undef)
 193             return No;
 194         if (dowarn)
 195             warn("Use of uninitialized variable");
 196         STR_GROW(str, 30);
 197         s = str->str_ptr;
 198     }
 199     *s = '\0';
 200     str->str_cur = s - str->str_ptr;
 201     str->str_pok = 1;
 202 #ifdef DEBUGGING
 203     if (debug & 32)
 204         fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
 205 #endif
 206     return str->str_ptr;
 207 }
 208
 209 double
 210 str_2num(str)
 211 register STR *str;
 212 {
 213     if (!str)
 214         return 0.0;
 215     if (str->str_state == SS_INCR)
 216         Str_Grow(str,0);       /* just force copy down */
 217     str->str_state = SS_NORM;
 218     if (str->str_len && str->str_pok)
 219         str->str_u.str_nval = atof(str->str_ptr);
 220     else  {
 221         if (str == &str_undef)
 222             return 0.0;
 223         if (dowarn)
 224             warn("Use of uninitialized variable");
 225         str->str_u.str_nval = 0.0;
 226     }
 227     str->str_nok = 1;
 228 #ifdef DEBUGGING
 229     if (debug & 32)
 230         fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
 231 #endif
 232     return str->str_u.str_nval;
 233 }
 234
 235 str_sset(dstr,sstr)
 236 STR *dstr;
 237 register STR *sstr;
 238 {
 239 #ifdef TAINT
 240     if (sstr)
 241         tainted |= sstr->str_tainted;
 242 #endif
 243     if (sstr == dstr || dstr == &str_undef)
 244         return;
 245     if (!sstr)
 246         dstr->str_pok = dstr->str_nok = 0;
 247     else if (sstr->str_pok) {
 248         str_nset(dstr,sstr->str_ptr,sstr->str_cur);
 249         if (sstr->str_nok) {
 250             dstr->str_u.str_nval = sstr->str_u.str_nval;
 251             dstr->str_nok = 1;
 252             dstr->str_state = SS_NORM;
 253         }
 254         else if (sstr->str_cur == sizeof(STBP)) {
 255             char *tmps = sstr->str_ptr;
 256
 257             if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
 258                 if (!dstr->str_magic) {
 259                     dstr->str_magic = str_smake(sstr->str_magic);
 260                     dstr->str_magic->str_rare = 'X';
 261                 }
 262             }
 263         }
 264     }
 265     else if (sstr->str_nok)
 266         str_numset(dstr,sstr->str_u.str_nval);
 267     else {
 268         if (dstr->str_state == SS_INCR)
 269             Str_Grow(dstr,0);       /* just force copy down */
 270
 271 #ifdef STRUCTCOPY
 272         dstr->str_u = sstr->str_u;
 273 #else
 274         dstr->str_u.str_nval = sstr->str_u.str_nval;
 275 #endif
 276         dstr->str_pok = dstr->str_nok = 0;
 277     }
 278 }
 279
 280 str_nset(str,ptr,len)
 281 register STR *str;
 282 register char *ptr;
 283 register STRLEN len;
 284 {
 285     if (str == &str_undef)
 286         return;
 287     STR_GROW(str, len + 1);
 288     if (ptr)
 289         (void)bcopy(ptr,str->str_ptr,len);
 290     str->str_cur = len;
 291     *(str->str_ptr+str->str_cur) = '\0';
 292     str->str_nok = 0;           /* invalidate number */
 293     str->str_pok = 1;           /* validate pointer */
 294 #ifdef TAINT
 295     str->str_tainted = tainted;
 296 #endif
 297 }
 298
 299 str_set(str,ptr)
 300 register STR *str;
 301 register char *ptr;
 302 {
 303     register STRLEN len;
 304
 305     if (str == &str_undef)
 306         return;
 307     if (!ptr)
 308         ptr = "";
 309     len = strlen(ptr);
 310     STR_GROW(str, len + 1);
 311     (void)bcopy(ptr,str->str_ptr,len+1);
 312     str->str_cur = len;
 313     str->str_nok = 0;           /* invalidate number */
 314     str->str_pok = 1;           /* validate pointer */
 315 #ifdef TAINT
 316     str->str_tainted = tainted;
 317 #endif
 318 }
 319
 320 str_chop(str,ptr)       /* like set but assuming ptr is in str */
 321 register STR *str;
 322 register char *ptr;
 323 {
 324     register STRLEN delta;
 325
 326     if (!(str->str_pok))
 327         fatal("str_chop: internal inconsistency");
 328     delta = ptr - str->str_ptr;
 329     str->str_len -= delta;
 330     str->str_cur -= delta;
 331     str->str_ptr += delta;
 332     if (str->str_state == SS_INCR)
 333         str->str_u.str_useful += delta;
 334     else {
 335         str->str_u.str_useful = delta;
 336         str->str_state = SS_INCR;
 337     }
 338     str->str_nok = 0;           /* invalidate number */
 339     str->str_pok = 1;           /* validate pointer (and unstudy str) */
 340 }
 341
 342 str_ncat(str,ptr,len)
 343 register STR *str;
 344 register char *ptr;
 345 register STRLEN len;
 346 {
 347     if (str == &str_undef)
 348         return;
 349     if (!(str->str_pok))
 350         (void)str_2ptr(str);
 351     STR_GROW(str, str->str_cur + len + 1);
 352     (void)bcopy(ptr,str->str_ptr+str->str_cur,len);
 353     str->str_cur += len;
 354     *(str->str_ptr+str->str_cur) = '\0';
 355     str->str_nok = 0;           /* invalidate number */
 356     str->str_pok = 1;           /* validate pointer */
 357 #ifdef TAINT
 358     str->str_tainted |= tainted;
 359 #endif
 360 }
 361
 362 str_scat(dstr,sstr)
 363 STR *dstr;
 364 register STR *sstr;
 365 {
 366 #ifdef TAINT
 367     tainted |= sstr->str_tainted;
 368 #endif
 369     if (!sstr)
 370         return;
 371     if (!(sstr->str_pok))
 372         (void)str_2ptr(sstr);
 373     if (sstr)
 374         str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
 375 }
 376
 377 str_cat(str,ptr)
 378 register STR *str;
 379 register char *ptr;
 380 {
 381     register STRLEN len;
 382
 383     if (str == &str_undef)
 384         return;
 385     if (!ptr)
 386         return;
 387     if (!(str->str_pok))
 388         (void)str_2ptr(str);
 389     len = strlen(ptr);
 390     STR_GROW(str, str->str_cur + len + 1);
 391     (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1);
 392     str->str_cur += len;
 393     str->str_nok = 0;           /* invalidate number */
 394     str->str_pok = 1;           /* validate pointer */
 395 #ifdef TAINT
 396     str->str_tainted |= tainted;
 397 #endif
 398 }
 399
 400 char *
 401 str_append_till(str,from,fromend,delim,keeplist)
 402 register STR *str;
 403 register char *from;
 404 register char *fromend;
 405 register int delim;
 406 char *keeplist;
 407 {
 408     register char *to;
 409     register STRLEN len;
 410
 411     if (str == &str_undef)
 412         return Nullch;
 413     if (!from)
 414         return Nullch;
 415     len = fromend - from;
 416     STR_GROW(str, str->str_cur + len + 1);
 417     str->str_nok = 0;           /* invalidate number */
 418     str->str_pok = 1;           /* validate pointer */
 419     to = str->str_ptr+str->str_cur;
 420     for (; from < fromend; from++,to++) {
 421         if (*from == '\\' && from+1 < fromend && delim != '\\') {
 422             if (!keeplist) {
 423                 if (from[1] == delim || from[1] == '\\')
 424                     from++;
 425                 else
 426                     *to++ = *from++;
 427             }
 428             else if (from[1] && index(keeplist,from[1]))
 429                 *to++ = *from++;
 430             else
 431                 from++;
 432         }
 433         else if (*from == delim)
 434             break;
 435         *to = *from;
 436     }
 437     *to = '\0';
 438     str->str_cur = to - str->str_ptr;
 439     return from;
 440 }
 441
 442 STR *
 443 #ifdef LEAKTEST
 444 str_new(x,len)
 445 int x;
 446 #else
 447 str_new(len)
 448 #endif
 449 STRLEN len;
 450 {
 451     register STR *str;
 452
 453     if (freestrroot) {
 454         str = freestrroot;
 455         freestrroot = str->str_magic;
 456         str->str_magic = Nullstr;
 457         str->str_state = SS_NORM;
 458     }
 459     else {
 460         Newz(700+x,str,1,STR);
 461     }
 462     if (len)
 463         STR_GROW(str, len + 1);
 464     return str;
 465 }
 466
 467 void
 468 str_magic(str, stab, how, name, namlen)
 469 register STR *str;
 470 STAB *stab;
 471 int how;
 472 char *name;
 473 STRLEN namlen;
 474 {
 475     if (str == &str_undef || str->str_magic)
 476         return;
 477     str->str_magic = Str_new(75,namlen);
 478     str = str->str_magic;
 479     str->str_u.str_stab = stab;
 480     str->str_rare = how;
 481     if (name)
 482         str_nset(str,name,namlen);
 483 }
 484
 485 void
 486 str_insert(bigstr,offset,len,little,littlelen)
 487 STR *bigstr;
 488 STRLEN offset;
 489 STRLEN len;
 490 char *little;
 491 STRLEN littlelen;
 492 {
 493     register char *big;
 494     register char *mid;
 495     register char *midend;
 496     register char *bigend;
 497     register int i;
 498
 499     if (bigstr == &str_undef)
 500         return;
 501     bigstr->str_nok = 0;
 502     bigstr->str_pok = SP_VALID; /* disable possible screamer */
 503
 504     i = littlelen - len;
 505     if (i > 0) {                        /* string might grow */
 506         STR_GROW(bigstr, bigstr->str_cur + i + 1);
 507         big = bigstr->str_ptr;
 508         mid = big + offset + len;
 509         midend = bigend = big + bigstr->str_cur;
 510         bigend += i;
 511         *bigend = '\0';
 512         while (midend > mid)            /* shove everything down */
 513             *--bigend = *--midend;
 514         (void)bcopy(little,big+offset,littlelen);
 515         bigstr->str_cur += i;
 516         return;
 517     }
 518     else if (i == 0) {
 519         (void)bcopy(little,bigstr->str_ptr+offset,len);
 520         return;
 521     }
 522
 523     big = bigstr->str_ptr;
 524     mid = big + offset;
 525     midend = mid + len;
 526     bigend = big + bigstr->str_cur;
 527
 528     if (midend > bigend)
 529         fatal("panic: str_insert");
 530
 531     if (mid - big > bigend - midend) {  /* faster to shorten from end */
 532         if (littlelen) {
 533             (void)bcopy(little, mid, littlelen);
 534             mid += littlelen;
 535         }
 536         i = bigend - midend;
 537         if (i > 0) {
 538             (void)bcopy(midend, mid, i);
 539             mid += i;
 540         }
 541         *mid = '\0';
 542         bigstr->str_cur = mid - big;
 543     }
 544     else if (i = mid - big) {   /* faster from front */
 545         midend -= littlelen;
 546         mid = midend;
 547         str_chop(bigstr,midend-i);
 548         big += i;
 549         while (i--)
 550             *--midend = *--big;
 551         if (littlelen)
 552             (void)bcopy(little, mid, littlelen);
 553     }
 554     else if (littlelen) {
 555         midend -= littlelen;
 556         str_chop(bigstr,midend);
 557         (void)bcopy(little,midend,littlelen);
 558     }
 559     else {
 560         str_chop(bigstr,midend);
 561     }
 562     STABSET(bigstr);
 563 }
 564
 565 /* make str point to what nstr did */
 566
 567 void
 568 str_replace(str,nstr)
 569 register STR *str;
 570 register STR *nstr;
 571 {
 572     if (str == &str_undef)
 573         return;
 574     if (str->str_state == SS_INCR)
 575         Str_Grow(str,0);        /* just force copy down */
 576     if (nstr->str_state == SS_INCR)
 577         Str_Grow(nstr,0);
 578     if (str->str_ptr)
 579         Safefree(str->str_ptr);
 580     str->str_ptr = nstr->str_ptr;
 581     str->str_len = nstr->str_len;
 582     str->str_cur = nstr->str_cur;
 583     str->str_pok = nstr->str_pok;
 584     str->str_nok = nstr->str_nok;
 585 #ifdef STRUCTCOPY
 586     str->str_u = nstr->str_u;
 587 #else
 588     str->str_u.str_nval = nstr->str_u.str_nval;
 589 #endif
 590 #ifdef TAINT
 591     str->str_tainted = nstr->str_tainted;
 592 #endif
 593     Safefree(nstr);
 594 }
 595
 596 void
 597 str_free(str)
 598 register STR *str;
 599 {
 600     if (!str || str == &str_undef)
 601         return;
 602     if (str->str_state) {
 603         if (str->str_state == SS_FREE)  /* already freed */
 604             return;
 605         if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
 606             str->str_ptr -= str->str_u.str_useful;
 607             str->str_len += str->str_u.str_useful;
 608         }
 609     }
 610     if (str->str_magic)
 611         str_free(str->str_magic);
 612 #ifdef LEAKTEST
 613     if (str->str_len)
 614         Safefree(str->str_ptr);
 615     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
 616         arg_free(str->str_u.str_args);
 617     Safefree(str);
 618 #else /* LEAKTEST */
 619     if (str->str_len) {
 620         if (str->str_len > 127) {       /* next user not likely to want more */
 621             Safefree(str->str_ptr);     /* so give it back to malloc */
 622             str->str_ptr = Nullch;
 623             str->str_len = 0;
 624         }
 625         else
 626             str->str_ptr[0] = '\0';
 627     }
 628     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
 629         arg_free(str->str_u.str_args);
 630     str->str_cur = 0;
 631     str->str_nok = 0;
 632     str->str_pok = 0;
 633     str->str_state = SS_FREE;
 634 #ifdef TAINT
 635     str->str_tainted = 0;
 636 #endif
 637     str->str_magic = freestrroot;
 638     freestrroot = str;
 639 #endif /* LEAKTEST */
 640 }
 641
 642 STRLEN
 643 str_len(str)
 644 register STR *str;
 645 {
 646     if (!str)
 647         return 0;
 648     if (!(str->str_pok))
 649         (void)str_2ptr(str);
 650     if (str->str_ptr)
 651         return str->str_cur;
 652     else
 653         return 0;
 654 }
 655
 656 str_eq(str1,str2)
 657 register STR *str1;
 658 register STR *str2;
 659 {
 660     if (!str1 || str1 == &str_undef)
 661         return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
 662     if (!str2 || str2 == &str_undef)
 663         return !str1->str_cur;
 664
 665     if (!str1->str_pok)
 666         (void)str_2ptr(str1);
 667     if (!str2->str_pok)
 668         (void)str_2ptr(str2);
 669
 670     if (str1->str_cur != str2->str_cur)
 671         return 0;
 672
 673     return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
 674 }
 675
 676 str_cmp(str1,str2)
 677 register STR *str1;
 678 register STR *str2;
 679 {
 680     int retval;
 681
 682     if (!str1 || str1 == &str_undef)
 683         return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
 684     if (!str2 || str2 == &str_undef)
 685         return str1->str_cur != 0;
 686
 687     if (!str1->str_pok)
 688         (void)str_2ptr(str1);
 689     if (!str2->str_pok)
 690         (void)str_2ptr(str2);
 691
 692     if (str1->str_cur < str2->str_cur) {
 693         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
 694             return retval;
 695         else
 696             return -1;
 697     }
 698     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
 699         return retval;
 700     else if (str1->str_cur == str2->str_cur)
 701         return 0;
 702     else
 703         return 1;
 704 }
 705
 706 char *
 707 str_gets(str,fp,append)
 708 register STR *str;
 709 register FILE *fp;
 710 int append;
 711 {
 712     register char *bp;          /* we're going to steal some values */
 713     register int cnt;           /*  from the stdio struct and put EVERYTHING */
 714     register STDCHAR *ptr;      /*   in the innermost loop into registers */
 715     register int newline = record_separator;/* (assuming >= 6 registers) */
 716     int i;
 717     STRLEN bpx;
 718     STRLEN obpx;
 719     register int get_paragraph;
 720     register char *oldbp;
 721
 722     if (str == &str_undef)
 723         return Nullch;
 724     if (get_paragraph = !rslen) {       /* yes, that's an assignment */
 725         newline = '\n';
 726         oldbp = Nullch;                 /* remember last \n position (none) */
 727     }
 728 #ifdef STDSTDIO         /* Here is some breathtakingly efficient cheating */
 729     cnt = fp->_cnt;                     /* get count into register */
 730     str->str_nok = 0;                   /* invalidate number */
 731     str->str_pok = 1;                   /* validate pointer */
 732     if (str->str_len <= cnt + 1)        /* make sure we have the room */
 733         STR_GROW(str, append+cnt+2);    /* (remembering cnt can be -1) */
 734     bp = str->str_ptr + append;         /* move these two too to registers */
 735     ptr = fp->_ptr;
 736     for (;;) {
 737       screamer:
 738         while (--cnt >= 0) {                    /* this */      /* eat */
 739             if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
 740                 goto thats_all_folks;           /* screams */   /* sed :-) */
 741         }
 742
 743         fp->_cnt = cnt;                 /* deregisterize cnt and ptr */
 744         fp->_ptr = ptr;
 745         i = _filbuf(fp);                /* get more characters */
 746         cnt = fp->_cnt;
 747         ptr = fp->_ptr;                 /* reregisterize cnt and ptr */
 748
 749         bpx = bp - str->str_ptr;        /* prepare for possible relocation */
 750         if (get_paragraph && oldbp)
 751             obpx = oldbp - str->str_ptr;
 752         str->str_cur = bpx;
 753         STR_GROW(str, bpx + cnt + 2);
 754         bp = str->str_ptr + bpx;        /* reconstitute our pointer */
 755         if (get_paragraph && oldbp)
 756             oldbp = str->str_ptr + obpx;
 757
 758         if (i == newline) {             /* all done for now? */
 759             *bp++ = i;
 760             goto thats_all_folks;
 761         }
 762         else if (i == EOF)              /* all done for ever? */
 763             goto thats_really_all_folks;
 764         *bp++ = i;                      /* now go back to screaming loop */
 765     }
 766
 767 thats_all_folks:
 768     if (get_paragraph && bp - 1 != oldbp) {
 769         oldbp = bp;     /* remember where this newline was */
 770         goto screamer;  /* and go back to the fray */
 771     }
 772 thats_really_all_folks:
 773     fp->_cnt = cnt;                     /* put these back or we're in trouble */
 774     fp->_ptr = ptr;
 775     *bp = '\0';
 776     str->str_cur = bp - str->str_ptr;   /* set length */
 777
 778 #else /* !STDSTDIO */   /* The big, slow, and stupid way */
 779
 780     {
 781         static char buf[8192];
 782         char * bpe = buf + sizeof(buf) - 3;
 783
 784 screamer:
 785         bp = buf;
 786 filler:
 787         while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe);
 788         if (i == newline && get_paragraph &&
 789             (i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe)
 790             goto filler;
 791
 792         *bp = '\0';
 793         if (append)
 794             str_cat(str, buf);
 795         else
 796             str_set(str, buf);
 797         if (i != newline && i != EOF) {
 798             append = -1;
 799             goto screamer;
 800         }
 801     }
 802
 803 #endif /* STDSTDIO */
 804
 805     return str->str_cur - append ? str->str_ptr : Nullch;
 806 }
 807
 808 ARG *
 809 parselist(str)
 810 STR *str;
 811 {
 812     register CMD *cmd;
 813     register ARG *arg;
 814     CMD *oldcurcmd = curcmd;
 815     int oldperldb = perldb;
 816     int retval;
 817
 818     perldb = 0;
 819     str_sset(linestr,str);
 820     in_eval++;
 821     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
 822     bufend = bufptr + linestr->str_cur;
 823     if (++loop_ptr >= loop_max) {
 824         loop_max += 128;
 825         Renew(loop_stack, loop_max, struct loop);
 826     }
 827     loop_stack[loop_ptr].loop_label = "_EVAL_";
 828     loop_stack[loop_ptr].loop_sp = 0;
 829 #ifdef DEBUGGING
 830     if (debug & 4) {
 831         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
 832     }
 833 #endif
 834     if (setjmp(loop_stack[loop_ptr].loop_env)) {
 835         in_eval--;
 836         loop_ptr--;
 837         perldb = oldperldb;
 838         fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
 839     }
 840 #ifdef DEBUGGING
 841     if (debug & 4) {
 842         char *tmps = loop_stack[loop_ptr].loop_label;
 843         deb("(Popping label #%d %s)\n",loop_ptr,
 844             tmps ? tmps : "" );
 845     }
 846 #endif
 847     loop_ptr--;
 848     error_count = 0;
 849     curcmd = &compiling;
 850     curcmd->c_line = oldcurcmd->c_line;
 851     retval = yyparse();
 852     curcmd = oldcurcmd;
 853     perldb = oldperldb;
 854     in_eval--;
 855     if (retval || error_count)
 856         fatal("Invalid component in string or format");
 857     cmd = eval_root;
 858     arg = cmd->c_expr;
 859     if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
 860         fatal("panic: error in parselist %d %x %d", cmd->c_type,
 861           cmd->c_next, arg ? arg->arg_type : -1);
 862     Safefree(cmd);
 863     return arg;
 864 }
 865
 866 void
 867 intrpcompile(src)
 868 STR *src;
 869 {
 870     register char *s = str_get(src);
 871     register char *send = s + src->str_cur;
 872     register STR *str;
 873     register char *t;
 874     STR *toparse;
 875     STRLEN len;
 876     register int brackets;
 877     register char *d;
 878     STAB *stab;
 879     char *checkpoint;
 880
 881     toparse = Str_new(76,0);
 882     str = Str_new(77,0);
 883
 884     str_nset(str,"",0);
 885     str_nset(toparse,"",0);
 886     t = s;
 887     while (s < send) {
 888         if (*s == '\\' && s[1] && index("$@[{\\]}",s[1])) {
 889             str_ncat(str, t, s - t);
 890             ++s;
 891             if (*nointrp && s+1 < send)
 892                 if (*s != '@' && (*s != '$' || index(nointrp,s[1])))
 893                     str_ncat(str,s-1,1);
 894             str_ncat(str, "$b", 2);
 895             str_ncat(str, s, 1);
 896             ++s;
 897             t = s;
 898         }
 899         else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) &&
 900           s+1 < send) {
 901             str_ncat(str,t,s-t);
 902             t = s;
 903             if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
 904                 s++;
 905             s = scanreg(s,send,tokenbuf);
 906             if (*t == '@' &&
 907               (!(stab = stabent(tokenbuf,FALSE)) ||
 908                  (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
 909                 str_ncat(str,"@",1);
 910                 s = ++t;
 911                 continue;       /* grandfather @ from old scripts */
 912             }
 913             str_ncat(str,"$a",2);
 914             str_ncat(toparse,",",1);
 915             if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
 916               (stab = stabent(tokenbuf,FALSE)) &&
 917               ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
 918                 brackets = 0;
 919                 checkpoint = s;
 920                 do {
 921                     switch (*s) {
 922                     case '[':
 923                         if (s[-1] != '$')
 924                             brackets++;
 925                         break;
 926                     case '{':
 927                         brackets++;
 928                         break;
 929                     case ']':
 930                         if (s[-1] != '$')
 931                             brackets--;
 932                         break;
 933                     case '}':
 934                         brackets--;
 935                         break;
 936                     case '\'':
 937                     case '"':
 938                         if (s[-1] != '$') {
 939                             s = cpytill(tokenbuf,s+1,send,*s,&len);
 940                             if (s >= send)
 941                                 fatal("Unterminated string");
 942                         }
 943                         break;
 944                     }
 945                     s++;
 946                 } while (brackets > 0 && s < send);
 947                 if (s > send)
 948                     fatal("Unmatched brackets in string");
 949                 if (*nointrp) {         /* we're in a regular expression */
 950                     d = checkpoint;
 951                     if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
 952                         ++d;
 953                         if (isdigit(*d)) {      /* matches /^{\d,?\d*}$/ */
 954                             if (*++d == ',')
 955                                 ++d;
 956                             while (isdigit(*d))
 957                                 d++;
 958                             if (d == s - 1)
 959                                 s = checkpoint;         /* Is {n,m}! Backoff! */
 960                         }
 961                     }
 962                     else if (*d == '[' && s[-1] == ']') { /* char class? */
 963                         int weight = 2;         /* let's weigh the evidence */
 964                         char seen[256];
 965                         unsigned char un_char = 0, last_un_char;
 966
 967                         Zero(seen,256,char);
 968                         *--s = '\0';
 969                         if (d[1] == '^')
 970                             weight += 150;
 971                         else if (d[1] == '$')
 972                             weight -= 3;
 973                         if (isdigit(d[1])) {
 974                             if (d[2]) {
 975                                 if (isdigit(d[2]) && !d[3])
 976                                     weight -= 10;
 977                             }
 978                             else
 979                                 weight -= 100;
 980                         }
 981                         for (d++; d < s; d++) {
 982                             last_un_char = un_char;
 983                             un_char = (unsigned char)*d;
 984                             switch (*d) {
 985                             case '&':
 986                             case '$':
 987                                 weight -= seen[un_char] * 10;
 988                                 if (isalpha(d[1]) || isdigit(d[1]) ||
 989                                   d[1] == '_') {
 990                                     d = scanreg(d,s,tokenbuf);
 991                                     if (stabent(tokenbuf,FALSE))
 992                                         weight -= 100;
 993                                     else
 994                                         weight -= 10;
 995                                 }
 996                                 else if (*d == '$' && d[1] &&
 997                                   index("[#!%*<>()-=",d[1])) {
 998                                     if (!d[2] || /*{*/ index("])} =",d[2]))
 999                                         weight -= 10;
1000                                     else
1001                                         weight -= 1;
1002                                 }
1003                                 break;
1004                             case '\\':
1005                                 un_char = 254;
1006                                 if (d[1]) {
1007                                     if (index("wds",d[1]))
1008                                         weight += 100;
1009                                     else if (seen['\''] || seen['"'])
1010                                         weight += 1;
1011                                     else if (index("rnftb",d[1]))
1012                                         weight += 40;
1013                                     else if (isdigit(d[1])) {
1014                                         weight += 40;
1015                                         while (d[1] && isdigit(d[1]))
1016                                             d++;
1017                                     }
1018                                 }
1019                                 else
1020                                     weight += 100;
1021                                 break;
1022                             case '-':
1023                                 if (last_un_char < (unsigned char) d[1]
1024                                   || d[1] == '\\') {
1025                                     if (index("aA01! ",last_un_char))
1026                                         weight += 30;
1027                                     if (index("zZ79~",d[1]))
1028                                         weight += 30;
1029                                 }
1030                                 else
1031                                     weight -= 1;
1032                             default:
1033                                 if (isalpha(*d) && d[1] && isalpha(d[1])) {
1034                                     bufptr = d;
1035                                     if (yylex() != WORD)
1036                                         weight -= 150;
1037                                     d = bufptr;
1038                                 }
1039                                 if (un_char == last_un_char + 1)
1040                                     weight += 5;
1041                                 weight -= seen[un_char];
1042                                 break;
1043                             }
1044                             seen[un_char]++;
1045                         }
1046 #ifdef DEBUGGING
1047                         if (debug & 512)
1048                             fprintf(stderr,"[%s] weight %d\n",
1049                               checkpoint+1,weight);
1050 #endif
1051                         *s++ = ']';
1052                         if (weight >= 0)        /* probably a character class */
1053                             s = checkpoint;
1054                     }
1055                 }
1056             }
1057             if (*t == '@')
1058                 str_ncat(toparse, "join($\",", 8);
1059             if (t[1] == '{' && s[-1] == '}') {
1060                 str_ncat(toparse, t, 1);
1061                 str_ncat(toparse, t+2, s - t - 3);
1062             }
1063             else
1064                 str_ncat(toparse, t, s - t);
1065             if (*t == '@')
1066                 str_ncat(toparse, ")", 1);
1067             t = s;
1068         }
1069         else
1070             s++;
1071     }
1072     str_ncat(str,t,s-t);
1073     if (toparse->str_ptr && *toparse->str_ptr == ',') {
1074         *toparse->str_ptr = '(';
1075         str_ncat(toparse,",$$);",5);
1076         str->str_u.str_args = parselist(toparse);
1077         str->str_u.str_args->arg_len--;         /* ignore $$ reference */
1078     }
1079     else
1080         str->str_u.str_args = Nullarg;
1081     str_free(toparse);
1082     str->str_pok |= SP_INTRP;
1083     str->str_nok = 0;
1084     str_replace(src,str);
1085 }
1086
1087 STR *
1088 interp(str,src,sp)
1089 register STR *str;
1090 STR *src;
1091 int sp;
1092 {
1093     register char *s;
1094     register char *t;
1095     register char *send;
1096     register STR **elem;
1097
1098     if (str == &str_undef)
1099         return Nullstr;
1100     if (!(src->str_pok & SP_INTRP)) {
1101         int oldsave = savestack->ary_fill;
1102
1103         (void)savehptr(&curstash);
1104         curstash = curcmd->c_stash;     /* so stabent knows right package */
1105         intrpcompile(src);
1106         restorelist(oldsave);
1107     }
1108     s = src->str_ptr;           /* assumed valid since str_pok set */
1109     t = s;
1110     send = s + src->str_cur;
1111
1112     if (src->str_u.str_args) {
1113         (void)eval(src->str_u.str_args,G_ARRAY,sp);
1114         /* Assuming we have correct # of args */
1115         elem = stack->ary_array + sp;
1116     }
1117
1118     str_nset(str,"",0);
1119     while (s < send) {
1120         if (*s == '$' && s+1 < send) {
1121             str_ncat(str,t,s-t);
1122             switch(*++s) {
1123             case 'a':
1124                 str_scat(str,*++elem);
1125                 break;
1126             case 'b':
1127                 str_ncat(str,++s,1);
1128                 break;
1129             }
1130             t = ++s;
1131         }
1132         else
1133             s++;
1134     }
1135     str_ncat(str,t,s-t);
1136     return str;
1137 }
1138
1139 void
1140 str_inc(str)
1141 register STR *str;
1142 {
1143     register char *d;
1144
1145     if (!str || str == &str_undef)
1146         return;
1147     if (str->str_nok) {
1148         str->str_u.str_nval += 1.0;
1149         str->str_pok = 0;
1150         return;
1151     }
1152     if (!str->str_pok || !*str->str_ptr) {
1153         str->str_u.str_nval = 1.0;
1154         str->str_nok = 1;
1155         str->str_pok = 0;
1156         return;
1157     }
1158     d = str->str_ptr;
1159     while (isalpha(*d)) d++;
1160     while (isdigit(*d)) d++;
1161     if (*d) {
1162         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
1163         return;
1164     }
1165     d--;
1166     while (d >= str->str_ptr) {
1167         if (isdigit(*d)) {
1168             if (++*d <= '9')
1169                 return;
1170             *(d--) = '0';
1171         }
1172         else {
1173             ++*d;
1174             if (isalpha(*d))
1175                 return;
1176             *(d--) -= 'z' - 'a' + 1;
1177         }
1178     }
1179     /* oh,oh, the number grew */
1180     STR_GROW(str, str->str_cur + 2);
1181     str->str_cur++;
1182     for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
1183         *d = d[-1];
1184     if (isdigit(d[1]))
1185         *d = '1';
1186     else
1187         *d = d[1];
1188 }
1189
1190 void
1191 str_dec(str)
1192 register STR *str;
1193 {
1194     if (!str || str == &str_undef)
1195         return;
1196     if (str->str_nok) {
1197         str->str_u.str_nval -= 1.0;
1198         str->str_pok = 0;
1199         return;
1200     }
1201     if (!str->str_pok) {
1202         str->str_u.str_nval = -1.0;
1203         str->str_nok = 1;
1204         return;
1205     }
1206     str_numset(str,atof(str->str_ptr) - 1.0);
1207 }
1208
1209 /* Make a string that will exist for the duration of the expression
1210  * evaluation.  Actually, it may have to last longer than that, but
1211  * hopefully cmd_exec won't free it until it has been assigned to a
1212  * permanent location. */
1213
1214 static long tmps_size = -1;
1215
1216 STR *
1217 str_static(oldstr)
1218 STR *oldstr;
1219 {
1220     register STR *str = Str_new(78,0);
1221
1222     str_sset(str,oldstr);
1223     if (++tmps_max > tmps_size) {
1224         tmps_size = tmps_max;
1225         if (!(tmps_size & 127)) {
1226             if (tmps_size)
1227                 Renew(tmps_list, tmps_size + 128, STR*);
1228             else
1229                 New(702,tmps_list, 128, STR*);
1230         }
1231     }
1232     tmps_list[tmps_max] = str;
1233     return str;
1234 }
1235
1236 /* same thing without the copying */
1237
1238 STR *
1239 str_2static(str)
1240 register STR *str;
1241 {
1242     if (str == &str_undef)
1243         return str;
1244     if (++tmps_max > tmps_size) {
1245         tmps_size = tmps_max;
1246         if (!(tmps_size & 127)) {
1247             if (tmps_size)
1248                 Renew(tmps_list, tmps_size + 128, STR*);
1249             else
1250                 New(704,tmps_list, 128, STR*);
1251         }
1252     }
1253     tmps_list[tmps_max] = str;
1254     return str;
1255 }
1256
1257 STR *
1258 str_make(s,len)
1259 char *s;
1260 STRLEN len;
1261 {
1262     register STR *str = Str_new(79,0);
1263
1264     if (!len)
1265         len = strlen(s);
1266     str_nset(str,s,len);
1267     return str;
1268 }
1269
1270 STR *
1271 str_nmake(n)
1272 double n;
1273 {
1274     register STR *str = Str_new(80,0);
1275
1276     str_numset(str,n);
1277     return str;
1278 }
1279
1280 /* make an exact duplicate of old */
1281
1282 STR *
1283 str_smake(old)
1284 register STR *old;
1285 {
1286     register STR *new = Str_new(81,0);
1287
1288     if (!old)
1289         return Nullstr;
1290     if (old->str_state == SS_FREE) {
1291         warn("semi-panic: attempt to dup freed string");
1292         return Nullstr;
1293     }
1294     if (old->str_state == SS_INCR && !(old->str_pok & 2))
1295         Str_Grow(old,0);
1296     if (new->str_ptr)
1297         Safefree(new->str_ptr);
1298     Copy(old,new,1,STR);
1299     if (old->str_ptr)
1300         new->str_ptr = nsavestr(old->str_ptr,old->str_len);
1301     return new;
1302 }
1303
1304 str_reset(s,stash)
1305 register char *s;
1306 HASH *stash;
1307 {
1308     register HENT *entry;
1309     register STAB *stab;
1310     register STR *str;
1311     register int i;
1312     register SPAT *spat;
1313     register int max;
1314
1315     if (!*s) {          /* reset ?? searches */
1316         for (spat = stash->tbl_spatroot;
1317           spat != Nullspat;
1318           spat = spat->spat_next) {
1319             spat->spat_flags &= ~SPAT_USED;
1320         }
1321         return;
1322     }
1323
1324     /* reset variables */
1325
1326     if (!stash->tbl_array)
1327         return;
1328     while (*s) {
1329         i = *s;
1330         if (s[1] == '-') {
1331             s += 2;
1332         }
1333         max = *s++;
1334         for ( ; i <= max; i++) {
1335             for (entry = stash->tbl_array[i];
1336               entry;
1337               entry = entry->hent_next) {
1338                 stab = (STAB*)entry->hent_val;
1339                 str = stab_val(stab);
1340                 str->str_cur = 0;
1341                 str->str_nok = 0;
1342 #ifdef TAINT
1343                 str->str_tainted = tainted;
1344 #endif
1345                 if (str->str_ptr != Nullch)
1346                     str->str_ptr[0] = '\0';
1347                 if (stab_xarray(stab)) {
1348                     aclear(stab_xarray(stab));
1349                 }
1350                 if (stab_xhash(stab)) {
1351                     hclear(stab_xhash(stab), FALSE);
1352                     if (stab == envstab)
1353                         environ[0] = Nullch;
1354                 }
1355             }
1356         }
1357     }
1358 }
1359
1360 #ifdef TAINT
1361 taintproper(s)
1362 char *s;
1363 {
1364 #ifdef DEBUGGING
1365     if (debug & 2048)
1366         fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
1367 #endif
1368     if (tainted && (!euid || euid != uid || egid != gid)) {
1369         if (!unsafe)
1370             fatal("%s", s);
1371         else if (dowarn)
1372             warn("%s", s);
1373     }
1374 }
1375
1376 taintenv()
1377 {
1378     register STR *envstr;
1379
1380     envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
1381     if (envstr == &str_undef || envstr->str_tainted) {
1382         tainted = 1;
1383         if (envstr->str_tainted == 2)
1384             taintproper("Insecure directory in PATH");
1385         else
1386             taintproper("Insecure PATH");
1387     }
1388     envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
1389     if (envstr != &str_undef && envstr->str_tainted) {
1390         tainted = 1;
1391         taintproper("Insecure IFS");
1392     }
1393 }
1394 #endif /* TAINT */