diff options
author | fvogel <fvogelnew1@free.fr> | 2023-05-28 10:39:40 (GMT) |
---|---|---|
committer | fvogel <fvogelnew1@free.fr> | 2023-05-28 10:39:40 (GMT) |
commit | 69ae2a0f039e827976e6af9b7b2047473fa9f647 (patch) | |
tree | 6ca42482ca225aff4805a0de444f885b7f361dc1 | |
parent | 0657f97bc5e5f5b835c2c60713f306fb97950a89 (diff) | |
parent | 7988b3f1b6d6acf879c174eeb322700ea5a1e325 (diff) | |
download | tcl-69ae2a0f039e827976e6af9b7b2047473fa9f647.zip tcl-69ae2a0f039e827976e6af9b7b2047473fa9f647.tar.gz tcl-69ae2a0f039e827976e6af9b7b2047473fa9f647.tar.bz2 |
merge 8.7
-rw-r--r-- | doc/configurable.n | 7 | ||||
-rw-r--r-- | doc/open.n | 22 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 8 | ||||
-rw-r--r-- | tests/ioCmd.test | 25 | ||||
-rwxr-xr-x | unix/configure | 8 | ||||
-rw-r--r-- | unix/configure.ac | 2 | ||||
-rw-r--r-- | unix/tclUnixChan.c | 175 | ||||
-rw-r--r-- | win/tclWinChan.c | 203 |
8 files changed, 440 insertions, 10 deletions
diff --git a/doc/configurable.n b/doc/configurable.n index a138c33..ef888ed 100644 --- a/doc/configurable.n +++ b/doc/configurable.n @@ -14,7 +14,7 @@ oo::configurable, configure, property \- class that makes configurable classes a .nf package require TclOO -\fBoo::configurable create \fIclass\fR \fR?\fIdefinitionScript\fR? +\fBoo::configurable create \fIclass\fR ?\fIdefinitionScript\fR? \fBoo::define \fIclass\fB {\fR \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...? @@ -26,7 +26,7 @@ package require TclOO \fIobjectName \fBconfigure\fR \fIobjectName \fBconfigure\fR \fI\-prop\fR -\fIobjectName \fBconfigure\fR \fI\-prop value\fR ?\fI\-prop value\fR...\fR +\fIobjectName \fBconfigure\fR \fI\-prop value\fR ?\fI\-prop value\fR... .fi .SH "CLASS HIERARCHY" .nf @@ -157,12 +157,11 @@ class constructors under normal circumstances), as described above in \fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its \fBproperty\fR command so that it may be used easily in user definition dialects. .TP -. \fBoo::configuresupport::configurableobject\fR . This is a namespace that contains the definition dialect that provides the \fBproperty\fR declaration for use in instance objects (i.e., via -\fBoo::objdefine\fR, and the\fB self\R declaration in \fBoo::define), as +\fBoo::objdefine\fR, and the \fBself\fR declaration in \fBoo::define\fR), as described above in \fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its \fBproperty\fR command so that it may be used easily in user definition dialects. @@ -128,6 +128,28 @@ 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 diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 0a24d88..cb71c40 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2388,8 +2388,14 @@ StoreStatData( #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)); diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 471659a..e603731 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -229,7 +229,7 @@ test iocmd-8.4 {fconfigure command} -setup { 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} @@ -592,7 +592,28 @@ test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { } -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 diff --git a/unix/configure b/unix/configure index 4c54fbe..c0f7a32 100755 --- a/unix/configure +++ b/unix/configure @@ -9506,6 +9506,14 @@ 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" diff --git a/unix/configure.ac b/unix/configure.ac index 238e47a..17da218 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -371,7 +371,7 @@ SC_TIME_HANDLER #-------------------------------------------------------------------- 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()?])]) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 6feaeae..62c3be9 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -124,6 +124,9 @@ 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, @@ -164,7 +167,7 @@ static const Tcl_ChannelType fileChannelType = { FileOutputProc, /* Output proc. */ NULL, NULL, /* Set option proc. */ - NULL, /* Get option proc. */ + FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ FileCloseProc, /* close2proc. */ @@ -534,6 +537,176 @@ FileGetHandleProc( 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 /* *---------------------------------------------------------------------- diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 9535fdd..620c75f 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -80,6 +80,9 @@ static int FileCloseProc(void *instanceData, static int FileEventProc(Tcl_Event *evPtr, int flags); static int FileGetHandleProc(void *instanceData, int direction, void **handlePtr); +static int FileGetOptionProc(ClientData instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); static ThreadSpecificData *FileInit(void); static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); @@ -110,7 +113,7 @@ static const Tcl_ChannelType fileChannelType = { FileOutputProc, /* Output proc. */ NULL, 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. */ @@ -129,6 +132,15 @@ static const Tcl_ChannelType fileChannelType = { #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) + /* *---------------------------------------------------------------------- @@ -749,6 +761,195 @@ FileGetHandleProc( /* *---------------------------------------------------------------------- * + * 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. |