Index: doc/open.n ================================================================== --- doc/open.n +++ doc/open.n @@ -126,10 +126,32 @@ .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 Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -2525,13 +2525,19 @@ #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("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 Index: tests/ioCmd.test ================================================================== --- tests/ioCmd.test +++ tests/ioCmd.test @@ -227,11 +227,11 @@ set f1 [open $path(test1) w] } -body { fconfigure $f1 froboz } -returnCodes error -cleanup { close $f1 -} -result [expectedOpts "froboz" {}] +} -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 @@ -604,11 +604,32 @@ 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} { Index: unix/configure ================================================================== --- unix/configure +++ unix/configure @@ -9502,10 +9502,18 @@ 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" Index: unix/configure.ac ================================================================== --- unix/configure.ac +++ unix/configure.ac @@ -369,11 +369,11 @@ # 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]) + 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()?])]) #-------------------------------------------------------------------- Index: unix/tclUnixChan.c ================================================================== --- unix/tclUnixChan.c +++ unix/tclUnixChan.c @@ -122,10 +122,13 @@ 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 @@ -170,11 +173,11 @@ FileSeekProc, /* Seek proc. */ #else NULL, #endif NULL, /* Set option proc. */ - NULL, /* Get 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. */ @@ -600,10 +603,180 @@ *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 /* *---------------------------------------------------------------------- * Index: win/tclWinChan.c ================================================================== --- win/tclWinChan.c +++ win/tclWinChan.c @@ -78,10 +78,13 @@ 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); @@ -116,11 +119,11 @@ FileSeekProc, /* Seek proc. */ #else NULL, #endif NULL, /* Set option proc. */ - NULL, /* Get 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. */ @@ -135,10 +138,19 @@ */ #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 -- @@ -830,10 +842,199 @@ } *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 --