str.c

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