Return to tclglob.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tcl

Annotation of micropolis/src/tcl/tclglob.c, revision 1.1

1.1     ! root        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: 
        !            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: 
        !           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: 
        !           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: 
        !           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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.