cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclglob.c

   1 /*
   2  * tclGlob.c --
   3  *
   4  *      This file provides procedures and commands for file name
   5  *      manipulation, such as tilde expansion and globbing.
   6  *
   7  * Copyright 1990-1991 Regents of the University of California
   8  * Permission to use, copy, modify, and distribute this
   9  * software and its documentation for any purpose and without
  10  * fee is hereby granted, provided that the above copyright
  11  * notice appear in all copies.  The University of California
  12  * makes no representations about the suitability of this
  13  * software for any purpose.  It is provided "as is" without
  14  * express or implied warranty.
  15  */
  16
  17 #ifndef lint
  18 static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGlob.c,v 1.24 92/07/01 08:51:50 ouster Exp $ SPRITE (Berkeley)";
  19 #endif /* not lint */
  20
  21 #include <sys/types.h>
  22
  23 #include "tclint.h"
  24 #include "tclunix.h"
  25
  26 void dvpath(char *);
  27
  28 /*
  29  * The structure below is used to keep track of a globbing result
  30  * being built up (i.e. a partial list of file names).  The list
  31  * grows dynamically to be as big as needed.
  32  */
  33
  34 typedef struct {
  35     char *result;               /* Pointer to result area. */
  36     int totalSpace;             /* Total number of characters allocated
  37                                  * for result. */
  38     int spaceUsed;              /* Number of characters currently in use
  39                                  * to hold the partial result (not including
  40                                  * the terminating NULL). */
  41     int dynamic;                /* 0 means result is static space, 1 means
  42                                  * it's dynamic. */
  43 } GlobResult;
  44
  45 /*
  46  * Declarations for procedures local to this file:
  47  */
  48
  49 static void             AppendResult _ANSI_ARGS_((Tcl_Interp *interp,
  50                             char *dir, char *separator, char *name,
  51                             int nameLength));
  52 static int              DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
  53                             char *rem));
  54 \f
  55 /*
  56  *----------------------------------------------------------------------
  57  *
  58  * AppendResult --
  59  *
  60  *      Given two parts of a file name (directory and element within
  61  *      directory), concatenate the two together and append them to
  62  *      the result building up in interp.
  63  *
  64  * Results:
  65  *      There is no return value.
  66  *
  67  * Side effects:
  68  *      Interp->result gets extended.
  69  *
  70  *----------------------------------------------------------------------
  71  */
  72
  73 static void
  74 AppendResult (
  75     Tcl_Interp *interp,         /* Interpreter whose result should be
  76                                  * appended to. */
  77     char *dir,                  /* Name of directory, without trailing
  78                                  * slash except for root directory. */
  79     char *separator,            /* Separator string so use between dir and
  80                                  * name:  either "/" or "" depending on dir. */
  81     char *name,                 /* Name of file withing directory (NOT
  82                                  * necessarily null-terminated!). */
  83     int nameLength              /* Number of characters in name. */
  84 )
  85 {
  86     int dirFlags, nameFlags;
  87     char *p, saved;
  88
  89     /*
  90      * Next, see if we can put together a valid list element from dir
  91      * and name by calling Tcl_AppendResult.
  92      */
  93
  94     if (*dir == 0) {
  95         dirFlags = 0;
  96     } else {
  97         Tcl_ScanElement(dir, &dirFlags);
  98     }
  99     saved = name[nameLength];
 100     name[nameLength] = 0;
 101     Tcl_ScanElement(name, &nameFlags);
 102     if ((dirFlags == 0) && (nameFlags == 0)) {
 103         if (*interp->result != 0) {
 104             Tcl_AppendResult(interp, " ", dir, separator, name, (char *) NULL);
 105         } else {
 106             Tcl_AppendResult(interp, dir, separator, name, (char *) NULL);
 107         }
 108         name[nameLength] = saved;
 109         return;
 110     }
 111
 112     /*
 113      * This name has weird characters in it, so we have to convert it to
 114      * a list element.  To do that, we have to merge the characters
 115      * into a single name.  To do that, malloc a buffer to hold everything.
 116      */
 117
 118     p = (char *) ckalloc((unsigned) (strlen(dir) + strlen(separator)
 119             + nameLength + 1));
 120     sprintf(p, "%s%s%s", dir, separator, name);
 121     name[nameLength] = saved;
 122     Tcl_AppendElement(interp, p, 0);
 123     ckfree(p);
 124 }
 125 \f
 126 /*
 127  *----------------------------------------------------------------------
 128  *
 129  * DoGlob --
 130  *
 131  *      This recursive procedure forms the heart of the globbing
 132  *      code.  It performs a depth-first traversal of the tree
 133  *      given by the path name to be globbed.
 134  *
 135  * Results:
 136  *      The return value is a standard Tcl result indicating whether
 137  *      an error occurred in globbing.  After a normal return the
 138  *      result in interp will be set to hold all of the file names
 139  *      given by the dir and rem arguments.  After an error the
 140  *      result in interp will hold an error message.
 141  *
 142  * Side effects:
 143  *      None.
 144  *
 145  *----------------------------------------------------------------------
 146  */
 147
 148 static int
 149 DoGlob (
 150     Tcl_Interp *interp,                 /* Interpreter to use for error
 151                                          * reporting (e.g. unmatched brace). */
 152     char *dir,                          /* Name of a directory at which to
 153                                          * start glob expansion.  This name
 154                                          * is fixed: it doesn't contain any
 155                                          * globbing chars. */
 156     char *rem                           /* Path to glob-expand. */
 157 )
 158 {
 159     /*
 160      * When this procedure is entered, the name to be globbed may
 161      * already have been partly expanded by ancestor invocations of
 162      * DoGlob.  The part that's already been expanded is in "dir"
 163      * (this may initially be empty), and the part still to expand
 164      * is in "rem".  This procedure expands "rem" one level, making
 165      * recursive calls to itself if there's still more stuff left
 166      * in the remainder.
 167      */
 168
 169     register char *p;
 170     register char c;
 171     char *openBrace, *closeBrace;
 172     int gotSpecial, result;
 173     char *separator;
 174
 175     /*
 176      * Figure out whether we'll need to add a slash between the directory
 177      * name and file names within the directory when concatenating them
 178      * together.
 179      */
 180
 181     if ((dir[0] == 0) || ((dir[0] == '/') && (dir[1] == 0))) {
 182         separator = "";
 183     } else {
 184         separator = "/";
 185     }
 186
 187     /*
 188      * When generating information for the next lower call,
 189      * use static areas if the name is short, and malloc if the name
 190      * is longer.
 191      */
 192
 193 #define STATIC_SIZE 200
 194
 195     /*
 196      * First, find the end of the next element in rem, checking
 197      * along the way for special globbing characters.
 198      */
 199
 200     gotSpecial = 0;
 201     openBrace = closeBrace = NULL;
 202     for (p = rem; ; p++) {
 203         c = *p;
 204         if ((c == '\0') || (c == '/')) {
 205             break;
 206         }
 207         if ((c == '{') && (openBrace == NULL)) {
 208             openBrace = p;
 209         }
 210         if ((c == '}') && (closeBrace == NULL)) {
 211             closeBrace = p;
 212         }
 213         if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
 214             gotSpecial = 1;
 215         }
 216     }
 217
 218     /*
 219      * If there is an open brace in the argument, then make a recursive
 220      * call for each element between the braces.  In this case, the
 221      * recursive call to DoGlob uses the same "dir" that we got.
 222      * If there are several brace-pairs in a single name, we just handle
 223      * one here, and the others will be handled in recursive calls.
 224      */
 225
 226     if (openBrace != NULL) {
 227         int remLength, l1, l2;
 228         char static1[STATIC_SIZE];
 229         char *element, *newRem;
 230
 231         if (closeBrace == NULL) {
 232             Tcl_ResetResult(interp);
 233             interp->result = "unmatched open-brace in file name";
 234             return TCL_ERROR;
 235         }
 236         remLength = strlen(rem) + 1;
 237         if (remLength <= STATIC_SIZE) {
 238             newRem = static1;
 239         } else {
 240             newRem = (char *) ckalloc((unsigned) remLength);
 241         }
 242         l1 = openBrace-rem;
 243         strncpy(newRem, rem, l1);
 244         p = openBrace;
 245         for (p = openBrace; *p != '}'; ) {
 246             element = p+1;
 247             for (p = element; ((*p != '}') && (*p != ',')); p++) {
 248                 /* Empty loop body:  just find end of this element. */
 249             }
 250             l2 = p - element;
 251             strncpy(newRem+l1, element, l2);
 252             strcpy(newRem+l1+l2, closeBrace+1);
 253             if (DoGlob(interp, dir, newRem) != TCL_OK) {
 254                 return TCL_ERROR;
 255             }
 256         }
 257         if (remLength > STATIC_SIZE) {
 258             ckfree(newRem);
 259         }
 260         return TCL_OK;
 261     }
 262
 263     /*
 264      * If there were any pattern-matching characters, then scan through
 265      * the directory to find all the matching names.
 266      */
 267
 268     if (gotSpecial) {
 269         DIR *d;
 270         struct dirent *entryPtr;
 271         int l1, l2;
 272         char *pattern, *newDir, *dirName;
 273         char static1[STATIC_SIZE], static2[STATIC_SIZE];
 274         struct stat statBuf;
 275
 276         /*
 277          * Be careful not to do any actual file system operations on a
 278          * directory named "";  instead, use ".".  This is needed because
 279          * some versions of UNIX don't treat "" like "." automatically.
 280          */
 281
 282         if (*dir == '\0') {
 283             dirName = ".";
 284         } else {
 285             dirName = dir;
 286         }
 287         if ((stat(dirName, &statBuf) != 0)
 288                 || ((statBuf.st_mode & S_IFMT) != S_IFDIR)) {
 289             return TCL_OK;
 290         }
 291         d = opendir(dirName);
 292         if (d == NULL) {
 293             Tcl_ResetResult(interp);
 294             Tcl_AppendResult(interp, "couldn't read directory \"",
 295                     dirName, "\": ", Tcl_UnixError(interp), (char *) NULL);
 296             return TCL_ERROR;
 297         }
 298         l1 = strlen(dir);
 299         l2 = (p - rem);
 300         if (l2 < STATIC_SIZE) {
 301             pattern = static2;
 302         } else {
 303             pattern = (char *) ckalloc((unsigned) (l2+1));
 304         }
 305         strncpy(pattern, rem, l2);
 306         pattern[l2] = '\0';
 307         result = TCL_OK;
 308         while (1) {
 309             entryPtr = readdir(d);
 310             if (entryPtr == NULL) {
 311                 break;
 312             }
 313
 314             /*
 315              * Don't match names starting with "." unless the "." is
 316              * present in the pattern.
 317              */
 318
 319             if ((*entryPtr->d_name == '.') && (*pattern != '.')) {
 320                 continue;
 321             }
 322             if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
 323                 int nameLength = strlen(entryPtr->d_name);
 324                 if (*p == 0) {
 325                     AppendResult(interp, dir, separator, entryPtr->d_name,
 326                             nameLength);
 327                 } else {
 328                     if ((l1+nameLength+2) <= STATIC_SIZE) {
 329                         newDir = static1;
 330                     } else {
 331                         newDir = (char *) ckalloc((unsigned) (l1+nameLength+2));
 332                     }
 333                     sprintf(newDir, "%s%s%s", dir, separator, entryPtr->d_name);
 334                     result = DoGlob(interp, newDir, p+1);
 335                     if (newDir != static1) {
 336                         ckfree(newDir);
 337                     }
 338                     if (result != TCL_OK) {
 339                         break;
 340                     }
 341                 }
 342             }
 343         }
 344         closedir(d);
 345         if (pattern != static2) {
 346             ckfree(pattern);
 347         }
 348         return result;
 349     }
 350
 351     /*
 352      * This is the simplest case:  just another path element.  Move
 353      * it to the dir side and recurse (or just add the name to the
 354      * list, if we're at the end of the path).
 355      */
 356
 357     if (*p == 0) {
 358         AppendResult(interp, dir, separator, rem, p-rem);
 359     } else {
 360         int l1, l2;
 361         char *newDir;
 362         char static1[STATIC_SIZE];
 363
 364         l1 = strlen(dir);
 365         l2 = l1 + (p - rem) + 2;
 366         if (l2 <= STATIC_SIZE) {
 367             newDir = static1;
 368         } else {
 369             newDir = (char *) ckalloc((unsigned) l2);
 370         }
 371         sprintf(newDir, "%s%s%.*s", dir, separator, p-rem, rem);
 372         result = DoGlob(interp, newDir, p+1);
 373         if (newDir != static1) {
 374             ckfree(newDir);
 375         }
 376         if (result != TCL_OK) {
 377             return TCL_ERROR;
 378         }
 379     }
 380     return TCL_OK;
 381 }
 382 \f
 383 /*
 384  *----------------------------------------------------------------------
 385  *
 386  * Tcl_TildeSubst --
 387  *
 388  *      Given a name starting with a tilde, produce a name where
 389  *      the tilde and following characters have been replaced by
 390  *      the home directory location for the named user.
 391  *
 392  * Results:
 393  *      The result is a pointer to a static string containing
 394  *      the new name.  This name will only persist until the next
 395  *      call to Tcl_TildeSubst;  save it if you care about it for
 396  *      the long term.  If there was an error in processing the
 397  *      tilde, then an error message is left in interp->result
 398  *      and the return value is NULL.
 399  *
 400  * Side effects:
 401  *      None that the caller needs to worry about.
 402  *
 403  *----------------------------------------------------------------------
 404  */
 405
 406 char *
 407 Tcl_TildeSubst (
 408     Tcl_Interp *interp,         /* Interpreter in which to store error
 409                                  * message (if necessary). */
 410     char *name                  /* File name, which may begin with "~/"
 411                                  * (to indicate current user's home directory)
 412                                  * or "~<user>/" (to indicate any user's
 413                                  * home directory). */
 414 )
 415 {
 416 #define STATIC_BUF_SIZE 50
 417     static char staticBuf[STATIC_BUF_SIZE];
 418     static int curSize = STATIC_BUF_SIZE;
 419     static char *curBuf = staticBuf;
 420     char *dir;
 421     int length;
 422     int fromPw = 0;
 423     register char *p;
 424
 425     if (name[0] != '~') {
 426         return name;
 427     }
 428
 429 #ifdef MSDOS
 430     dvpath(dir);
 431     if (name[1] != '/') {
 432         strcat(dir,"/");
 433         p = name;
 434     }
 435     else
 436         p = name +1;
 437 #else
 438
 439     /*
 440      * First, find the directory name corresponding to the tilde entry.
 441      */
 442
 443     if ((name[1] == '/') || (name[1] == '\0')) {
 444         dir = getenv("HOME");
 445         if (dir == NULL) {
 446             Tcl_ResetResult(interp);
 447             Tcl_AppendResult(interp, "couldn't find HOME environment ",
 448                     "variable to expand \"", name, "\"", (char *) NULL);
 449             return NULL;
 450         }
 451         p = name+1;
 452     } else {
 453         struct passwd *pwPtr;
 454
 455         for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
 456             /* Null body;  just find end of name. */
 457         }
 458         length = p-&name[1];
 459         if (length >= curSize) {
 460             length = curSize-1;
 461         }
 462         memcpy((VOID *) curBuf, (VOID *) (name+1), length);
 463         curBuf[length] = '\0';
 464         pwPtr = getpwnam(curBuf);
 465         if (pwPtr == NULL) {
 466             Tcl_ResetResult(interp);
 467             Tcl_AppendResult(interp, "user \"", curBuf,
 468                     "\" doesn't exist", (char *) NULL);
 469             return NULL;
 470         }
 471         dir = pwPtr->pw_dir;
 472         fromPw = 1;
 473     }
 474 #endif
 475
 476     /*
 477      * Grow the buffer if necessary to make enough space for the
 478      * full file name.
 479      */
 480
 481     length = strlen(dir) + strlen(p);
 482     if (length >= curSize) {
 483         if (curBuf != staticBuf) {
 484             ckfree(curBuf);
 485         }
 486         curSize = length + 1;
 487         curBuf = (char *) ckalloc((unsigned) curSize);
 488     }
 489
 490     /*
 491      * Finally, concatenate the directory name with the remainder
 492      * of the path in the buffer.
 493      */
 494
 495     strcpy(curBuf, dir);
 496     strcat(curBuf, p);
 497 #ifndef MSDOS
 498     if (fromPw) {
 499         endpwent();
 500     }
 501 #endif
 502     return curBuf;
 503 }
 504 \f
 505 /*
 506  *----------------------------------------------------------------------
 507  *
 508  * Tcl_GlobCmd --
 509  *
 510  *      This procedure is invoked to process the "glob" Tcl command.
 511  *      See the user documentation for details on what it does.
 512  *
 513  * Results:
 514  *      A standard Tcl result.
 515  *
 516  * Side effects:
 517  *      See the user documentation.
 518  *
 519  *----------------------------------------------------------------------
 520  */
 521
 522         /* ARGSUSED */
 523 int
 524 Tcl_GlobCmd (
 525     ClientData dummy,                   /* Not used. */
 526     Tcl_Interp *interp,                 /* Current interpreter. */
 527     int argc,                           /* Number of arguments. */
 528     char **argv                 /* Argument strings. */
 529 )
 530 {
 531     int i, result, noComplain;
 532
 533     if (argc < 2) {
 534         notEnoughArgs:
 535         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 536                 " ?-nocomplain? name ?name ...?\"", (char *) NULL);
 537         return TCL_ERROR;
 538     }
 539     noComplain = 0;
 540     if ((argv[1][0] == '-') && (strcmp(argv[1], "-nocomplain") == 0)) {
 541         if (argc < 3) {
 542             goto notEnoughArgs;
 543         }
 544         noComplain = 1;
 545     }
 546
 547     for (i = 1 + noComplain; i < argc; i++) {
 548         char *thisName;
 549
 550         /*
 551          * Do special checks for names starting at the root and for
 552          * names beginning with ~.  Then let DoGlob do the rest.
 553          */
 554
 555         thisName = argv[i];
 556         if (*thisName == '~') {
 557             thisName = Tcl_TildeSubst(interp, thisName);
 558             if (thisName == NULL) {
 559                 return TCL_ERROR;
 560             }
 561         }
 562         if (*thisName == '/') {
 563             result = DoGlob(interp, "/", thisName+1);
 564         } else {
 565             result = DoGlob(interp, "", thisName);
 566         }
 567         if (result != TCL_OK) {
 568             return result;
 569         }
 570     }
 571     if ((*interp->result == 0) && !noComplain) {
 572         char *sep = "";
 573
 574         Tcl_AppendResult(interp, "no files matched glob pattern",
 575                 (argc == 2) ? " \"" : "s \"", (char *) NULL);
 576         for (i = 1; i < argc; i++) {
 577             Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
 578             sep = " ";
 579         }
 580         Tcl_AppendResult(interp, "\"", (char *) NULL);
 581         return TCL_ERROR;
 582     }
 583     return TCL_OK;
 584 }