Tcl Source Code

.
If the file exists it is truncated to zero length.
.PP
If a new file is created as part of opening it, \fIpermissions\fR
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.
.PP
.VS "8.7, TIP 603"
When the file opened is an ordinary disk file, the \fBchan configure\fR and
\fBfconfigure\fR commands can be used to query this additional configuration
option:
.TP
\fB\-stat\fR
.
This option, when read, returns a dictionary of values much as is obtained
from the \fBfile stat\fR command, where that stat information relates to the
real opened file. Keys in the dictionary may include \fBatime\fR, \fBctime\fR,
\fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR,
\fBsize\fR, \fBtype\fR, and \fBuid\fR among others; the \fBmtime\fR,
\fBsize\fR and \fBtype\fR fields are guaranteed to be present and meaningful
on all platforms; other keys may be present too.
.RS
.PP
\fIImplementation note:\fR This option maps to a call to \fBfstat()\fR on
POSIX platforms, and to a call to \fBGetFileInformationByHandle()\fR on
Windows; the information reported is what those system calls produce.
.RE
.VE "8.7, TIP 603"
.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is
.QW \fB|\fR
then the
remaining characters of \fIfileName\fR are treated as a list of arguments
that describe a command pipeline to invoke, in the same style as the

    STORE_ARY("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
    STORE_ARY("size",	Tcl_NewWideIntObj(statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj(statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
#ifdef HAVE_STRUCT_STAT_ST_RDEV
    if (S_ISCHR(statPtr->st_mode) || S_ISBLK(statPtr->st_mode)) {
	STORE_ARY("rdev", Tcl_NewWideIntObj((long) statPtr->st_rdev));
    }
#endif
    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(
	    Tcl_GetModificationTimeFromStat(statPtr)));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewWideIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;

test iocmd-8.4 {fconfigure command} -setup {
    file delete $path(test1)
    set f1 [open $path(test1) w]
} -body {
    fconfigure $f1 froboz
} -returnCodes error -cleanup {
    close $f1
} -result [expectedOpts "froboz" -stat]
test iocmd-8.5 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -buffering froboz
} -result {bad value for -buffering: must be one of full, line, or none}
test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {

    set fid [open $f rb]
    append d [read $fid]
    close $fid
    return $d
} -cleanup {
    removeFile $f
} -result 341234x6
test ioCmd-13.12 {open file produces something that has fconfigure -stat} -setup {
    set f [makeFile {} iocmd13_12]
    set result {}
} -body {
    set fd [open $f wb]
    set result [dict get [fconfigure $fd -stat] type]
    fconfigure $fd -buffering none
    puts -nonewline $fd abc
    # Three ways of getting the size; all should agree!
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    puts -nonewline $fd def
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    puts -nonewline $fd ghi
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    close $fd
    return $result
} -cleanup {
    removeFile $f
} -result {file 3 3 3 6 6 6 9 9 9}

test iocmd-14.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $::errorCode
} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
test iocmd-14.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {can not find channel named "filex"}}

fi
ac_fn_c_check_member "$LINENO" "struct stat" "st_blksize" "ac_cv_member_struct_stat_st_blksize" "$ac_includes_default"
if test "x$ac_cv_member_struct_stat_st_blksize" = xyes
then :

printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLKSIZE 1" >>confdefs.h


fi
ac_fn_c_check_member "$LINENO" "struct stat" "st_rdev" "ac_cv_member_struct_stat_st_rdev" "$ac_includes_default"
if test "x$ac_cv_member_struct_stat_st_rdev" = xyes
then :

printf "%s\n" "#define HAVE_STRUCT_STAT_ST_RDEV 1" >>confdefs.h


fi

fi
ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default"
if test "x$ac_cv_type_blkcnt_t" = xyes
then :

#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" != "yes"; then
    AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize, struct stat.st_rdev])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

#--------------------------------------------------------------------
#       Some system have no memcmp or it does not work with 8 bit data, this
#       checks it and add memcmp.o to LIBOBJS if needed

 */

static int		FileBlockModeProc(void *instanceData, int mode);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
#ifndef TCL_NO_DEPRECATED
static int		FileSeekProc(void *instanceData, long offset,
			    int mode, int *errorCode);

    FileOutputProc,		/* Output proc. */
#ifndef TCL_NO_DEPRECATED
    FileSeekProc,		/* Seek proc. */
#else
	NULL,
#endif
    NULL,			/* Set option proc. */
    FileGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* wide seek proc. */

    if (direction & fsPtr->validMask) {
	*handlePtr = INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FileGetOptionProc --
 *
 *	Gets an option associated with an open file. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.  Sets error message if needed
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static inline void
StoreElementInDict(
    Tcl_Obj *dictObj,
    const char *name,
    Tcl_Obj *valueObj)
{
    /*
     * We assume that the dict is being built fresh and that there's never any
     * duplicate keys.
     */

    Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
    Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj);
}

