tclfcmd.c

linux系统下的音频通信

 * Side effects:
 *	Target is overwritten if the force flag is set.  Attempting to
 *	copy/rename a file onto a directory or a directory onto a file
 *	will always result in an error.  
 *
 *----------------------------------------------------------------------
 */

static int
CopyRenameOneFile(interp, source, target, copyFlag, force) 
    Tcl_Interp *interp;		/* Used for error reporting. */
    char *source;		/* Pathname of file to copy.  May need to
				 * be translated. */
    char *target;		/* Pathname of file to create/overwrite.
				 * May need to be translated. */
    int copyFlag;		/* If non-zero, copy files.  Otherwise,
				 * rename them. */
    int force;			/* If non-zero, overwrite target file if it
				 * exists.  Otherwise, error if target already
				 * exists. */
{
    int result;
    Tcl_DString sourcePath, targetPath, errorBuffer;
    char *targetName, *sourceName, *errfile;
    struct stat sourceStatBuf, targetStatBuf;
	
    sourceName = Tcl_TranslateFileName(interp, source, &sourcePath);
    if (sourceName == NULL) {
	return TCL_ERROR;
    }
    targetName = Tcl_TranslateFileName(interp, target, &targetPath);
    if (targetName == NULL) {
	Tcl_DStringFree(&sourcePath);
	return TCL_ERROR;
    }
    
    errfile = NULL;
    result = TCL_ERROR;
    Tcl_DStringInit(&errorBuffer);
    
    /*
     * We want to copy/rename links and not the files they point to, so we
     * use lstat(). If target is a link, we also want to replace the 
     * link and not the file it points to, so we also use lstat() on the
     * target.
     */

    if (lstat(sourceName, &sourceStatBuf) != 0) {
	errfile = source;
	goto done;
    }
    if (lstat(targetName, &targetStatBuf) != 0) {
	if (errno != ENOENT) {
	    errfile = target;
	    goto done;
	}
    } else {
	if (force == 0) {
	    errno = EEXIST;
	    errfile = target;
	    goto done;
	}

        /* 
         * Prevent copying or renaming a file onto itself.  Under Windows, 
         * stat always returns 0 for st_ino.  However, the Windows-specific 
         * code knows how to deal with copying or renaming a file on top of
         * itself.  It might be a good idea to write a stat that worked.
         */
     
        if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
            if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
            	    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
            	result = TCL_OK;
            	goto done;
            }
        }

	/*
	 * Prevent copying/renaming a file onto a directory and
	 * vice-versa.  This is a policy decision based on the fact that
	 * existing implementations of copy and rename on all platforms
	 * also prevent this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
                && !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_AppendResult(interp, "can't overwrite file \"", target,
		    "\" with directory \"", source, "\"", (char *) NULL);
	    goto done;
	}
	if (!S_ISDIR(sourceStatBuf.st_mode)
	        && S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_AppendResult(interp, "can't overwrite directory \"", target, 
	            "\" with file \"", source, "\"", (char *) NULL);
	    goto done;
	}
    }

    if (copyFlag == 0) {
	result = TclpRenameFile(sourceName, targetName);
	if (result == TCL_OK) {
	    goto done;
	}
	    
	if (errno == EINVAL) {
	    Tcl_AppendResult(interp, "error renaming \"", source, "\" to \"",
		    target, "\": trying to rename a volume or ",
		    "move a directory into itself", (char *) NULL);
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}
	
	/*
	 * The rename failed because the move was across file systems.
	 * Fall through to copy file and then remove original.  Note that
	 * the low-level TclpRenameFile is allowed to implement
	 * cross-filesystem moves itself.
	 */
    }

    if (S_ISDIR(sourceStatBuf.st_mode)) {
	result = TclpCopyDirectory(sourceName, targetName, &errorBuffer);
	if (result != TCL_OK) {
	    errfile = Tcl_DStringValue(&errorBuffer);
	    if (strcmp(errfile, sourceName) == 0) {
		errfile = source;
	    } else if (strcmp(errfile, targetName) == 0) {
		errfile = target;
	    }
	}
    } else {
	result = TclpCopyFile(sourceName, targetName);
	if (result != TCL_OK) {
	    /*
	     * Well, there really shouldn't be a problem with source,
	     * because up there we checked to see if it was ok to copy it.
	     */

	    errfile = target;
	}
    }
    if ((copyFlag == 0) && (result == TCL_OK)) {
	if (S_ISDIR(sourceStatBuf.st_mode)) {
	    result = TclpRemoveDirectory(sourceName, 1, &errorBuffer);
	    if (result != TCL_OK) {
		errfile = Tcl_DStringValue(&errorBuffer);
		if (strcmp(errfile, sourceName) == 0) {
		    errfile = source;
		}
	    }
	} else {
	    result = TclpDeleteFile(sourceName);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    Tcl_AppendResult(interp, "can't unlink \"", errfile, "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	    errfile = NULL;
	}
    }
    
    done:
    if (errfile != NULL) {
	Tcl_AppendResult(interp, 
		((copyFlag) ? "error copying \"" : "error renaming \""),
		source, (char *) NULL);
	if (errfile != source) {
	    Tcl_AppendResult(interp, "\" to \"", target, (char *) NULL);
	    if (errfile != target) {
		Tcl_AppendResult(interp, "\": \"", errfile, (char *) NULL);
	    }
	}
	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
		(char *) NULL);
    }
    Tcl_DStringFree(&errorBuffer);
    Tcl_DStringFree(&sourcePath);
    Tcl_DStringFree(&targetPath);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * FileForceOption --
 *
 *	Helps parse command line options for file commands that take
 *	the "-force" and "--" options.
 *
 * Results:
 *	The return value is how many arguments from argv were consumed
 *	by this function, or -1 if there was an error parsing the
 *	options.  If an error occurred, an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
