summaryrefslogtreecommitdiffstats
path: root/win/tclWinChan.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2023-05-24 16:04:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2023-05-24 16:04:46 (GMT)
commit6598d2eeae0c954ec9231fd405438adc9d62f7ee (patch)
tree76a21d1b72f69d7f7218eb0332f9d2afbed472d5 /win/tclWinChan.c
parent70a3d08fc4eb639c20c5613ea5952a0dfdd5e935 (diff)
parent29225e440c7dfc3b4fb54d8bb5a8b32fd9604d6f (diff)
downloadtcl-6598d2eeae0c954ec9231fd405438adc9d62f7ee.zip
tcl-6598d2eeae0c954ec9231fd405438adc9d62f7ee.tar.gz
tcl-6598d2eeae0c954ec9231fd405438adc9d62f7ee.tar.bz2
TIP 603: Get 'stat' Information of Open Files
Diffstat (limited to 'win/tclWinChan.c')
-rw-r--r--win/tclWinChan.c203
1 files changed, 202 insertions, 1 deletions
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index ecdd03a..6774634 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -80,6 +80,9 @@ static int FileCloseProc(ClientData instanceData,
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);
@@ -118,7 +121,7 @@ static const Tcl_ChannelType fileChannelType = {
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. */
@@ -137,6 +140,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)
+
/*
*----------------------------------------------------------------------
@@ -836,6 +848,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.