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