static inline const char *
GetTypeFromMode(
    int mode)
{
    /*
     * TODO: deduplicate with tclCmdAH.c
     */

    if (S_ISREG(mode)) {
	return "file";
    } else if (S_ISDIR(mode)) {
	return "directory";
    } else if (S_ISCHR(mode)) {
	return "characterSpecial";
    } else if (S_ISBLK(mode)) {
	return "blockSpecial";
    } else if (S_ISFIFO(mode)) {
	return "fifo";
#ifdef S_ISLNK
    } else if (S_ISLNK(mode)) {
	return "link";
#endif
#ifdef S_ISSOCK
    } else if (S_ISSOCK(mode)) {
	return "socket";
#endif
    }
    return "unknown";
}

static Tcl_Obj *
StatOpenFile(
    FileState *fsPtr)
{
    Tcl_StatBuf statBuf;	/* Not allocated on heap; we're definitely
				 * API-synchronized with how Tcl is built! */
    Tcl_Obj *dictObj;
    unsigned short mode;

    if (TclOSfstat(fsPtr->fd, &statBuf) < 0) {
	return NULL;
    }

    /*
     * TODO: merge with TIP 594 implementation (it's silly to have a
     * duplicate!)
     */

    dictObj = Tcl_NewObj();
#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value)

    STORE_ELEM("dev",     Tcl_NewWideIntObj((long) statBuf.st_dev));
    STORE_ELEM("ino",     Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_ino));
    STORE_ELEM("nlink",   Tcl_NewWideIntObj((long) statBuf.st_nlink));
    STORE_ELEM("uid",     Tcl_NewWideIntObj((long) statBuf.st_uid));
    STORE_ELEM("gid",     Tcl_NewWideIntObj((long) statBuf.st_gid));
    STORE_ELEM("size",    Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ELEM("blocks",  Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ELEM("blksize", Tcl_NewWideIntObj((long) statBuf.st_blksize));
#endif
#ifdef HAVE_STRUCT_STAT_ST_RDEV
    if (S_ISCHR(statBuf.st_mode) || S_ISBLK(statBuf.st_mode)) {
	STORE_ELEM("rdev", Tcl_NewWideIntObj((long) statBuf.st_rdev));
    }
#endif
    STORE_ELEM("atime",   Tcl_NewWideIntObj(
	    Tcl_GetAccessTimeFromStat(&statBuf)));
    STORE_ELEM("mtime",   Tcl_NewWideIntObj(
	    Tcl_GetModificationTimeFromStat(&statBuf)));
    STORE_ELEM("ctime",   Tcl_NewWideIntObj(
	    Tcl_GetChangeTimeFromStat(&statBuf)));
    mode = (unsigned short) statBuf.st_mode;
    STORE_ELEM("mode",    Tcl_NewWideIntObj(mode));
    STORE_ELEM("type",    Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ELEM

    return dictObj;
}

static int
FileGetOptionProc(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    FileState *fsPtr = (FileState *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    int len;

    if (optionName == NULL) {
	len = 0;
	valid = 1;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -stat
     * Option is readonly and returned by [fconfigure chan -stat] but not
     * returned by [fconfigure chan] without explicit option name.
     */

    if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) {
	Tcl_Obj *dictObj = StatOpenFile(fsPtr);
	const char *dictContents;
	int dictLength;

	if (dictObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't read file channel status: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Transfer dictionary to the DString. Note that we don't do this as
	 * an element as this is an option that can't be retrieved with a
	 * general probe.
	 */

	dictContents = Tcl_GetStringFromObj(dictObj, &dictLength);
	Tcl_DStringAppend(dsPtr, dictContents, dictLength);
	Tcl_DecrRefCount(dictObj);
	return TCL_OK;
    }

    if (valid) {
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName,
		"stat");
}

#ifdef SUPPORTS_TTY
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *

static void		FileChannelExitHandler(ClientData clientData);
static void		FileCheckProc(ClientData clientData, int flags);
static int		FileCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileEventProc(Tcl_Event *evPtr, int flags);
static int		FileGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		FileGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static ThreadSpecificData *FileInit(void);
static int		FileInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
#ifndef TCL_NO_DEPRECATED
static int		FileSeekProc(ClientData instanceData, long offset,

    FileOutputProc,		/* Output proc. */
#ifndef TCL_NO_DEPRECATED
    FileSeekProc,		/* Seek proc. */
#else
	NULL,
#endif
    NULL,			/* Set option proc. */
    FileGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Set up the notifier to watch the channel. */
    FileGetHandleProc,		/* Get an OS handle from channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* Wide seek proc. */
    FileThreadActionProc,	/* Thread action proc. */
    FileTruncateProc		/* Truncate proc. */
};

/*
 * General useful clarification macros.
 */

#define SET_FLAG(var, flag)	((var) |= (flag))
#define CLEAR_FLAG(var, flag)	((var) &= ~(flag))
#define TEST_FLAG(value, flag)	(((value) & (flag)) != 0)

/*
 * The number of 100-ns intervals between the Windows system epoch (1601-01-01
 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
 */

#define POSIX_EPOCH_AS_FILETIME	\
	((long long) 116444736 * (long long) 1000000000)


/*
 *----------------------------------------------------------------------
 *
 * FileInit --
 *
 *	This function creates the window used to simulate file events.

    if (!TEST_FLAG(direction, infoPtr->validMask)) {
	return TCL_ERROR;
    }

    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileGetOptionProc --
 *
 *	Gets an option associated with an open file. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.  Sets error message if needed
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static inline ULONGLONG
CombineDwords(
    DWORD hi,
    DWORD lo)
{
    ULARGE_INTEGER converter;

    converter.LowPart = lo;
    converter.HighPart = hi;
    return converter.QuadPart;
}

static inline void
StoreElementInDict(
    Tcl_Obj *dictObj,
    const char *name,
    Tcl_Obj *valueObj)
{
    /*
     * We assume that the dict is being built fresh and that there's never any
     * duplicate keys.
     */

    Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
    Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj);
}

static inline time_t
ToCTime(
    FILETIME fileTime)		/* UTC time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.LowPart = fileTime.dwLowDateTime;
    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

    return (time_t) ((convertedTime.QuadPart -
	    (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000);
}

static Tcl_Obj *
StatOpenFile(
    FileInfo *infoPtr)
{
    DWORD attr;
    int dev, nlink = 1;
    unsigned short mode;
    unsigned long long size, inode;
    long long atime, ctime, mtime;
    BY_HANDLE_FILE_INFORMATION data;
    Tcl_Obj *dictObj;

    if (GetFileInformationByHandle(infoPtr->handle, &data) != TRUE) {
	Tcl_SetErrno(ENOENT);
	return NULL;
    }

    atime = ToCTime(data.ftLastAccessTime);
    mtime = ToCTime(data.ftLastWriteTime);
    ctime = ToCTime(data.ftCreationTime);
    attr = data.dwFileAttributes;
    size = CombineDwords(data.nFileSizeHigh, data.nFileSizeLow);
    nlink = data.nNumberOfLinks;

    /*
     * Unfortunately our stat definition's inode field (unsigned short) will
     * throw away most of the precision we have here, which means we can't
     * rely on inode as a unique identifier of a file. We'd really like to do
     * something like how we handle 'st_size'.
     */

    inode = CombineDwords(data.nFileIndexHigh, data.nFileIndexLow);

    dev = data.dwVolumeSerialNumber;

    /*
     * Note that this code has no idea whether the file can be executed.
     */

    mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG;
    mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE;
    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;

    /*
     * We don't construct a Tcl_StatBuf; we're using the info immediately.
     */

    dictObj = Tcl_NewObj();
#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value)

    STORE_ELEM("dev",      Tcl_NewWideIntObj((long) dev));
    STORE_ELEM("ino",      Tcl_NewWideIntObj((long long) inode));
    STORE_ELEM("nlink",    Tcl_NewIntObj(nlink));
    STORE_ELEM("uid",      Tcl_NewIntObj(0));
    STORE_ELEM("gid",      Tcl_NewIntObj(0));
    STORE_ELEM("size",     Tcl_NewWideIntObj((long long) size));
    STORE_ELEM("atime",    Tcl_NewWideIntObj(atime));
    STORE_ELEM("mtime",    Tcl_NewWideIntObj(mtime));
    STORE_ELEM("ctime",    Tcl_NewWideIntObj(ctime));
    STORE_ELEM("mode",     Tcl_NewWideIntObj(mode));

    /*
     * Windows only has files and directories, as far as we're concerned.
     * Anything else and we definitely couldn't have got here anyway.
     */
    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
	STORE_ELEM("type", Tcl_NewStringObj("directory", -1));
    } else {
	STORE_ELEM("type", Tcl_NewStringObj("file", -1));
    }
#undef STORE_ELEM

    return dictObj;
}

static int
FileGetOptionProc(
    ClientData instanceData,	/* The file state. */
    Tcl_Interp *interp,		/* For error reporting. */
    const char *optionName,	/* What option to read, or NULL for all. */
    Tcl_DString *dsPtr)		/* Where to write the value read. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    int len;

    if (optionName == NULL) {
	len = 0;
	valid = 1;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -stat
     * Option is readonly and returned by [fconfigure chan -stat] but not
     * returned by [fconfigure chan] without explicit option name.
     */

    if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) {
	return TCL_OK;
    }

    if (valid) {
	Tcl_Obj *dictObj = StatOpenFile(infoPtr);
	const char *dictContents;
	int dictLength;

	if (dictObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't read file channel status: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Transfer dictionary to the DString. Note that we don't do this as
	 * an element as this is an option that can't be retrieved with a
	 * general probe.
	 */

	dictContents = Tcl_GetStringFromObj(dictObj, &dictLength);
	Tcl_DStringAppend(dsPtr, dictContents, dictLength);
	Tcl_DecrRefCount(dictObj);
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName,
		"stat");
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFileChannel --
 *
 *	Open an File based channel on Unix systems.