home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclUnixFile.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  13.3 KB  |  529 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclUnixFile.c --
  3.  *
  4.  *      This file contains wrappers around UNIX file handling functions.
  5.  *      These wrappers mask differences between Windows and UNIX.
  6.  *
  7.  * Copyright (c) 1995 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclUnixFile.c 1.48 97/07/07 16:38:11
  13.  */
  14.  
  15. #include "tclInt.h"
  16. #include "tclPort.h"
  17.  
  18. /*
  19.  * The variable below caches the name of the current working directory
  20.  * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
  21.  * NULL means the cache needs to be refreshed.
  22.  */
  23.  
  24. static char *currentDir =  NULL;
  25. static int currentDirExitHandlerSet = 0;
  26.  
  27. /*
  28.  * The variable below is set if the exit routine for deleting the string
  29.  * containing the executable name has been registered.
  30.  */
  31.  
  32. static int executableNameExitHandlerSet = 0;
  33.  
  34. extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
  35.  
  36. /*
  37.  * Static routines for this file:
  38.  */
  39.  
  40. static void    FreeCurrentDir _ANSI_ARGS_((ClientData clientData));
  41. static void    FreeExecutableName _ANSI_ARGS_((ClientData clientData));
  42.  
  43. /*
  44.  *----------------------------------------------------------------------
  45.  *
  46.  * FreeCurrentDir --
  47.  *
  48.  *    Frees the string stored in the currentDir variable. This routine
  49.  *    is registered as an exit handler and will be called during shutdown.
  50.  *
  51.  * Results:
  52.  *    None.
  53.  *
  54.  * Side effects:
  55.  *    Frees the memory occuppied by the currentDir value.
  56.  *
  57.  *----------------------------------------------------------------------
  58.  */
  59.  
  60.     /* ARGSUSED */
  61. static void
  62. FreeCurrentDir(clientData)
  63.     ClientData clientData;    /* Not used. */
  64. {
  65.     if (currentDir != (char *) NULL) {
  66.         ckfree(currentDir);
  67.         currentDir = (char *) NULL;
  68.         currentDirExitHandlerSet = 0;
  69.     }
  70. }
  71.  
  72. /*
  73.  *----------------------------------------------------------------------
  74.  *
  75.  * FreeExecutableName --
  76.  *
  77.  *    Frees the string stored in the tclExecutableName variable. This
  78.  *    routine is registered as an exit handler and will be called
  79.  *    during shutdown.
  80.  *
  81.  * Results:
  82.  *    None.
  83.  *
  84.  * Side effects:
  85.  *    Frees the memory occuppied by the tclExecutableName value.
  86.  *
  87.  *----------------------------------------------------------------------
  88.  */
  89.  
  90.     /* ARGSUSED */
  91. static void
  92. FreeExecutableName(clientData)
  93.     ClientData clientData;    /* Not used. */
  94. {
  95.     if (tclExecutableName != (char *) NULL) {
  96.         ckfree(tclExecutableName);
  97.         tclExecutableName = (char *) NULL;
  98.     }
  99. }
  100.  
  101. /*
  102.  *----------------------------------------------------------------------
  103.  *
  104.  * TclChdir --
  105.  *
  106.  *    Change the current working directory.
  107.  *
  108.  * Results:
  109.  *    The result is a standard Tcl result.  If an error occurs and 
  110.  *    interp isn't NULL, an error message is left in interp->result.
  111.  *
  112.  * Side effects:
  113.  *    The working directory for this application is changed.  Also
  114.  *    the cache maintained used by TclGetCwd is deallocated and
  115.  *    set to NULL.
  116.  *
  117.  *----------------------------------------------------------------------
  118.  */
  119.  
  120. int
  121. TclChdir(interp, dirName)
  122.     Tcl_Interp *interp;        /* If non NULL, used for error reporting. */
  123.     char *dirName;             /* Path to new working directory. */
  124. {
  125.     if (currentDir != NULL) {
  126.     ckfree(currentDir);
  127.     currentDir = NULL;
  128.     }
  129.     if (chdir(dirName) != 0) {
  130.     if (interp != NULL) {
  131.         Tcl_AppendResult(interp, "couldn't change working directory to \"",
  132.             dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  133.     }
  134.     return TCL_ERROR;
  135.     }
  136.     return TCL_OK;
  137. }
  138.  
  139. /*
  140.  *----------------------------------------------------------------------
  141.  *
  142.  * TclGetCwd --
  143.  *
  144.  *    Return the path name of the current working directory.
  145.  *
  146.  * Results:
  147.  *    The result is the full path name of the current working
  148.  *    directory, or NULL if an error occurred while figuring it out.
  149.  *    The returned string is owned by the TclGetCwd routine and must
  150.  *    not be freed by the caller.  If an error occurs and interp
  151.  *    isn't NULL, an error message is left in interp->result.
  152.  *
  153.  * Side effects:
  154.  *    The path name is cached to avoid having to recompute it
  155.  *    on future calls;  if it is already cached, the cached
  156.  *    value is returned.
  157.  *
  158.  *----------------------------------------------------------------------
  159.  */
  160.  
  161. char *
  162. TclGetCwd(interp)
  163.     Tcl_Interp *interp;        /* If non NULL, used for error reporting. */
  164. {
  165.     char buffer[MAXPATHLEN+1];
  166.  
  167.     if (currentDir == NULL) {
  168.         if (!currentDirExitHandlerSet) {
  169.             currentDirExitHandlerSet = 1;
  170.             Tcl_CreateExitHandler(FreeCurrentDir, (ClientData) NULL);
  171.         }
  172. #ifdef USEGETWD
  173.     if ((int)getwd(buffer) == (int)NULL) {
  174.         if (interp != NULL) {
  175.         Tcl_AppendResult(interp,
  176.             "error getting working directory name: ",
  177.             buffer, (char *)NULL);
  178.         }
  179.         return NULL;
  180.     }
  181. #else
  182.     if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
  183.         if (interp != NULL) {
  184.         if (errno == ERANGE) {
  185.             Tcl_SetResult(interp,
  186.                 "working directory name is too long",
  187.                     TCL_STATIC);
  188.         } else {
  189.             Tcl_AppendResult(interp,
  190.                 "error getting working directory name: ",
  191.                 Tcl_PosixError(interp), (char *) NULL);
  192.         }
  193.         }
  194.         return NULL;
  195.     }
  196. #endif
  197.     currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
  198.     strcpy(currentDir, buffer);
  199.     }
  200.     return currentDir;
  201. }
  202.  
  203. /*
  204.  *----------------------------------------------------------------------
  205.  *
  206.  * Tcl_FindExecutable --
  207.  *
  208.  *    This procedure computes the absolute path name of the current
  209.  *    application, given its argv[0] value.
  210.  *
  211.  * Results:
  212.  *    None.
  213.  *
  214.  * Side effects:
  215.  *    The variable tclExecutableName gets filled in with the file
  216.  *    name for the application, if we figured it out.  If we couldn't
  217.  *    figure it out, Tcl_FindExecutable is set to NULL.
  218.  *
  219.  *----------------------------------------------------------------------
  220.  */
  221.  
  222. void
  223. Tcl_FindExecutable(argv0)
  224.     char *argv0;        /* The value of the application's argv[0]. */
  225. {
  226.     char *name, *p, *cwd;
  227.     Tcl_DString buffer;
  228.     int length;
  229.     struct stat statBuf;
  230.  
  231.     Tcl_DStringInit(&buffer);
  232.     if (tclExecutableName != NULL) {
  233.     ckfree(tclExecutableName);
  234.     tclExecutableName = NULL;
  235.     }
  236.  
  237.     name = argv0;
  238.     for (p = name; *p != 0; p++) {
  239.     if (*p == '/') {
  240.         /*
  241.          * The name contains a slash, so use the name directly
  242.          * without doing a path search.
  243.          */
  244.  
  245.         goto gotName;
  246.     }
  247.     }
  248.  
  249.     p = getenv("PATH");
  250.     if (p == NULL) {
  251.     /*
  252.      * There's no PATH environment variable; use the default that
  253.      * is used by sh.
  254.      */
  255.  
  256.     p = ":/bin:/usr/bin";
  257.     }
  258.  
  259.     /*
  260.      * Search through all the directories named in the PATH variable
  261.      * to see if argv[0] is in one of them.  If so, use that file
  262.      * name.
  263.      */
  264.  
  265.     while (*p != 0) {
  266.     while (isspace(UCHAR(*p))) {
  267.         p++;
  268.     }
  269.     name = p;
  270.     while ((*p != ':') && (*p != 0)) {
  271.         p++;
  272.     }
  273.     Tcl_DStringSetLength(&buffer, 0);
  274.     if (p != name) {
  275.         Tcl_DStringAppend(&buffer, name, p-name);
  276.         if (p[-1] != '/') {
  277.         Tcl_DStringAppend(&buffer, "/", 1);
  278.         }
  279.     }
  280.     Tcl_DStringAppend(&buffer, argv0, -1);
  281.     if ((access(Tcl_DStringValue(&buffer), X_OK) == 0)
  282.         && (stat(Tcl_DStringValue(&buffer), &statBuf) == 0)
  283.         && S_ISREG(statBuf.st_mode)) {
  284.         name = Tcl_DStringValue(&buffer);
  285.         goto gotName;
  286.     }
  287.     if (*p == 0) {
  288.         break;
  289.     }
  290.     p++;
  291.     }
  292.     goto done;
  293.  
  294.     /*
  295.      * If the name starts with "/" then just copy it to tclExecutableName.
  296.      */
  297.  
  298.     gotName:
  299.     if (name[0] == '/')  {
  300.     tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
  301.     strcpy(tclExecutableName, name);
  302.     goto done;
  303.     }
  304.  
  305.     /*
  306.      * The name is relative to the current working directory.  First
  307.      * strip off a leading "./", if any, then add the full path name of
  308.      * the current working directory.
  309.      */
  310.  
  311.     if ((name[0] == '.') && (name[1] == '/')) {
  312.     name += 2;
  313.     }
  314.     cwd = TclGetCwd((Tcl_Interp *) NULL);
  315.     if (cwd == NULL) {
  316.     tclExecutableName = NULL;
  317.     goto done;
  318.     }
  319.     length = strlen(cwd);
  320.     tclExecutableName = (char *) ckalloc((unsigned)
  321.         (length + strlen(name) + 2));
  322.     strcpy(tclExecutableName, cwd);
  323.     tclExecutableName[length] = '/';
  324.     strcpy(tclExecutableName + length + 1, name);
  325.  
  326.     done:
  327.     Tcl_DStringFree(&buffer);
  328.  
  329.     if (!executableNameExitHandlerSet) {
  330.         executableNameExitHandlerSet = 1;
  331.         Tcl_CreateExitHandler(FreeExecutableName, (ClientData) NULL);
  332.     }
  333. }
  334.  
  335. /*
  336.  *----------------------------------------------------------------------
  337.  *
  338.  * TclGetUserHome --
  339.  *
  340.  *    This function takes the passed in user name and finds the
  341.  *    corresponding home directory specified in the password file.
  342.  *
  343.  * Results:
  344.  *    The result is a pointer to a static string containing
  345.  *    the new name.  If there was an error in processing the
  346.  *    user name then the return value is NULL.  Otherwise the
  347.  *    result is stored in bufferPtr, and the caller must call
  348.  *    Tcl_DStringFree(bufferPtr) to free the result.
  349.  *
  350.  * Side effects:
  351.  *    Information may be left in bufferPtr.
  352.  *
  353.  *----------------------------------------------------------------------
  354.  */
  355.  
  356. char *
  357. TclGetUserHome(name, bufferPtr)
  358.     char *name;            /* User name to use to find home directory. */
  359.     Tcl_DString *bufferPtr;    /* May be used to hold result.  Must not hold
  360.                  * anything at the time of the call, and need
  361.                  * not even be initialized. */
  362. {
  363.     struct passwd *pwPtr;
  364.  
  365.     pwPtr = getpwnam(name);
  366.     if (pwPtr == NULL) {
  367.     endpwent();
  368.     return NULL;
  369.     }
  370.     Tcl_DStringInit(bufferPtr);
  371.     Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
  372.     endpwent();
  373.     return bufferPtr->string;
  374. }
  375.  
  376. /*
  377.  *----------------------------------------------------------------------
  378.  *
  379.  * TclMatchFiles --
  380.  *
  381.  *    This routine is used by the globbing code to search a
  382.  *    directory for all files which match a given pattern.
  383.  *
  384.  * Results: 
  385.  *    If the tail argument is NULL, then the matching files are
  386.  *    added to the interp->result.  Otherwise, TclDoGlob is called
  387.  *    recursively for each matching subdirectory.  The return value
  388.  *    is a standard Tcl result indicating whether an error occurred
  389.  *    in globbing.
  390.  *
  391.  * Side effects:
  392.  *    None.
  393.  *
  394.  *----------------------------------------------------------------------
  395.  */
  396.  
  397. int
  398. TclMatchFiles(interp, separators, dirPtr, pattern, tail)
  399.     Tcl_Interp *interp;        /* Interpreter to receive results. */
  400.     char *separators;        /* Path separators to pass to TclDoGlob. */
  401.     Tcl_DString *dirPtr;    /* Contains path to directory to search. */
  402.     char *pattern;        /* Pattern to match against. */
  403.     char *tail;            /* Pointer to end of pattern. */
  404. {
  405.     char *dirName, *patternEnd = tail;
  406.     char savedChar = 0;        /* Initialization needed only to prevent
  407.                  * compiler warning from gcc. */
  408.     DIR *d;
  409.     struct stat statBuf;
  410.     struct dirent *entryPtr;
  411.     int matchHidden;
  412.     int result = TCL_OK;
  413.     int baseLength = Tcl_DStringLength(dirPtr);
  414.  
  415.     /*
  416.      * Make sure that the directory part of the name really is a
  417.      * directory.  If the directory name is "", use the name "."
  418.      * instead, because some UNIX systems don't treat "" like "."
  419.      * automatically.  Keep the "" for use in generating file names,
  420.      * otherwise "glob foo.c" would return "./foo.c".
  421.      */
  422.  
  423.     if (dirPtr->string[0] == '\0') {
  424.     dirName = ".";
  425.     } else {
  426.     dirName = dirPtr->string;
  427.     }
  428.     if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
  429.     return TCL_OK;
  430.     }
  431.  
  432.     /*
  433.      * Check to see if the pattern needs to compare with hidden files.
  434.      */
  435.  
  436.     if ((pattern[0] == '.')
  437.         || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
  438.     matchHidden = 1;
  439.     } else {
  440.     matchHidden = 0;
  441.     }
  442.  
  443.     /*
  444.      * Now open the directory for reading and iterate over the contents.
  445.      */
  446.  
  447.     d = opendir(dirName);
  448.     if (d == NULL) {
  449.     Tcl_ResetResult(interp);
  450.  
  451.     /*
  452.      * Strip off a trailing '/' if necessary, before reporting the error.
  453.      */
  454.  
  455.     if (baseLength > 0) {
  456.         savedChar = dirPtr->string[baseLength-1];
  457.         if (savedChar == '/') {
  458.         dirPtr->string[baseLength-1] = '\0';
  459.         }
  460.     }
  461.     Tcl_AppendResult(interp, "couldn't read directory \"",
  462.         dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
  463.     if (baseLength > 0) {
  464.         dirPtr->string[baseLength-1] = savedChar;
  465.     }
  466.     return TCL_ERROR;
  467.     }
  468.  
  469.     /*
  470.      * Clean up the end of the pattern and the tail pointer.  Leave
  471.      * the tail pointing to the first character after the path separator
  472.      * following the pattern, or NULL.  Also, ensure that the pattern
  473.      * is null-terminated.
  474.      */
  475.  
  476.     if (*tail == '\\') {
  477.     tail++;
  478.     }
  479.     if (*tail == '\0') {
  480.     tail = NULL;
  481.     } else {
  482.     tail++;
  483.     }
  484.     savedChar = *patternEnd;
  485.     *patternEnd = '\0';
  486.  
  487.     while (1) {
  488.     entryPtr = readdir(d);
  489.     if (entryPtr == NULL) {
  490.         break;
  491.     }
  492.  
  493.     /*
  494.      * Don't match names starting with "." unless the "." is
  495.      * present in the pattern.
  496.      */
  497.  
  498.     if (!matchHidden && (*entryPtr->d_name == '.')) {
  499.         continue;
  500.     }
  501.  
  502.     /*
  503.      * Now check to see if the file matches.  If there are more
  504.      * characters to be processed, then ensure matching files are
  505.      * directories before calling TclDoGlob. Otherwise, just add
  506.      * the file to the result.
  507.      */
  508.  
  509.     if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
  510.         Tcl_DStringSetLength(dirPtr, baseLength);
  511.         Tcl_DStringAppend(dirPtr, entryPtr->d_name, -1);
  512.         if (tail == NULL) {
  513.         Tcl_AppendElement(interp, dirPtr->string);
  514.         } else if ((stat(dirPtr->string, &statBuf) == 0)
  515.             && S_ISDIR(statBuf.st_mode)) {
  516.         Tcl_DStringAppend(dirPtr, "/", 1);
  517.         result = TclDoGlob(interp, separators, dirPtr, tail);
  518.         if (result != TCL_OK) {
  519.             break;
  520.         }
  521.         }
  522.     }
  523.     }
  524.     *patternEnd = savedChar;
  525.  
  526.     closedir(d);
  527.     return result;
  528. }
  529.