geos_one/archie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
d896ff745c
archie/tcl7.6/win/tclWinChan.c

1642 lines
45 KiB
C
Raw Normal View History

Update tcl/tk for tcl-dp
2024-05-27 16:40:40 +02:00
/*
* tclWinChan.c
*
* Channel drivers for Windows channels based on files, command
* pipes and TCP sockets.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclWinChan.c 1.64 96/10/11 15:39:43
*/
#include "tclWinInt.h"
/*
* Static routines for this file:
*/
static int FileBlockModeProc _ANSI_ARGS_((
ClientData instanceData, int mode));
static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite, int *errorCode));
static int FileType _ANSI_ARGS_((HANDLE h));
static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static int FileReadyProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static Tcl_File FileGetProc _ANSI_ARGS_((ClientData instanceData,
int direction));
static int PipeBlockModeProc _ANSI_ARGS_((
ClientData instanceData, int mode));
static int PipeCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int PipeInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int PipeOutputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite, int *errorCode));
static void PipeWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static int PipeReadyProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static Tcl_File PipeGetProc _ANSI_ARGS_((ClientData instanceData,
int direction));
/*
* This structure describes the channel type structure for file based IO.
*/
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
FileBlockModeProc, /* Set blocking or non-blocking mode.*/
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
FileSeekProc, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
FileWatchProc, /* Set up the notifier to watch the channel. */
FileReadyProc, /* Are events present? */
FileGetProc, /* Get a Tcl_File from channel. */
};
/*
* This structure describes the channel type structure for command pipe
* based IO.
*/
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
PipeCloseProc, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
PipeWatchProc, /* Set up notifier to watch the channel. */
PipeReadyProc, /* Are events present? */
PipeGetProc, /* Get a Tcl_File from channel. */
};
/*
* This is the size of the channel name for File based channels
*/
#define CHANNEL_NAME_SIZE 64
static char channelName[CHANNEL_NAME_SIZE+1];
/*
* Structure describing per-instance state for file based channels.
*
* IMPORTANT NOTE: If you modify this structure, make sure that the
* "asynch" field remains the first field - FilePipeBlockMode depends
* on this.
*/
typedef struct FileState {
int asynch; /* 1 if channel is in asynch mode. */
int append; /* 1 if channel is in append mode. */
Tcl_File inFile; /* Input file. */
Tcl_File outFile; /* Output file. */
} FileState;
/*
* This structure describes per-instance state of a pipe based channel.
*
* IMPORTANT NOTE: If you modify this structure, make sure that the
* "asynch" field remains the first field - FilePipeBlockMode depends
* on this.
*/
typedef struct PipeState {
int asynch; /* 1 if channel is in asynch mode. */
Tcl_File readFile; /* Output from pipe. */
Tcl_File writeFile; /* Input from pipe. */
Tcl_File errorFile; /* Error output from pipe. */
int numPids; /* Number of processes attached to pipe. */
int *pidPtr; /* Pids of attached processes. */
} PipeState;
/*
*----------------------------------------------------------------------
*
* FileBlockModeProc --
*
* Set blocking or non-blocking mode on channel.
*
* Results:
* 0 if successful, errno when failed.
*
* Side effects:
* Sets the device into blocking or non-blocking mode.
*
*----------------------------------------------------------------------
*/
static int
FileBlockModeProc(instanceData, mode)
ClientData instanceData; /* Instance state for channel. */
int mode; /* The mode to set. */
{
FileState *fsPtr = (FileState *) instanceData;
/*
* Files on Windows can not be switched between blocking and nonblocking,
* hence we have to emulate the behavior. This is done in the input
* function by checking against a bit in the state. We set or unset the
* bit here to cause the input function to emulate the correct behavior.
*/
fsPtr->asynch = (mode == TCL_MODE_BLOCKING) ? 0 : 1;
return 0;
}
/*
*----------------------------------------------------------------------
*
* FileCloseProc --
*
* Closes the IO channel.
*
* Results:
* 0 if successful, the value of errno if failed.
*
* Side effects:
* Closes the physical channel
*
*----------------------------------------------------------------------
*/
static int
FileCloseProc(instanceData, interp)
ClientData instanceData; /* Pointer to FileState structure. */
Tcl_Interp *interp; /* Not used. */
{
FileState *fsPtr = (FileState *) instanceData;
HANDLE handle;
int type, errorCode = 0;
if (fsPtr->inFile != NULL) {
handle = (HANDLE) Tcl_GetFileInfo(fsPtr->inFile, &type);
/*
* Check for read/write file so we only close it once.
*/
if (fsPtr->inFile == fsPtr->outFile) {
fsPtr->outFile = NULL;
}
Tcl_FreeFile(fsPtr->inFile);
if (CloseHandle(handle) == FALSE) {
TclWinConvertError(GetLastError());
errorCode = errno;
}
}
if (fsPtr->outFile != NULL) {
handle = (HANDLE) Tcl_GetFileInfo(fsPtr->outFile, &type);
Tcl_FreeFile(fsPtr->outFile);
if (CloseHandle(handle) == FALSE) {
TclWinConvertError(GetLastError());
if (errorCode == 0) {
errorCode = errno;
}
}
}
ckfree((char *) instanceData);
return errorCode;
}
/*
*----------------------------------------------------------------------
*
* FileSeekProc --
*
* Seeks on a file-based channel. Returns the new position.
*
* Results:
* -1 if failed, the new position if successful. If failed, it
* also sets *errorCodePtr to the error code.
*
* Side effects:
* Moves the location at which the channel will be accessed in
* future operations.
*
*----------------------------------------------------------------------
*/
static int
FileSeekProc(instanceData, offset, mode, errorCodePtr)
ClientData instanceData; /* File state. */
long offset; /* Offset to seek to. */
int mode; /* Relative to where
* should we seek? */
int *errorCodePtr; /* To store error code. */
{
FileState *fsPtr = (FileState *) instanceData;
DWORD moveMethod;
DWORD newPos;
HANDLE handle;
int type;
*errorCodePtr = 0;
if (fsPtr->inFile != (Tcl_File) NULL) {
handle = (HANDLE) Tcl_GetFileInfo(fsPtr->inFile, &type);
} else if (fsPtr->outFile != (Tcl_File) NULL) {
handle = (HANDLE) Tcl_GetFileInfo(fsPtr->outFile, &type);
} else {
*errorCodePtr = EFAULT;
return -1;
}
if (mode == SEEK_SET) {
moveMethod = FILE_BEGIN;
} else if (mode == SEEK_CUR) {
moveMethod = FILE_CURRENT;
} else {
moveMethod = FILE_END;
}
newPos = SetFilePointer(handle, offset, NULL, moveMethod);
if (newPos == 0xFFFFFFFF) {
TclWinConvertError(GetLastError());
return -1;
}
return newPos;
}
/*
*----------------------------------------------------------------------
*
* FileInputProc --
*
* Reads input from the IO channel into the buffer given. Returns
* count of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
* indication is returned in an output argument.
*
* Side effects:
* Reads input from the actual channel.
*
*----------------------------------------------------------------------
*/
static int
FileInputProc(instanceData, buf, bufSize, errorCode)
ClientData instanceData; /* File state. */
char *buf; /* Where to store data read. */
int bufSize; /* How much space is available
* in the buffer? */
int *errorCode; /* Where to store error code. */
{
FileState *statePtr;
HANDLE handle;
DWORD bytesRead;
int type;
*errorCode = 0;
statePtr = (FileState *) instanceData;
handle = (HANDLE) Tcl_GetFileInfo(statePtr->inFile, &type);
/*
* Note that we will block on reads from a console buffer until a
* full line has been entered. The only way I know of to get
* around this is to write a console driver. We should probably
* do this at some point, but for now, we just block.
*/
if (ReadFile(handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
(LPOVERLAPPED) NULL) == FALSE) {
goto error;
}
return bytesRead;
error:
TclWinConvertError(GetLastError());
*errorCode = errno;
if (errno == EPIPE) {
return 0;
}
return -1;
}
/*
*----------------------------------------------------------------------
*
* FileOutputProc --
*
* Writes the given output on the IO channel. Returns count of how
* many characters were actually written, and an error indication.
*
* Results:
* A count of how many characters were written is returned and an
* error indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
*
*----------------------------------------------------------------------
*/
static int
FileOutputProc(instanceData, buf, toWrite, errorCode)
ClientData instanceData; /* File state. */
char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCode; /* Where to store error code. */
{
FileState *statePtr = (FileState *) instanceData;
int type;
DWORD bytesWritten;
HANDLE handle;
*errorCode = 0;
handle = (HANDLE) Tcl_GetFileInfo(statePtr->outFile, &type);
/*
* If we are writing to a file that was opened with O_APPEND, we need to
* seek to the end of the file before writing the current buffer.
*/
if (statePtr->append) {
SetFilePointer(handle, 0, NULL, FILE_END);
}
if (WriteFile(handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
(LPOVERLAPPED) NULL) == FALSE) {
TclWinConvertError(GetLastError());
*errorCode = errno;
return -1;
}
FlushFileBuffers(handle);
return bytesWritten;
}
/*
*----------------------------------------------------------------------
*
* FileWatchProc --
*
* Called by the notifier to set up to watch for events on this
* channel.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
FileWatchProc(instanceData, mask)
ClientData instanceData; /* File state. */
int mask; /* What events to watch for; OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
FileState *fsPtr = (FileState *) instanceData;
if ((mask & TCL_READABLE) && (fsPtr->inFile != (Tcl_File) NULL)) {
Tcl_WatchFile(fsPtr->inFile, TCL_READABLE);
}
if ((mask & TCL_WRITABLE) && (fsPtr->outFile != (Tcl_File) NULL)) {
Tcl_WatchFile(fsPtr->outFile, TCL_WRITABLE);
}
if (mask & TCL_EXCEPTION) {
if (fsPtr->inFile != (Tcl_File) NULL) {
Tcl_WatchFile(fsPtr->inFile, TCL_EXCEPTION);
}
if (fsPtr->outFile != (Tcl_File) NULL) {
Tcl_WatchFile(fsPtr->outFile, TCL_EXCEPTION);
}
}
}
/*
*----------------------------------------------------------------------
*
* FileReadyProc --
*
* Called by the notifier to check whether events of interest are
* present on the channel.
*
* Results:
* Returns OR-ed combination of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION to indicate which events of interest are present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
FileReadyProc(instanceData, mask)
ClientData instanceData; /* The file state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
FileState *fsPtr = (FileState *) instanceData;
int present = 0;
if ((mask & TCL_READABLE) && (fsPtr->inFile != (Tcl_File) NULL)) {
present |= Tcl_FileReady(fsPtr->inFile, TCL_READABLE);
}
if ((mask & TCL_WRITABLE) && (fsPtr->outFile != (Tcl_File) NULL)) {
present |= Tcl_FileReady(fsPtr->outFile, TCL_WRITABLE);
}
if (mask & TCL_EXCEPTION) {
if (fsPtr->inFile != (Tcl_File) NULL) {
present |= Tcl_FileReady(fsPtr->inFile, TCL_EXCEPTION);
}
if (fsPtr->outFile != (Tcl_File) NULL) {
present |= Tcl_FileReady(fsPtr->outFile, TCL_EXCEPTION);
}
}
return present;
}
/*
*----------------------------------------------------------------------
*
* FileGetProc --
*
* Called from Tcl_GetChannelFile to retrieve Tcl_Files from inside
* a file based channel.
*
* Results:
* The appropriate Tcl_File or NULL if not present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static Tcl_File
FileGetProc(instanceData, direction)
ClientData instanceData; /* The file state. */
int direction; /* Which Tcl_File to retrieve? */
{
FileState *fsPtr = (FileState *) instanceData;
if (direction == TCL_READABLE) {
return fsPtr->inFile;
}
if (direction == TCL_WRITABLE) {
return fsPtr->outFile;
}
return (Tcl_File) NULL;
}
/*
*----------------------------------------------------------------------
*
* PipeBlockModeProc --
*
* Set blocking or non-blocking mode on channel.
*
* Results:
* 0 if successful, errno when failed.
*
* Side effects:
* Sets the device into blocking or non-blocking mode.
*
*----------------------------------------------------------------------
*/
static int
PipeBlockModeProc(instanceData, mode)
ClientData instanceData; /* Instance state for channel. */
int mode; /* The mode to set. */
{
PipeState *statePtr = (PipeState *) instanceData;
/*
* Files on Windows can not be switched between blocking and nonblocking,
* hence we have to emulate the behavior. This is done in the input
* function by checking against a bit in the state. We set or unset the
* bit here to cause the input function to emulate the correct behavior.
*/
statePtr->asynch = (mode == TCL_MODE_BLOCKING) ? 0 : 1;
return 0;
}
/*
*----------------------------------------------------------------------
*
* PipeCloseProc --
*
* Closes a pipe based IO channel.
*
* Results:
* 0 on success, errno otherwise.
*
* Side effects:
* Closes the physical channel.
*
*----------------------------------------------------------------------
*/
static int
PipeCloseProc(instanceData, interp)
ClientData instanceData; /* Pointer to PipeState structure. */
Tcl_Interp *interp; /* For error reporting. */
{
PipeState *pipePtr = (PipeState *) instanceData;
FileState *fsPtr;
HANDLE handle;
Tcl_Channel errChan;
int errorCode, result, type;
ClientData clientData;
TclWinPipe *winPipePtr;
errorCode = 0;
if (pipePtr->readFile != NULL) {
clientData = Tcl_GetFileInfo(pipePtr->readFile, &type);
Tcl_FreeFile(pipePtr->readFile);
if (type == TCL_WIN32S_PIPE) {
winPipePtr = (TclWinPipe *) clientData;
if (winPipePtr->otherPtr != NULL) {
winPipePtr->otherPtr->otherPtr = NULL;
} else {
if (winPipePtr->fileHandle != INVALID_HANDLE_VALUE) {
CloseHandle(winPipePtr->fileHandle);
}
DeleteFile(winPipePtr->fileName);
ckfree((char *) winPipePtr->fileName);
}
ckfree((char *) winPipePtr);
} else {
handle = (HANDLE) clientData;
if (CloseHandle(handle) == FALSE) {
TclWinConvertError(GetLastError());
errorCode = errno;
}
}
}
if (pipePtr->writeFile != NULL) {
clientData = Tcl_GetFileInfo(pipePtr->writeFile, &type);
Tcl_FreeFile(pipePtr->writeFile);
if (type == TCL_WIN32S_PIPE) {
winPipePtr = (TclWinPipe *) clientData;
if (winPipePtr->otherPtr != NULL) {
winPipePtr->otherPtr->otherPtr = NULL;
} else {
if (winPipePtr->fileHandle != INVALID_HANDLE_VALUE) {
CloseHandle(winPipePtr->fileHandle);
}
DeleteFile(winPipePtr->fileName);
ckfree((char *) winPipePtr->fileName);
}
ckfree((char *) winPipePtr);
} else {
handle = (HANDLE) clientData;
if (CloseHandle(handle) == FALSE) {
TclWinConvertError(GetLastError());
if (errorCode == 0) {
errorCode = errno;
}
}
}
}
/*
* Wrap the error file into a channel and give it to the cleanup
* routine.
*/
if (pipePtr->errorFile != NULL) {
fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
fsPtr->inFile = pipePtr->errorFile;
fsPtr->outFile = (Tcl_File) NULL;
fsPtr->asynch = 0;
fsPtr->append = 0;
errChan = Tcl_CreateChannel(&fileChannelType, "pipeError",
(ClientData) fsPtr, TCL_READABLE);
if (Tcl_SetChannelOption(interp, errChan, "-translation", "auto") ==
TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, errChan);
errChan = (Tcl_Channel) NULL;
}
if ((errChan != (Tcl_Channel) NULL) &&
(Tcl_SetChannelOption(NULL, errChan, "-eofchar", "\032") ==
TCL_ERROR)) {
Tcl_Close((Tcl_Interp *) NULL, errChan);
errChan = (Tcl_Channel) NULL;
}
} else {
errChan = NULL;
}
result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
errChan);
if (pipePtr->numPids > 0) {
ckfree((char *) pipePtr->pidPtr);
}
ckfree((char *) pipePtr);
if (errorCode == 0) {
return result;
}
return errorCode;
}
/*
*----------------------------------------------------------------------
*
* PipeInputProc --
*
* Reads input from the IO channel into the buffer given. Returns
* count of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
* indication is returned in an output argument.
*
* Side effects:
* Reads input from the actual channel.
*
*----------------------------------------------------------------------
*/
static int
PipeInputProc(instanceData, buf, bufSize, errorCode)
ClientData instanceData; /* Pipe state. */
char *buf; /* Where to store data read. */
int bufSize; /* How much space is available
* in the buffer? */
int *errorCode; /* Where to store error code. */
{
PipeState *statePtr;
HANDLE handle;
DWORD count;
DWORD bytesRead;
int type;
ClientData clientData;
TclWinPipe *pipePtr;
*errorCode = 0;
statePtr = (PipeState *) instanceData;
clientData = Tcl_GetFileInfo(statePtr->readFile, &type);
if (type == TCL_WIN32S_PIPE) {
pipePtr = (TclWinPipe *) clientData;
if (pipePtr->otherPtr != NULL) {
panic("PipeInputProc: child process isn't finished writing");
}
if (pipePtr->fileHandle == INVALID_HANDLE_VALUE) {
pipePtr->fileHandle = CreateFile(pipePtr->fileName, GENERIC_READ,
0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
}
handle = pipePtr->fileHandle;
if (handle == INVALID_HANDLE_VALUE) {
goto error;
}
} else {
handle = (HANDLE) clientData;
/*
* Pipes will block until the requested number of bytes has been
* read. To avoid blocking unnecessarily, we look ahead and only
* read as much as is available.
*/
if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0, (LPDWORD) NULL,
&count, (LPDWORD) NULL) == TRUE) {
if ((count != 0) && ((DWORD) bufSize > count)) {
bufSize = (int) count;
} else if ((count == 0) && statePtr->asynch) {
errno = *errorCode = EAGAIN;
return 0;
} else if ((count == 0) && !statePtr->asynch) {
bufSize = 1;
}
} else {
goto error;
}
}
/*
* Note that we will block on reads from a console buffer until a
* full line has been entered. The only way I know of to get
* around this is to write a console driver. We should probably
* do this at some point, but for now, we just block.
*/
if (ReadFile(handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
(LPOVERLAPPED) NULL) == FALSE) {
goto error;
}
return bytesRead;
error:
TclWinConvertError(GetLastError());
if (errno == EPIPE) {
return 0;
}
*errorCode = errno;
return -1;
}
/*
*----------------------------------------------------------------------
*
* PipeOutputProc --
*
* Writes the given output on the IO channel. Returns count of how
* many characters were actually written, and an error indication.
*
* Results:
* A count of how many characters were written is returned and an
* error indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
*
*----------------------------------------------------------------------
*/
static int
PipeOutputProc(instanceData, buf, toWrite, errorCode)
ClientData instanceData; /* Pipe state. */
char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCode; /* Where to store error code. */
{
PipeState *statePtr = (PipeState *) instanceData;
int type;
DWORD bytesWritten;
HANDLE handle;
*errorCode = 0;
handle = (HANDLE) Tcl_GetFileInfo(statePtr->writeFile, &type);
if (WriteFile(handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
(LPOVERLAPPED) NULL) == FALSE) {
TclWinConvertError(GetLastError());
if (errno == EPIPE) {
return 0;
}
*errorCode = errno;
return -1;
}
return bytesWritten;
}
/*
*----------------------------------------------------------------------
*
* PipeWatchProc --
*
* Initialize the notifier to watch Tcl_Files from this channel.
*
* Results:
* None.
*
* Side effects:
* Sets up the notifier so that a future event on the channel will
* be seen by Tcl.
*
*----------------------------------------------------------------------
*/
static void
PipeWatchProc(instanceData, mask)
ClientData instanceData; /* The pipe state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABEL and TCL_EXCEPTION. */
{
PipeState *psPtr = (PipeState *) instanceData;
if ((mask & TCL_READABLE) && (psPtr->readFile != (Tcl_File) NULL)) {
Tcl_WatchFile(psPtr->readFile, TCL_READABLE);
}
if ((mask & TCL_WRITABLE) && (psPtr->writeFile != (Tcl_File) NULL)) {
Tcl_WatchFile(psPtr->writeFile, TCL_WRITABLE);
}
if (mask & TCL_EXCEPTION) {
if (psPtr->readFile != (Tcl_File) NULL) {
Tcl_WatchFile(psPtr->readFile, TCL_EXCEPTION);
}
if (psPtr->writeFile != (Tcl_File) NULL) {
Tcl_WatchFile(psPtr->writeFile, TCL_EXCEPTION);
}
}
}
/*
*----------------------------------------------------------------------
*
* PipeReadyProc --
*
* Called by the notifier to check whether events of interest are
* present on the channel.
*
* Results:
* Returns OR-ed combination of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION to indicate which events of interest are present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
PipeReadyProc(instanceData, mask)
ClientData instanceData; /* The pipe state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
PipeState *psPtr = (PipeState *) instanceData;
int present = 0;
if ((mask & TCL_READABLE) && (psPtr->readFile != (Tcl_File) NULL)) {
present |= Tcl_FileReady(psPtr->readFile, TCL_READABLE);
}
if ((mask & TCL_WRITABLE) && (psPtr->writeFile != (Tcl_File) NULL)) {
present |= Tcl_FileReady(psPtr->writeFile, TCL_WRITABLE);
}
if (mask & TCL_EXCEPTION) {
if (psPtr->readFile != (Tcl_File) NULL) {
present |= Tcl_FileReady(psPtr->readFile, TCL_EXCEPTION);
}
if (psPtr->writeFile != (Tcl_File) NULL) {
present |= Tcl_FileReady(psPtr->writeFile, TCL_EXCEPTION);
}
}
return present;
}
/*
*----------------------------------------------------------------------
*
* PipeGetProc --
*
* Called from Tcl_GetChannelFile to retrieve Tcl_Files from inside
* a command pipeline based channel.
*
* Results:
* The appropriate Tcl_File or NULL if not present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static Tcl_File
PipeGetProc(instanceData, direction)
ClientData instanceData; /* The pipe state. */
int direction; /* Which Tcl_File to retrieve? */
{
PipeState *psPtr = (PipeState *) instanceData;
if (direction == TCL_READABLE) {
return psPtr->readFile;
}
if (direction == TCL_WRITABLE) {
return psPtr->writeFile;
}
return (Tcl_File) NULL;
}
/*
*----------------------------------------------------------------------
*
* Tcl_OpenFileChannel --
*
* Open an File based channel on Unix systems.
*
* Results:
* The new channel or NULL. If NULL, the output argument
* errorCodePtr is set to a POSIX error.
*
* Side effects:
* May open the channel and may cause creation of a file on the
* file system.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
char *fileName; /* Name of file to open. */
char *modeString; /* A list of POSIX open modes or
* a string such as "rw". */
int permissions; /* If the open involves creating a
* file, with what modes to create
* it? */
{
Tcl_File file;
Tcl_Channel chan;
FileState *sPtr;
int seekFlag, mode, readWriteMode;
HANDLE handle;
DWORD accessMode, createMode, shareMode, flags;
SECURITY_ATTRIBUTES sec;
char *nativeName;
Tcl_DString buffer;
mode = TclGetOpenMode(interp, modeString, &seekFlag);
if (mode == -1) {
return NULL;
}
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
accessMode = GENERIC_READ;
break;
case O_WRONLY:
accessMode = GENERIC_WRITE;
break;
case O_RDWR:
accessMode = (GENERIC_READ | GENERIC_WRITE);
break;
default:
panic("Tcl_OpenFileChannel: invalid mode value");
break;
}
/*
* Map the creation flags to the NT create mode.
*/
switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
case (O_CREAT | O_EXCL):
case (O_CREAT | O_EXCL | O_TRUNC):
createMode = CREATE_NEW;
break;
case (O_CREAT | O_TRUNC):
createMode = CREATE_ALWAYS;
break;
case O_CREAT:
createMode = OPEN_ALWAYS;
break;
case O_TRUNC:
case (O_TRUNC | O_EXCL):
createMode = TRUNCATE_EXISTING;
break;
default:
createMode = OPEN_EXISTING;
break;
}
/*
* If the file is being created, get the file attributes from the
* permissions argument, else use the existing file attributes.
*/
if (mode & O_CREAT) {
if (permissions & S_IWRITE) {
flags = FILE_ATTRIBUTE_NORMAL;
} else {
flags = FILE_ATTRIBUTE_READONLY;
}
} else {
flags = GetFileAttributes(fileName);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
}
/*
* Set up the security attributes so this file is not inherited by
* child processes.
*/
sec.nLength = sizeof(sec);
sec.lpSecurityDescriptor = NULL;
sec.bInheritHandle = 0;
/*
* Set up the file sharing mode. We want to allow simultaneous access.
*/
shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
/*
* Now we get to create the file.
*/
nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
if (nativeName == NULL) {
return NULL;
}
handle = CreateFile(nativeName, accessMode, shareMode, &sec, createMode,
flags, (HANDLE) NULL);
Tcl_DStringFree(&buffer);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
file = Tcl_GetFile((ClientData) handle, TCL_WIN_FILE);
sPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
sPtr->asynch = 0;
sPtr->append = (mode & O_APPEND) ? 1 : 0;
readWriteMode = 0;
if (accessMode & GENERIC_READ) {
readWriteMode |= TCL_READABLE;
sPtr->inFile = file;
} else {
sPtr->inFile = (Tcl_File) NULL;
}
if (accessMode & GENERIC_WRITE) {
readWriteMode |= TCL_WRITABLE;
sPtr->outFile = file;
} else {
sPtr->outFile = (Tcl_File) NULL;
}
sprintf(channelName, "file%d", (int) Tcl_GetFileInfo(file, NULL));
chan = Tcl_CreateChannel(&fileChannelType, channelName,
(ClientData) sPtr, readWriteMode);
if (chan == (Tcl_Channel) NULL) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "could not open channel \"",
channelName, "\": ", Tcl_PosixError(interp),
(char *) NULL);
}
Tcl_FreeFile(file);
CloseHandle(handle);
ckfree((char *) sPtr);
return NULL;
}
if (seekFlag) {
if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "could not seek to end of file on \"",
channelName, "\": ", Tcl_PosixError(interp),
(char *) NULL);
}
Tcl_Close((Tcl_Interp *) NULL, chan);
return NULL;
}
}
/*
* Files have default translation of AUTO and ^Z eof char, which
* means that a ^Z will be appended to them at close.
*/
if (Tcl_SetChannelOption(interp, chan, "-translation", "auto") ==
TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "\032 {}") ==
TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* FileType --
*
* Converts a Windows handle type to a Tcl file type
*
* Results:
* The Tcl file type corresponding to the given Windows handle type
* or -1 on error.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
FileType(h)
HANDLE h; /* Convert the type of this handle to
* a Tcl file type. */
{
switch (GetFileType(h)) {
case FILE_TYPE_CHAR:
return TCL_WIN_CONSOLE;
case FILE_TYPE_DISK:
return TCL_WIN_FILE;
case FILE_TYPE_PIPE:
return TCL_WIN_PIPE;
default:
return -1;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_MakeFileChannel --
*
* Creates a Tcl_Channel from an existing platform specific file
* handle.
*
* Results:
* The Tcl_Channel created around the preexisting file.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_MakeFileChannel(inFile, outFile, mode)
ClientData inFile; /* OS level handle used for input. */
ClientData outFile; /* OS level handle used for output. */
int mode; /* ORed combination of TCL_READABLE and
* TCL_WRITABLE to indicate whether inFile
* and/or outFile are valid. */
{
Tcl_Channel chan;
int fileUsed;
Tcl_File inFd, outFd;
char channelName[20];
FileState *sPtr;
if (mode & TCL_READABLE) {
sprintf(channelName, "file%d", (int) inFile);
inFd = Tcl_GetFile(inFile, FileType((HANDLE) inFile));
} else {
inFd = (Tcl_File) NULL;
}
if (mode & TCL_WRITABLE) {
sprintf(channelName, "file%d", (int) outFile);
outFd = Tcl_GetFile(outFile, FileType((HANDLE) outFile));
} else {
outFd = (Tcl_File) NULL;
}
/*
* See if a channel with the right Tcl_Files in it already exists. If
* so, return it.
*/
chan = TclFindFileChannel(inFd, outFd, &fileUsed);
if (chan != (Tcl_Channel) NULL) {
return chan;
}
/*
* If one of the Tcl_Files is already used by another channel, do not
* create a new channel containing it. This will avoid core dumps later
* when the Tcl_File would be freed twice.
*/
if (fileUsed) {
return (Tcl_Channel) NULL;
}
sPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
sPtr->asynch = 0;
sPtr->append = 0;
sPtr->inFile = inFd;
sPtr->outFile = outFd;
chan = Tcl_CreateChannel(&fileChannelType, channelName,
(ClientData) sPtr, mode);
if (chan == (Tcl_Channel) NULL) {
ckfree((char *) sPtr);
return NULL;
}
/*
* Windows files have AUTO translation mode and ^Z eof char on input.
*/
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-translation",
"auto") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-eofchar",
"\032 {}") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* TclCreateCommandChannel --
*
* This function is called by Tcl_OpenCommandChannel to perform
* the platform specific channel initialization for a command
* channel.
*
* Results:
* Returns a new channel or NULL on failure.
*
* Side effects:
* Allocates a new channel.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
TclCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
Tcl_File readFile; /* If non-null, gives the file for reading. */
Tcl_File writeFile; /* If non-null, gives the file for writing. */
Tcl_File errorFile; /* If non-null, gives the file where errors
* can be read. */
int numPids; /* The number of pids in the pid array. */
int *pidPtr; /* An array of process identifiers. */
{
Tcl_Channel channel;
char channelName[20];
int channelId;
int permissions;
PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
statePtr->asynch = 0;
statePtr->readFile = readFile;
statePtr->writeFile = writeFile;
statePtr->errorFile = errorFile;
statePtr->numPids = numPids;
statePtr->pidPtr = pidPtr;
/*
* Use one of the fds associated with the channel as the
* channel id.
*/
if (readFile) {
channelId = (int) Tcl_GetFileInfo(readFile, NULL);
} else if (writeFile) {
channelId = (int) Tcl_GetFileInfo(writeFile, NULL);
} else if (errorFile) {
channelId = (int) Tcl_GetFileInfo(errorFile, NULL);
} else {
channelId = 0;
}
permissions = 0;
if (readFile != (Tcl_File) NULL) {
permissions |= TCL_READABLE;
}
if (writeFile != (Tcl_File) NULL) {
permissions |= TCL_WRITABLE;
}
/*
* For backward compatibility with previous versions of Tcl, we
* use "file%d" as the base name for pipes even though it would
* be more natural to use "pipe%d".
*/
sprintf(channelName, "file%d", channelId);
channel = Tcl_CreateChannel(&pipeChannelType, channelName,
(ClientData) statePtr, permissions);
if (channel == NULL) {
ckfree((char *)statePtr);
return NULL;
}
/*
* Pipes have AUTO translation mode on Windows and ^Z eof char, which
* means that a ^Z will be appended to them at close. This is needed
* for Windows programs that expect a ^Z at EOF.
*/
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
"auto") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, channel);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
"\032 {}") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, channel);
return (Tcl_Channel) NULL;
}
return channel;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PidCmd --
*
* This procedure is invoked to process the "pid" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
Tcl_PidCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
Tcl_Channel chan; /* The channel to get pids for. */
Tcl_ChannelType *typePtr;
PipeState *pipePtr; /* The pipe state. */
int i; /* Loops over PIDs attached to the
* pipe. */
char string[50]; /* Temp buffer for string rep. of
* PIDs attached to the pipe. */
if (argc > 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " ?channelId?\"", (char *) NULL);
return TCL_ERROR;
}
if (argc == 1) {
sprintf(interp->result, "%lu", (unsigned long) getpid());
} else {
chan = Tcl_GetChannel(interp, argv[1], NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
typePtr = Tcl_GetChannelType(chan);
if (typePtr != &pipeChannelType) {
return TCL_OK;
}
pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
for (i = 0; i < pipePtr->numPids; i++) {
sprintf(string, "%lu", (unsigned long) pipePtr->pidPtr[i]);
Tcl_AppendElement(interp, string);
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclGetDefaultStdChannel --
*
* Constructs a channel for the specified standard OS handle.
*
* Results:
* Returns the specified default standard channel, or NULL.
*
* Side effects:
* May cause the creation of a standard channel and the underlying
* file.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
TclGetDefaultStdChannel(type)
int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel;
HANDLE handle;
int mode;
char *bufMode;
DWORD handleId; /* Standard handle to retrieve. */
#ifdef _MSC_VER
/*
* If this code is compiled under Borland, the stdio handles for
* tclsh get screwed up and the program exits immediately.
*/
static int hidden = 0;
if (hidden == 0) {
/*
* The stdio handles for this process are globally visible by all
* children of this process, which means that a badly behaved child
* process could write to its parent's handles. Change the
* permission on the handles so that they are not globally visible,
* then have to tell C that the standard file descriptors are to
* be associated with these handles
*/
HANDLE hProcess = GetCurrentProcess();
HANDLE h1, h2;
h1 = GetStdHandle(STD_INPUT_HANDLE);
if (DuplicateHandle(hProcess, h1, hProcess, &h2, 0, FALSE,
DUPLICATE_SAME_ACCESS) != 0) {
/*
* The following two commands have the side effects of
* CloseHandle(h1) and SetStdHandle(STD_INPUT_HANDLE, h2).
*/
_close(0);
_open_osfhandle((long) h2, _O_TEXT);
}
h1 = GetStdHandle(STD_OUTPUT_HANDLE);
if (DuplicateHandle(hProcess, h1, hProcess, &h2, 0, FALSE,
DUPLICATE_SAME_ACCESS) != 0) {
/*
* The following two commands have the side effects of
* CloseHandle(h1) and SetStdHandle(STD_OUTPUT_HANDLE, h2).
*/
_close(1);
_open_osfhandle((long) h2, _O_TEXT);
}
h1 = GetStdHandle(STD_ERROR_HANDLE);
if (DuplicateHandle(hProcess, h1, hProcess, &h2, 0, FALSE,
DUPLICATE_SAME_ACCESS) != 0) {
/*
* The following two commands have the side effects of
* CloseHandle(h1) and SetStdHandle(STD_ERROR_HANDLE, h2).
*/
_close(2);
_open_osfhandle((long) h2, _O_TEXT);
}
hidden = 1;
}
#endif
switch (type) {
case TCL_STDIN:
handleId = STD_INPUT_HANDLE;
mode = TCL_READABLE;
bufMode = "line";
break;
case TCL_STDOUT:
handleId = STD_OUTPUT_HANDLE;
mode = TCL_WRITABLE;
bufMode = "line";
break;
case TCL_STDERR:
handleId = STD_ERROR_HANDLE;
mode = TCL_WRITABLE;
bufMode = "none";
break;
default:
panic("TclGetDefaultStdChannel: Unexpected channel type");
break;
}
handle = GetStdHandle(handleId);
/*
* Note that we need to check for 0 because Windows will return 0 if this
* is not a console mode application, even though this is not a valid
* handle.
*/
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
return NULL;
}
channel = Tcl_MakeFileChannel(handle, handle, mode);
/*
* Set up the normal channel options for stdio handles.
*/
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
"auto") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, channel);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
"\032 {}") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, channel);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-buffering",
bufMode) == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, channel);
return (Tcl_Channel) NULL;
}
return channel;
}
/*
*----------------------------------------------------------------------
*
* TclGetAndDetachPids --
*
* Stores a list of the command PIDs for a command channel in
* interp->result.
*
* Results:
* None.
*
* Side effects:
* Modifies interp->result.
*
*----------------------------------------------------------------------
*/
void
TclGetAndDetachPids(interp, chan)
Tcl_Interp *interp;
Tcl_Channel chan;
{
PipeState *pipePtr;
Tcl_ChannelType *chanTypePtr;
int i;
char buf[20];
/*
* Punt if the channel is not a command channel.
*/
chanTypePtr = Tcl_GetChannelType(chan);
if (chanTypePtr != &pipeChannelType) {
return;
}
pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
for (i = 0; i < pipePtr->numPids; i++) {
sprintf(buf, "%d", pipePtr->pidPtr[i]);
Tcl_AppendElement(interp, buf);
Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
}
if (pipePtr->numPids > 0) {
ckfree((char *) pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
/*
*----------------------------------------------------------------------
*
* TclClosePipeFile --
*
* This function is a simple wrapper for close on a file or
* pipe handle.
*
* Results:
* None.
*
* Side effects:
* Closes the HANDLE and frees the Tcl_File.
*
*----------------------------------------------------------------------
*/
void
TclClosePipeFile(file)
Tcl_File file;
{
int type;
HANDLE handle = (HANDLE) Tcl_GetFileInfo(file, &type);
switch (type) {
case TCL_WIN_FILE:
case TCL_WIN_PIPE:
CloseHandle(handle);
break;
default:
break;
}
Tcl_FreeFile(file);
}
Reference in New Issue Copy Permalink