FileForceOption(interp, argc, argv, forcePtr)
    Tcl_Interp *interp;		/* Interp, for error return. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  First command line
    option, if it exists, begins at */
    int *forcePtr;		/* If the "-force" was specified, *forcePtr
				 * is filled with 1, otherwise with 0. */
{
    int force, i;
    
    force = 0;
    for (i = 0; i < argc; i++) {
	if (argv[i][0] != '-') {
	    break;
	}
	if (strcmp(argv[i], "-force") == 0) {
	    force = 1;
	} else if (strcmp(argv[i], "--") == 0) {
	    i++;
	    break;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", argv[i], 
		    "\": should be -force or --", (char *)NULL);
	    return -1;
	}
    }
    *forcePtr = force;
    return i;
}
/*
 *---------------------------------------------------------------------------
 *
 * FileBasename --
 *
 *	Given a path in either tcl format (with / separators), or in the
 *	platform-specific format for the current platform, return all the
 *	characters in the path after the last directory separator.  But,
 *	if path is the root directory, returns no characters.
 *
 * Results:
 *	Appends the string that represents the basename to the end of
 *	the specified initialized DString, returning a pointer to the
 *	resulting string.  If there is an error, an error message is left
 *	in interp, NULL is returned, and the Tcl_DString is unmodified.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static char *
FileBasename(interp, path, bufferPtr)
    Tcl_Interp *interp;		/* Interp, for error return. */
    char *path;			/* Path whose basename to extract. */
    Tcl_DString *bufferPtr;	/* Initialized DString that receives
				 * basename. */
{
    int argc;
    char **argv;
    
    Tcl_SplitPath(path, &argc, &argv);
    if (argc == 0) {
	Tcl_DStringInit(bufferPtr);
    } else {
	if ((argc == 1) && (*path == '~')) {
	    Tcl_DString buffer;
	    
	    ckfree((char *) argv);
	    path = Tcl_TranslateFileName(interp, path, &buffer);
	    if (path == NULL) {
		return NULL;
	    }
	    Tcl_SplitPath(path, &argc, &argv);
	    Tcl_DStringFree(&buffer);
	}
	Tcl_DStringInit(bufferPtr);

	/*
	 * Return the last component, unless it is the only component, and it
	 * is the root of an absolute path.
	 */

	if (argc > 0) {
	    if ((argc > 1)
		    || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
		Tcl_DStringAppend(bufferPtr, argv[argc - 1], -1);
	    }
	}
    }
    ckfree((char *) argv);
    return Tcl_DStringValue(bufferPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFileAttrsCmd --
 *
 *      Sets or gets the platform-specific attributes of a file. The objc-objv
 *	points to the file name with the rest of the command line following.
 *	This routine uses platform-specific tables of option strings
 *	and callbacks. The callback to get the attributes take three
 *	parameters:
 *	    Tcl_Interp *interp;	    The interp to report errors with.
 *				    Since this is an object-based API,
 *				    the object form of the result should be
 *				    used.
 *	    CONST char *fileName;   This is extracted using
 *				    Tcl_TranslateFileName.
 *	    TclObj **attrObjPtrPtr; A new object to hold the attribute
 *				    is allocated and put here.
 *	The first two parameters of the callback used to write out the
 *	attributes are the same. The third parameter is:
 *	    CONST *attrObjPtr;	    A pointer to the object that has
 *				    the new attribute.
 *	They both return standard TCL errors; if the routine to get
 *	an attribute fails, no object is allocated and *attrObjPtrPtr
 *	is unchanged.
 *
 * Results:
 *      Standard TCL error.
 *
 * Side effects:
 *      May set file attributes for the file name.
 *      
 *----------------------------------------------------------------------
 */

int
TclFileAttrsCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int objc;			/* Number of command line arguments. */
    Tcl_Obj *CONST objv[];	/* The command line objects. */
{
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    char *fileName;
    int length, index;
    Tcl_Obj *listObjPtr;
    Tcl_Obj *elementObjPtr;
    Tcl_DString buffer;

    if ((objc > 2) && ((objc % 2) == 0)) {
	Tcl_AppendStringsToObj(resultPtr, 
		"wrong # args: must be \"file attributes name ?option? ?value? ?option value? ...\"",
		(char *) NULL);
	return TCL_ERROR;
    }

    fileName = Tcl_GetStringFromObj(objv[0], &length);
    if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
    	return TCL_ERROR;
    }
    fileName = Tcl_DStringValue(&buffer);
    
    if (objc == 1) {
    	listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    	
    	for (index = 0; tclpFileAttrStrings[index] != NULL; index++) {
    	    elementObjPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1);
	    Tcl_ListObjAppendElement(interp, listObjPtr, elementObjPtr);
	    if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
	    	    &elementObjPtr) != TCL_OK) {
	    	Tcl_DecrRefCount(listObjPtr);
	    	return TCL_ERROR;
	    }
	    Tcl_ListObjAppendElement(interp, listObjPtr, elementObjPtr);
    	}
    	Tcl_SetObjResult(interp, listObjPtr);
    } else if (objc == 2) {
    	if (Tcl_GetIndexFromObj(interp, objv[1], tclpFileAttrStrings, "option",
    		0, &index) != TCL_OK) {
    	    return TCL_ERROR;
    	}
	if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
		&elementObjPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, elementObjPtr);
    } else {
        int i;
        
    	for (i = 1; i < objc ; i += 2) {
    	    if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings, "option",
    	    	    0, &index) != TCL_OK) {
    	    	return TCL_ERROR;
    	    }
    	    if ((*tclpFileAttrProcs[index].setProc)(interp, index, fileName,
    	    	    objv[i + 1]) != TCL_OK) {
    	    	return TCL_ERROR;
    	    }
    	}
    }
    
    Tcl_DStringFree(&buffer);
    
    return TCL_OK;
}