/* 
 * tclUnixFile.c --
 *
 *      This file contains wrappers around UNIX file handling functions.
 *      These wrappers mask differences between Windows and UNIX.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixFile.c,v 1.18 2002/02/15 14:28:50 dkf Exp $
 * RCS: @(#) $Id: tclUnixFile.c,v 1.19 2002/03/24 11:41:51 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);


/*
 *---------------------------------------------------------------------------
 *
 * TclpFindExecutable --
 *

    Tcl_Obj *resultPtr;		/* List object to lappend results. */
    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
    CONST char *pattern;	/* Pattern to match against. */
    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    CONST char *native, *fname, *dirName;
    CONST char *native;
    DIR *d;
    Tcl_DString ds;
    Tcl_StatBuf statBuf;
    int matchHidden;
    int nativeDirLen;
    int result = TCL_OK;
    Tcl_DString dsOrig;
    Tcl_Obj *fileNamePtr;
    int baseLength;

    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
    if (fileNamePtr == NULL) {
	return TCL_ERROR;
    }
    
    if (pattern == NULL || (*pattern == '\0')) {
	/* Match a file directly */
	CONST char *native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
	if (NativeMatchType(native, types)) {
	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	}
	return TCL_OK;
    } else {
	CONST char *fname, *dirName;
	DIR *d;
	Tcl_DString ds;
	Tcl_StatBuf statBuf;
	int matchHidden;
	int nativeDirLen;
	int result = TCL_OK;
	Tcl_DString dsOrig;
	int baseLength;
	
    Tcl_DStringInit(&dsOrig);
    Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
    baseLength = Tcl_DStringLength(&dsOrig);
    
    /*
     * 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".
     */
	Tcl_DStringInit(&dsOrig);
	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
	baseLength = Tcl_DStringLength(&dsOrig);
	
	/*
	 * 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 (baseLength == 0) {
	dirName = ".";
    } else {
	dirName = Tcl_DStringValue(&dsOrig);
	/* Make sure we have a trailing directory delimiter */
	if (dirName[baseLength-1] != '/') {
	    dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
	    baseLength++;
	}
    }

    /*
     * Check to see if the pattern needs to compare with hidden files.
     */
	if (baseLength == 0) {
	    dirName = ".";
	} else {
	    dirName = Tcl_DStringValue(&dsOrig);
	    /* Make sure we have a trailing directory delimiter */
	    if (dirName[baseLength-1] != '/') {
		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
		baseLength++;
	    }
	}
	
	/*
	 * Check to see if the pattern needs to compare with hidden files.
	 */

    if ((pattern[0] == '.')
	    || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
	matchHidden = 1;
    } else {
	matchHidden = 0;
    }
	if ((pattern[0] == '.')
		|| ((pattern[0] == '\\') && (pattern[1] == '.'))) {
	    matchHidden = 1;
	} else {
	    matchHidden = 0;
	}

    /*
     * Now open the directory for reading and iterate over the contents.
     */
	/*
	 * Now open the directory for reading and iterate over the contents.
	 */

    native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
	native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);

    if ((Tcl_PlatformStat(native, &statBuf) != 0)	/* INTL: UTF-8. */
	    || !S_ISDIR(statBuf.st_mode)) {
	Tcl_DStringFree(&dsOrig);
	Tcl_DStringFree(&ds);
	return TCL_OK;
    }
	if ((Tcl_PlatformStat(native, &statBuf) != 0)		/* INTL: UTF-8. */
		|| !S_ISDIR(statBuf.st_mode)) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    return TCL_OK;
	}

    d = opendir(native);				/* INTL: Native. */
    if (d == NULL) {
        char savedChar = '\0';
	Tcl_ResetResult(interp);
	Tcl_DStringFree(&ds);
	d = opendir(native);				/* INTL: Native. */
	if (d == NULL) {
	    char savedChar = '\0';
	    Tcl_ResetResult(interp);
	    Tcl_DStringFree(&ds);

	/*
	 * Strip off a trailing '/' if necessary, before reporting the error.
	 */
	    /*
	     * Strip off a trailing '/' if necessary, before reporting the error.
	     */

	if (baseLength > 0) {
	    savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
	    if (savedChar == '/') {
		(Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
	    }
	}
	Tcl_AppendResult(interp, "couldn't read directory \"",
		Tcl_DStringValue(&dsOrig), "\": ",
		Tcl_PosixError(interp), (char *) NULL);
	if (baseLength > 0) {
	    (Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
	}
	Tcl_DStringFree(&dsOrig);
	return TCL_ERROR;
    }
	    if (baseLength > 0) {
		savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
		if (savedChar == '/') {
		    (Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
		}
	    }
	    Tcl_AppendResult(interp, "couldn't read directory \"",
		    Tcl_DStringValue(&dsOrig), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	    if (baseLength > 0) {
		(Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
	    }
	    Tcl_DStringFree(&dsOrig);
	    return TCL_ERROR;
	}

    nativeDirLen = Tcl_DStringLength(&ds);
	nativeDirLen = Tcl_DStringLength(&ds);

    while (1) {
        Tcl_DString utfDs;
	CONST char *utf;
	Tcl_DirEntry *entryPtr;
	
	entryPtr = Tcl_PlatformReaddir(d);		/* INTL: Native. */
	if (entryPtr == NULL) {
	    break;
	}
	if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
	    /* 
	     * We explicitly asked for hidden files, so turn around
	     * and ignore any file which isn't hidden.
	     */
	    if (*entryPtr->d_name != '.') {
	        continue;
	    }
	} else if (!matchHidden && (*entryPtr->d_name == '.')) {
	    /*
	     * Don't match names starting with "." unless the "." is
	     * present in the pattern.
	     */
	    continue;
	}
	while (1) {
	    Tcl_DString utfDs;
	    CONST char *utf;
	    Tcl_DirEntry *entryPtr;
	    
	    entryPtr = Tcl_PlatformReaddir(d);		/* INTL: Native. */
	    if (entryPtr == NULL) {
		break;
	    }
	    if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
		/* 
		 * We explicitly asked for hidden files, so turn around
		 * and ignore any file which isn't hidden.
		 */
		if (*entryPtr->d_name != '.') {
		    continue;
		}
	    } else if (!matchHidden && (*entryPtr->d_name == '.')) {
		/*
		 * Don't match names starting with "." unless the "." is
		 * present in the pattern.
		 */
		continue;
	    }

	/*
	 * Now check to see if the file matches, according to both type
	 * and pattern.  If so, add the file to the result.
	 */
	    /*
	     * Now check to see if the file matches, according to both type
	     * and pattern.  If so, add the file to the result.
	     */

	utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
	if (Tcl_StringMatch(utf, pattern) != 0) {
	    int typeOk = 1;
	    utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
	    if (Tcl_StringMatch(utf, pattern) != 0) {
		int typeOk = 1;

	    Tcl_DStringSetLength(&dsOrig, baseLength);
	    Tcl_DStringAppend(&dsOrig, utf, -1);
	    fname = Tcl_DStringValue(&dsOrig);
	    if (types != NULL) {
		Tcl_DStringSetLength(&dsOrig, baseLength);
		Tcl_DStringAppend(&dsOrig, utf, -1);
		fname = Tcl_DStringValue(&dsOrig);
		if (types != NULL) {
		Tcl_StatBuf buf;
		char *nativeEntry;
		Tcl_DStringSetLength(&ds, nativeDirLen);
		nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
		/* 
		 * The native name of the file is in entryPtr->d_name.
		 * We can use this below.
		 */
		
		if (types->perm != 0) {
		    if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
			/* 
			 * Either the file has disappeared between the
			 * 'readdir' call and the 'stat' call, or
			 * the file is a link to a file which doesn't
			 * exist (which we could ascertain with
			 * lstat), or there is some other strange
			 * problem.  In all these cases, we define this
			 * to mean the file does not match any defined
			 * permission, and therefore it is not 
			 * added to the list of files to return.
			 */
			typeOk = 0;
		    }
		    
		    /* 
		     * readonly means that there are NO write permissions
		     * (even for user), but execute is OK for anybody
		     */
		    char *nativeEntry;
		    Tcl_DStringSetLength(&ds, nativeDirLen);
		    nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
		    typeOk = NativeMatchType(nativeEntry, types);
		}
		if (typeOk) {
		    Tcl_ListObjAppendElement(interp, resultPtr, 
			    Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
		}
	    }
	    Tcl_DStringFree(&utfDs);
	}

	closedir(d);
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&dsOrig);
	return result;
    }
}
static int 
NativeMatchType(
    CONST char* nativeEntry,  /* Native path to check */
    Tcl_GlobTypeData *types)  /* Type description to match against */
{
    Tcl_StatBuf buf;
    if (types == NULL) {
	/* 
	 * Simply check for the file's existence, but do it
	 * with lstat, in case it is a link to a file which
	 * doesn't exist (since that case would not show up
	 * if we used 'access' or 'stat')
	 */
	if (Tcl_PlatformLStat(nativeEntry, &buf) != 0) {
	    return 0;
	}
    } else {
	if (types->perm != 0) {
	    if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
		/* 
		 * Either the file has disappeared between the
		 * 'readdir' call and the 'stat' call, or
		 * the file is a link to a file which doesn't
		 * exist (which we could ascertain with
		 * lstat), or there is some other strange
		 * problem.  In all these cases, we define this
		 * to mean the file does not match any defined
		 * permission, and therefore it is not 
		 * added to the list of files to return.
		 */
		return 0;
	    }
	    
	    /* 
	     * readonly means that there are NO write permissions
	     * (even for user), but execute is OK for anybody
	     */
		    if (typeOk && (
			((types->perm & TCL_GLOB_PERM_RONLY) &&
				(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
			((types->perm & TCL_GLOB_PERM_R) &&
				(access(nativeEntry, R_OK) != 0)) ||
			((types->perm & TCL_GLOB_PERM_W) &&
				(access(nativeEntry, W_OK) != 0)) ||
			((types->perm & TCL_GLOB_PERM_X) &&
				(access(nativeEntry, X_OK) != 0))
			)) {
			typeOk = 0;
		    }
		}
		if (typeOk && (types->type != 0)) {
		    if (types->perm == 0) {
			/* We haven't yet done a stat on the file */
			if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
			    /* Posix error occurred */
			    typeOk = 0;
			}
		    }
	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
			(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
		((types->perm & TCL_GLOB_PERM_R) &&
			(access(nativeEntry, R_OK) != 0)) ||
		((types->perm & TCL_GLOB_PERM_W) &&
			(access(nativeEntry, W_OK) != 0)) ||
		((types->perm & TCL_GLOB_PERM_X) &&
			(access(nativeEntry, X_OK) != 0))
		) {
		return 0;
	    }
	}
	if (types->type != 0) {
	    if (types->perm == 0) {
		/* We haven't yet done a stat on the file */
		if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
		    /* Posix error occurred */
		    return 0;
		}
	    }
		    if (typeOk) {
			/*
			 * In order bcdpfls as in 'find -t'
			 */
			if (
			    ((types->type & TCL_GLOB_TYPE_BLOCK) &&
				    S_ISBLK(buf.st_mode)) ||
			    ((types->type & TCL_GLOB_TYPE_CHAR) &&
				    S_ISCHR(buf.st_mode)) ||
			    ((types->type & TCL_GLOB_TYPE_DIR) &&
				    S_ISDIR(buf.st_mode)) ||
			    ((types->type & TCL_GLOB_TYPE_PIPE) &&
				    S_ISFIFO(buf.st_mode)) ||
			    ((types->type & TCL_GLOB_TYPE_FILE) &&
				    S_ISREG(buf.st_mode))
#ifdef S_ISSOCK
			    || ((types->type & TCL_GLOB_TYPE_SOCK) &&
				    S_ISSOCK(buf.st_mode))
#endif
			    ) {
			    /* Do nothing -- this file is ok */
			} else {
	    /*
	     * In order bcdpfls as in 'find -t'
	     */
	    if (
		((types->type & TCL_GLOB_TYPE_BLOCK) &&
			S_ISBLK(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_CHAR) &&
			S_ISCHR(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_DIR) &&
			S_ISDIR(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_PIPE) &&
			S_ISFIFO(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_FILE) &&
			S_ISREG(buf.st_mode))
    #ifdef S_ISSOCK
		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
			S_ISSOCK(buf.st_mode))
    #endif
		) {
		/* Do nothing -- this file is ok */
	    } else {
			    typeOk = 0;
#ifdef S_ISLNK
			    if ((types->type & TCL_GLOB_TYPE_LINK)
				    && Tcl_PlatformLStat(nativeEntry, &buf)==0
				    && S_ISLNK(buf.st_mode)) {
				typeOk = 1;
			    }
    #ifdef S_ISLNK
		if (types->type & TCL_GLOB_TYPE_LINK) {
		    if (Tcl_PlatformLStat(nativeEntry, &buf) == 0) {
			if (S_ISLNK(buf.st_mode)) {
			    return 1;
			}
#endif
			}
		    }
		    }
		}
		}
	    }
	    if (typeOk) {
    #endif
		Tcl_ListObjAppendElement(interp, resultPtr, 
			Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
		return 0;
	    }
	}
	Tcl_DStringFree(&utfDs);
    }

    closedir(d);
    Tcl_DStringFree(&ds);
    Tcl_DStringFree(&dsOrig);
    return result;
    return 1;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetUserHome --
 *

 */

int 
TclpObjLstat(pathPtr, bufPtr)
    Tcl_Obj *pathPtr;		/* Path of file to stat */
    Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
{
    CONST char *path = Tcl_FSGetNativePath(pathPtr);
    if (path == NULL) {
	return -1;
    } else {
	return Tcl_PlatformLStat(path, bufPtr);
    return Tcl_PlatformLStat(Tcl_FSGetNativePath(pathPtr), bufPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjGetCwd --
 *