/* * tclGlob.c -- * * This file provides procedures and commands for file name * manipulation, such as tilde expansion and globbing. * * Copyright (c) 1990-1993 The Regents of the University of California. * All rights reserved. * * Permission is hereby granted, without written agreement and without * license or royalty fees, to use, copy, modify, and distribute this * software and its documentation for any purpose, provided that the * above copyright notice and the following two paragraphs appear in * all copies of this software. * * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. */ #ifndef lint static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGlob.c,v 1.36 93/10/14 15:14:08 ouster Exp $ SPRITE (Berkeley)"; #endif /* not lint */ #include "tclInt.h" #include "tclUnix.h" /* * The structure below is used to keep track of a globbing result * being built up (i.e. a partial list of file names). The list * grows dynamically to be as big as needed. */ typedef struct { char *result; /* Pointer to result area. */ int totalSpace; /* Total number of characters allocated * for result. */ int spaceUsed; /* Number of characters currently in use * to hold the partial result (not including * the terminating NULL). */ int dynamic; /* 0 means result is static space, 1 means * it's dynamic. */ } GlobResult; /* * Declarations for procedures local to this file: */ static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir, char *rem)); /* *---------------------------------------------------------------------- * * DoGlob -- * * This recursive procedure forms the heart of the globbing * code. It performs a depth-first traversal of the tree * given by the path name to be globbed. * * Results: * The return value is a standard Tcl result indicating whether * an error occurred in globbing. After a normal return the * result in interp will be set to hold all of the file names * given by the dir and rem arguments. After an error the * result in interp will hold an error message. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int DoGlob(interp, dir, rem) Tcl_Interp *interp; /* Interpreter to use for error * reporting (e.g. unmatched brace). */ char *dir; /* Name of a directory at which to * start glob expansion. This name * is fixed: it doesn't contain any * globbing chars. */ char *rem; /* Path to glob-expand. */ { /* * When this procedure is entered, the name to be globbed may * already have been partly expanded by ancestor invocations of * DoGlob. The part that's already been expanded is in "dir" * (this may initially be empty), and the part still to expand * is in "rem". This procedure expands "rem" one level, making * recursive calls to itself if there's still more stuff left * in the remainder. */ Tcl_DString newName; /* Holds new name consisting of * dir plus the first part of rem. */ register char *p; register char c; char *openBrace, *closeBrace, *name, *dirName; int gotSpecial, baseLength; int result = TCL_OK; struct stat statBuf; /* * Make sure that the directory part of the name really is a * directory. If the directory name is "", use the name "." * instead, because some UNIX systems don't treat "" like "." * automatically. Keep the "" for use in generating file names, * otherwise "glob foo.c" would return "./foo.c". */ if (*dir == '\0') { dirName = "."; } else { dirName = dir; } if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) { return TCL_OK; } Tcl_DStringInit(&newName); /* * First, find the end of the next element in rem, checking * along the way for special globbing characters. */ gotSpecial = 0; openBrace = closeBrace = NULL; for (p = rem; ; p++) { c = *p; if ((c == '\0') || ((openBrace == NULL) && (c == '/'))) { break; } if ((c == '{') && (openBrace == NULL)) { openBrace = p; } if ((c == '}') && (openBrace != NULL) && (closeBrace == NULL)) { closeBrace = p; } if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) { gotSpecial = 1; } } /* * If there is an open brace in the argument, then make a recursive * call for each element between the braces. In this case, the * recursive call to DoGlob uses the same "dir" that we got. * If there are several brace-pairs in a single name, we just handle * one here, and the others will be handled in recursive calls. */ if (openBrace != NULL) { char *element; if (closeBrace == NULL) { Tcl_ResetResult(interp); interp->result = "unmatched open-brace in file name"; result = TCL_ERROR; goto done; } Tcl_DStringAppend(&newName, rem, openBrace-rem); baseLength = newName.length; for (p = openBrace; *p != '}'; ) { element = p+1; for (p = element; ((*p != '}') && (*p != ',')); p++) { /* Empty loop body. */ } Tcl_DStringAppend(&newName, element, p-element); Tcl_DStringAppend(&newName, closeBrace+1, -1); result = DoGlob(interp, dir, newName.string); if (result != TCL_OK) { goto done; } newName.length = baseLength; } goto done; } /* * Start building up the next-level name with dir plus a slash if * needed to separate it from the next file name. */ Tcl_DStringAppend(&newName, dir, -1); if ((dir[0] != 0) && (newName.string[newName.length-1] != '/')) { Tcl_DStringAppend(&newName, "/", 1); } baseLength = newName.length; /* * If there were any pattern-matching characters, then scan through * the directory to find all the matching names. */ if (gotSpecial) { DIR *d; struct dirent *entryPtr; char savedChar; d = opendir(dirName); if (d == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read directory \"", dirName, "\": ", Tcl_PosixError(interp), (char *) NULL); result = TCL_ERROR; goto done; } /* * Temporarily store a null into rem so that the pattern string * is now null-terminated. */ savedChar = *p; *p = 0; while (1) { entryPtr = readdir(d); if (entryPtr == NULL) { break; } /* * Don't match names starting with "." unless the "." is * present in the pattern. */ if ((*entryPtr->d_name == '.') && (*rem != '.')) { continue; } if (Tcl_StringMatch(entryPtr->d_name, rem)) { newName.length = baseLength; Tcl_DStringAppend(&newName, entryPtr->d_name, -1); if (savedChar == 0) { Tcl_AppendElement(interp, newName.string); } else { result = DoGlob(interp, newName.string, p+1); if (result != TCL_OK) { break; } } } } closedir(d); *p = savedChar; goto done; } /* * The current element is a simple one with no fancy features. Add * it to the new name. If there are more elements still to come, * then recurse to process them. */ Tcl_DStringAppend(&newName, rem, p-rem); if (*p != 0) { result = DoGlob(interp, newName.string, p+1); goto done; } /* * There are no more elements in the pattern. Check to be sure the * file actually exists, then add its name to the list being formed * in interp-result. */ name = newName.string; if (*name == 0) { name = "."; } if (access(name, F_OK) != 0) { goto done; } Tcl_AppendElement(interp, name); done: Tcl_DStringFree(&newName); return result; } /* *---------------------------------------------------------------------- * * Tcl_TildeSubst -- * * Given a name starting with a tilde, produce a name where * the tilde and following characters have been replaced by * the home directory location for the named user. * * Results: * The result is a pointer to a static string containing * the new name. If there was an error in processing the * tilde, then an error message is left in interp->result * and the return value is NULL. The result may be stored * in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr) * to free the name. * * Side effects: * Information may be left in bufferPtr. * *---------------------------------------------------------------------- */ char * Tcl_TildeSubst(interp, name, bufferPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ char *name; /* File name, which may begin with "~/" * (to indicate current user's home directory) * or "~/" (to indicate any user's * home directory). */ Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold * anything at the time of the call, and need * not even be initialized. */ { char *dir; register char *p; Tcl_DStringInit(bufferPtr); if (name[0] != '~') { return name; } if ((name[1] == '/') || (name[1] == '\0')) { dir = getenv("HOME"); if (dir == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't find HOME environment ", "variable to expand \"", name, "\"", (char *) NULL); return NULL; } Tcl_DStringAppend(bufferPtr, dir, -1); Tcl_DStringAppend(bufferPtr, name+1, -1); } else { struct passwd *pwPtr; for (p = &name[1]; (*p != 0) && (*p != '/'); p++) { /* Null body; just find end of name. */ } Tcl_DStringAppend(bufferPtr, name+1, p - (name+1)); pwPtr = getpwnam(bufferPtr->string); if (pwPtr == NULL) { endpwent(); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "user \"", bufferPtr->string, "\" doesn't exist", (char *) NULL); return NULL; } Tcl_DStringFree(bufferPtr); Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1); Tcl_DStringAppend(bufferPtr, p, -1); endpwent(); } return bufferPtr->string; } /* *---------------------------------------------------------------------- * * Tcl_GlobCmd -- * * This procedure is invoked to process the "glob" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_GlobCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { int i, result, noComplain, firstArg; if (argc < 2) { notEnoughArgs: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?switches? name ?name ...?\"", (char *) NULL); return TCL_ERROR; } noComplain = 0; for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-'); firstArg++) { if (strcmp(argv[firstArg], "-nocomplain") == 0) { noComplain = 1; } else if (strcmp(argv[firstArg], "--") == 0) { firstArg++; break; } else { Tcl_AppendResult(interp, "bad switch \"", argv[firstArg], "\": must be -nocomplain or --", (char *) NULL); return TCL_ERROR; } } if (firstArg >= argc) { goto notEnoughArgs; } for (i = firstArg; i < argc; i++) { char *thisName; Tcl_DString buffer; thisName = Tcl_TildeSubst(interp, argv[i], &buffer); if (thisName == NULL) { return TCL_ERROR; } if (*thisName == '/') { if (thisName[1] == '/') { /* * This is a special hack for systems like those from Apollo * where there is a super-root at "//": need to treat the * double-slash as a single name. */ result = DoGlob(interp, "//", thisName+2); } else { result = DoGlob(interp, "/", thisName+1); } } else { result = DoGlob(interp, "", thisName); } Tcl_DStringFree(&buffer); if (result != TCL_OK) { return result; } } if ((*interp->result == 0) && !noComplain) { char *sep = ""; Tcl_AppendResult(interp, "no files matched glob pattern", (argc == 2) ? " \"" : "s \"", (char *) NULL); for (i = firstArg; i < argc; i++) { Tcl_AppendResult(interp, sep, argv[i], (char *) NULL); sep = " "; } Tcl_AppendResult(interp, "\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; }