view release on metacpan or  search on metacpan

pTk/mTk/tclUnix/tclUnixFCmd.c  view on Meta::CPAN

    }

    sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));

    *attributePtrPtr = Tcl_NewStringObj(returnString, -1);

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetGroupAttribute --
 *
 *      Sets the group of the file to the specified group.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      As above.
 *
 *---------------------------------------------------------------------------
 */

static int
SetGroupAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;		    /* The interp for error reporting. */
    int objIndex;		    /* The index of the attribute. */
    Tcl_Obj *fileName;	            /* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr;	    /* New group for file. */
{
    long gid;
    int result;
    CONST char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr;
	CONST char *string;
	int length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	groupPtr = getgrnam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (groupPtr == NULL) {
	    endgrent();
	    Tcl_AppendResult(interp, "could not set group for file \"",
		    Tcl_GetString(fileName), "\": group \"",
		    string, "\" does not exist",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	gid = groupPtr->gr_gid;
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) -1, (gid_t) gid);	/* INTL: Native. */

    endgrent();
    if (result != 0) {
	Tcl_AppendResult(interp, "could not set group for file \"",
	    Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp),
	    (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetOwnerAttribute --
 *
 *      Sets the owner of the file to the specified owner.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      As above.
 *
 *---------------------------------------------------------------------------
 */

static int
SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;		    /* The interp for error reporting. */
    int objIndex;		    /* The index of the attribute. */
    Tcl_Obj *fileName;   	    /* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr;	    /* New owner for file. */
{
    long uid;
    int result;
    CONST char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr;
	CONST char *string;
	int length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	pwPtr = getpwnam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (pwPtr == NULL) {
	    Tcl_AppendResult(interp, "could not set owner for file \"",
			     Tcl_GetString(fileName), "\": user \"",
			     string, "\" does not exist",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	uid = pwPtr->pw_uid;
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) uid, (gid_t) -1);   /* INTL: Native. */

    if (result != 0) {
	Tcl_AppendResult(interp, "could not set owner for file \"",
			 Tcl_GetString(fileName), "\": ",
			 Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetPermissionsAttribute
 *
 *      Sets the file to the given permission.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      The permission of the file is changed.
 *
 *---------------------------------------------------------------------------
 */

static int
SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;		    /* The interp we are using for errors. */
    int objIndex;		    /* The index of the attribute. */
    Tcl_Obj *fileName;  	    /* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr;	    /* The attribute to set. */
{
    long mode;
    mode_t newMode;
    int result;
    CONST char *native;

    /*
     * First try if the string is a number
     */
    if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
        newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;
	char *modeStringPtr = Tcl_GetString(attributePtr);

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
	 * We get the current mode of the file, in order to allow for
	 * ug+-=rwx style chmod strings.
	 */
	result = TclpObjStat(fileName, &buf);
	if (result != 0) {
	    Tcl_AppendResult(interp, "could not read \"",
		    Tcl_GetString(fileName), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}