static int
DoCopyFile(
Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */
Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */
{
CONST TCHAR *nativeSrc, *nativeDst;
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
/*
* Would throw an exception under NT if one of the arguments is a char
* block device.
*/
__try {
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
return TCL_OK;
}
} __except (-1) {}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
Tcl_SetErrno(EACCES);
return TCL_ERROR;
}
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr != 0xffffffff) {
if (dstAttr == 0xffffffff) {
dstAttr = 0;
}
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
(*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~FILE_ATTRIBUTE_READONLY);
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
return TCL_OK;
}
/*
* Still can't copy onto dst. Return that error, and
* restore attributes of dst.
*/
TclWinConvertError(GetLastError());
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
}
}
}
return TCL_ERROR;
}
/*
* Return error message and code for owtcl internal and syntax errors.
*/
void owtcl_Error(Tcl_Interp * interp, char *error_family, char *error_code, char *format, ...)
{
#ifdef HAVE_VASPRINTF
char *buf;
#else
#define ErrBufSize 500
char buf[ErrBufSize];
#endif
va_list argsPtr;
va_start(argsPtr, format);
#ifdef HAVE_VASPRINTF
if (vasprintf(&buf, format, argsPtr) < 0)
#else
if (vsnprintf(buf, ErrBufSize, format, argsPtr) < 0)
#endif
{
/* Error within vasprintf/vsnprintf */
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_ErrnoMsg(Tcl_GetErrno()),-1)); // -1 means a C-style string
Tcl_PosixError(interp);
} else {
/* Generate a posix like error message and code. */
Tcl_SetResult(interp, buf, TCL_VOLATILE);
Tcl_SetErrorCode(interp, error_family, error_code, NULL);
}
va_end(argsPtr);
#ifdef HAVE_VASPRINTF
if (buf) {
free(buf);
}
#endif
}
/*-----------------------------------------------------------------------------
* CloseForError --
*
* Close a file on error. If the file is associated with a channel, close
* it too. The error number will be saved and not lost.
*
* Parameters:
* o interp (I) - Current interpreter.
* o channel (I) - Channel to close if not NULL.
* o fileNum (I) - File number to close if >= 0.
*-----------------------------------------------------------------------------
*/
static void
CloseForError (Tcl_Interp *interp,
Tcl_Channel channel,
int fileNum)
{
int saveErrNo = Tcl_GetErrno ();
/*
* Always close fileNum, even if channel close is done, as it doesn't
* close stdin, stdout or stderr numbers.
*/
if (channel != NULL)
Tcl_UnregisterChannel (interp, channel);
if (fileNum >= 0)
close (fileNum);
Tcl_SetErrno (saveErrNo);
}
char *
dlerror(
) {
TclWinConvertError(GetLastError());
return (char *) Tcl_ErrnoMsg(Tcl_GetErrno());
}
/*
* Return error message and code for OWlib errors.
*/
void owtcl_ErrorOWlib(Tcl_Interp * interp)
{
/* Generate a posix like error message and code. */
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_ErrnoMsg(Tcl_GetErrno()),-1)); // -1 means a C-style string
Tcl_SetErrorCode(interp, "OWTCL", Tcl_ErrnoId(), Tcl_ErrnoMsg(Tcl_GetErrno()), NULL);
}
void TclTextInterp::doEvent() {
if (!done_waiting())
return;
// no recursive calls to TclEvalObj; this prevents
// display update ui from messing up Tcl.
if (callLevel)
return;
Tcl_Channel inChannel = Tcl_GetStdChannel(TCL_STDIN);
Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (needPrompt && consoleisatty) {
#if TCL_MINOR_VERSION >= 4
if (gotPartial) {
Tcl_WriteChars(outChannel, "? ", -1);
} else {
Tcl_WriteChars(outChannel, VMD_CMD_PROMPT, -1);
}
#else
if (gotPartial) {
Tcl_Write(outChannel, "? ", -1);
} else {
Tcl_Write(outChannel, VMD_CMD_PROMPT, -1);
}
#endif
#if defined(VMDTKCON)
vmdcon_purge();
#endif
Tcl_Flush(outChannel);
needPrompt = 0;
}
#if defined(VMD_NANOHUB)
return;
#endif
//
// MPI builds of VMD cannot try to read any command input from the
// console because it creates shutdown problems, at least with MPICH.
// File-based command input is fine however.
//
// For the time being, the Android builds won't attempt to get any
// console input. Any input we're going to get is going to come via
// some means other than stdin, such as a network socket, text box, etc.
//
if (ignorestdin)
return;
if (!vmd_check_stdin())
return;
//
// event loop based on tclMain.c
//
// According to the Tcl docs, GetsObj returns -1 on error or EOF.
int length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
if (Tcl_Eof(inChannel)) {
// exit if we're not a tty, or if eofexit is set
if ((!consoleisatty) || app->get_eofexit())
app->VMDexit("", 0, 0);
} else {
msgErr << "Error reading Tcl input: " << Tcl_ErrnoMsg(Tcl_GetErrno())
<< sendmsg;
}
return;
}
needPrompt = 1;
// add the newline removed by Tcl_GetsObj
Tcl_AppendToObj(commandPtr, "\n", 1);
char *stringrep = Tcl_GetStringFromObj(commandPtr, NULL);
if (!Tcl_CommandComplete(stringrep)) {
gotPartial = 1;
return;
}
gotPartial = 0;
callLevel++;
#if defined(VMD_NANOHUB)
Tcl_EvalObjEx(interp, commandPtr, 0);
#else
Tcl_RecordAndEvalObj(interp, commandPtr, 0);
#endif
callLevel--;
#if TCL_MINOR_VERSION >= 4
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
#else
// XXX this crashes Tcl 8.5.[46] with an internal panic
Tcl_SetObjLength(commandPtr, 0);
#endif
// if ok, send to stdout; if not, send to stderr
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
if (length > 0) {
vmdcon_append(VMDCON_ALWAYS, bytes,length);
vmdcon_append(VMDCON_ALWAYS, "\n", 1);
}
vmdcon_purge();
#else
if (length > 0) {
#if TCL_MINOR_VERSION >= 4
Tcl_WriteChars(outChannel, bytes, length);
Tcl_WriteChars(outChannel, "\n", 1);
#else
Tcl_Write(outChannel, bytes, length);
Tcl_Write(outChannel, "\n", 1);
#endif
}
Tcl_Flush(outChannel);
#endif
}
int
TclFileAttrsCmd(
ClientData clientData, /* Unused */
Tcl_Interp *interp, /* The interpreter for error reporting. */
int objc, /* Number of command line arguments. */
Tcl_Obj *const objv[]) /* The command line objects. */
{
int result;
const char *const *attributeStrings;
const char **attributeStringsAllocated = NULL;
Tcl_Obj *objStrings = NULL;
int numObjStrings = -1;
Tcl_Obj *filePtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
return TCL_ERROR;
}
filePtr = objv[1];
if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
return TCL_ERROR;
}
objc -= 2;
objv += 2;
result = TCL_ERROR;
Tcl_SetErrno(0);
/*
* Get the set of attribute names from the filesystem.
*/
attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
if (attributeStrings == NULL) {
int index;
Tcl_Obj *objPtr;
if (objStrings == NULL) {
if (Tcl_GetErrno() != 0) {
/*
* There was an error, probably that the filePtr is not
* accepted by any filesystem
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not read \"%s\": %s",
TclGetString(filePtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
/*
* We own the object now.
*/
Tcl_IncrRefCount(objStrings);
/*
* Use objStrings as a list object.
*/
if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
attributeStringsAllocated = (const char **)
TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
for (index = 0; index < numObjStrings; index++) {
Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
attributeStringsAllocated[index] = TclGetString(objPtr);
}
attributeStringsAllocated[index] = NULL;
attributeStrings = attributeStringsAllocated;
} else if (objStrings != NULL) {
Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
}
/*
* Process the attributes to produce a list of all of them, the value of a
* particular attribute, or to set one or more attributes (depending on
* the number of arguments).
*/
if (objc == 0) {
/*
* Get all attributes.
*/
int index, res = TCL_OK, nbAtts = 0;
Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
for (index = 0; attributeStrings[index] != NULL; index++) {
Tcl_Obj *objPtrAttr;
if (res != TCL_OK) {
/*
* Clear the error from the last iteration.
*/
Tcl_ResetResult(interp);
}
res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr);
if (res == TCL_OK) {
Tcl_Obj *objPtr =
Tcl_NewStringObj(attributeStrings[index], -1);
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr);
nbAtts++;
}
}
if (index > 0 && nbAtts == 0) {
/*
* Error: no valid attributes found.
*/
Tcl_DecrRefCount(listPtr);
goto end;
}
Tcl_SetObjResult(interp, listPtr);
} else if (objc == 1) {
/*
* Get one attribute.
*/
int index;
Tcl_Obj *objPtr = NULL;
if (numObjStrings == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
"option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
goto end;
}
Tcl_SetObjResult(interp, objPtr);
} else {
/*
* Set option/value pairs.
*/
int i, index;
if (numObjStrings == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
for (i = 0; i < objc ; i += 2) {
if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
"option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
if (i + 1 == objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
"NOVALUE", NULL);
goto end;
}
if (Tcl_FSFileAttrsSet(interp, index, filePtr,
objv[i + 1]) != TCL_OK) {
goto end;
}
}
}
result = TCL_OK;
/*
* Free up the array we allocated and drop our reference to any list of
* attribute names issued by the filesystem.
*/
end:
if (attributeStringsAllocated != NULL) {
TclStackFree(interp, (void *) attributeStringsAllocated);
}
if (objStrings != NULL) {
Tcl_DecrRefCount(objStrings);
}
return result;
}
int main(int argc, char **argv)
{
char buffer[1024];
size_t objSize = sizeof(char);
int objCount = 100;
int opRet;
FILE *sp = NULL;
char *str = NULL;
int count;
int i;
if (argc != 2)
{
printf("Usage: \n1. testSlicerIO path/fileName\n2. testSlicerIO \"command pipe\" (e.g. \"| date\")\n");
return 1;
}
/* ------------------------------------------------------ */
/* Testing fgets */
/* ------------------------------------------------------ */
printf("\n......... Testing fgets .........\n\n");
printf("Case 1: Get a line from a file stream or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
memset(buffer, 0, 1024);
fgets(buffer, 1024, sp);
if (strlen(buffer) > 0)
{
printf(".........passed\n\n");
printf("Output: %s \n\n", buffer);
}
else
{
printf(".........failed\n\n");
}
fclose(sp);
printf("Case 2: Get a line from stdin (please type and hit return)\n");
str = fgets(buffer, 1024, stdin);
if (str != NULL)
{
printf(".........passed\n\n");
printf("Output: %s \n\n", str);
}
else
{
printf(".........failed\n\n");
}
/* ------------------------------------------------------ */
/* Testing fread */
/* ------------------------------------------------------ */
printf("\n......... Testing fread .........\n\n");
printf("Case 1: Read from a file stream or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
memset(buffer, 0, 1024);
opRet = fread(buffer, objSize, objCount, sp);
if (opRet > 0)
{
printf(".........passed\n\n");
}
else
{
printf(".........failed\n\n");
}
printf("Output: %s \n\n", buffer);
printf("Case 2: Read from stdin (please type (> 20 chars) and hit return)\n");
memset(buffer, 0, 1024);
objCount = 20;
opRet = fread(buffer, objSize, objCount, stdin);
if (opRet > 0)
{
printf(".........passed\n\n");
}
else
{
printf(".........failed\n\n");
}
printf("Output: %s \n\n", buffer);
fclose(sp);
/* ------------------------------------------------------ */
/* Test fwrite */
/* ------------------------------------------------------ */
printf("\n......... Testing fwrite .........\n\n");
printf("Case 1: Write to a file\n");
sp = fopen("testFwrite.txt", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
memset(buffer, 0, 1024);
objCount = 200;
opRet = fwrite(buffer, objSize, objCount, sp);
fclose(sp);
if (opRet != objCount)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 2: Write to stdout\n");
opRet = fwrite(buffer, objSize, objCount, stdout);
if (opRet != objCount)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 3: Write to stderr\n");
opRet = fwrite(buffer, objSize, objCount, stderr);
if (opRet != objCount)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 4: Write to a command pipe\n");
sp = fopen("| cal", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
strcpy(buffer, "Hello, I'm here in Boston Ma.");
/* memset(buffer, 38, 1024); */
opRet = fwrite(buffer, objSize, objCount, sp);
fclose(sp);
if (opRet != objCount)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
/* ------------------------------------------------------ */
/* Testing fprintf */
/* ------------------------------------------------------ */
printf("\n......... Testing fprintf .........\n\n");
printf("Case 1: Write to stdout\n");
opRet = fprintf(stdout, "%s\n", "Boston MA");
if (opRet <= 0)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 2: Write to stderr\n");
opRet = fprintf(stderr, "%s %d\n", "Boston Ma", 2006);
if (opRet <= 0)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 3: Write to a file\n");
sp = fopen("testFprintf.txt", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
strcpy(buffer, "Hello, I'm here in Boston Ma.");
/* memset(buffer, 38, 1024); */
opRet = fprintf(sp, "%s %d\n", buffer, 2006);
fclose(sp);
if (opRet <= 0)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 4: Write to command pipe\n");
sp = fopen("| cal", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
strcpy(buffer, "Hello, I'm here in Boston Ma.");
/* memset(buffer, 38, 1024); */
opRet = fprintf(sp, "%s %d\n", buffer, 2006);
fclose(sp);
if (opRet <= 0)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
/* ------------------------------------------------------ */
/* Testing fflush */
/* ------------------------------------------------------ */
printf("\n......... Testing fflush .........\n\n");
printf("Case 1: Flush stdout\n");
opRet = fflush(stdout);
if (opRet != 0)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 2: Flush stderr\n");
opRet = fflush(stderr);
if (opRet != 0)
{
printf(".........failed\n\n");
return 1;
}
else
{
printf(".........passed\n\n");
}
printf("Case 3: Flush a file stream or command pipe\n");
sp = fopen("testFflush.txt", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
opRet = fflush(sp);
if (opRet != 0)
{
printf(".........failed\n\n");
if (sp->interp != NULL)
{
int errno = Tcl_GetErrno();
printf("%s", Tcl_ErrnoMsg(errno));
}
return 1;
}
else
{
printf(".........passed\n\n");
}
fclose(sp);
/* ------------------------------------------------------ */
/* Testing fgetc */
/* ------------------------------------------------------ */
printf("\n......... Testing fgetc .........\n\n");
printf("Case 1: fgetc from stdin (type > 10 chars)\n");
i = 0;
while (i++ < 10) {
printf("%c", fgetc(stdin));
}
printf("\n");
printf(".........passed\n\n");
printf("Case 2: fgetc from a file or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
count = 1;
while ((i = fgetc(sp)) != EOF && count < 30)
{
printf("%c", i);
count++;
}
fclose(sp);
printf("\n");
printf(".........passed\n\n");
/* ------------------------------------------------------ */
/* Testing fputc */
/* ------------------------------------------------------ */
printf("\n......... Testing fputc .........\n\n");
printf("Case 1: fputc to stdout\n");
strcpy(buffer, "Hello, I'm here in Boston Ma.");
count = 0;
fflush(stdout);
while (count < 30) {
fputc(buffer[count], stdout);
count++;
}
printf("\n");
printf(".........passed\n\n");
printf("Case 2: fputc to stderr\n");
count = 0;
fflush(stderr);
while (count < 30) {
fputc(buffer[count], stderr);
count++;
}
printf("\n");
printf(".........passed\n\n");
printf("Case 3: fputc to a file\n");
sp = fopen("testFputc.txt", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
count = 0;
while (count < 30)
{
printf("%c", fputc(buffer[count], sp));
count++;
}
fclose(sp);
printf("\n");
printf(".........passed\n\n");
printf("Case 4: fputc to a command pipe\n");
sp = fopen("| cal", "w");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
count = 0;
while (count < 30)
{
printf("%c", fputc(buffer[count], sp));
count++;
}
fclose(sp);
printf("\n");
printf(".........passed\n\n");
/* ------------------------------------------------------ */
/* Testing feof */
/* ------------------------------------------------------ */
printf("\n......... Testing feof .........\n\n");
printf("Case 1: feof to a file or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
while (!feof(sp))
{
fgets(buffer, 1024, sp);
printf("%s\n", buffer);
}
fclose(sp);
printf("\n");
printf(".........passed\n\n");
printf("Case 2: feof to stdin (use control-d to finish input)\n");
while (!feof(stdin))
{
fgets(buffer, 1024, stdin);
printf("%s\n", buffer);
}
printf("\n");
printf(".........passed\n\n");
/* ------------------------------------------------------ */
/* Testing fseek */
/* ------------------------------------------------------ */
printf("\n......... Testing fseek .........\n\n");
printf("Case 1: fseek a file or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
fgets(buffer, 1024, sp);
printf("%s\n", buffer);
opRet = fseek(sp, 5, SEEK_SET);
fgets(buffer, 1024, sp);
printf("%s\n", buffer);
fclose(sp);
// Return non-zero if it fails
// See http://www.cplusplus.com/reference/clibrary/cstdio/fseek/
if (opRet != 0)
{
printf(".........failed (Tcl_Seek on pipes: Not supported\n\n");
/* return 1; */
}
else
{
printf(".........passed\n\n");
}
/* ------------------------------------------------------ */
/* Testing ftell */
/* ------------------------------------------------------ */
printf("\n......... Testing ftell .........\n\n");
printf("Case 1: ftell a file or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
fseek(sp, 5, SEEK_SET);
opRet = ftell(sp);
fclose(sp);
if (opRet == -1)
{
printf(".........failed (Tcl_Tell on pipes: Not supported)\n\n");
/* return 1; */
}
else
{
printf("Current access point = %d\n", opRet);
printf(".........passed\n\n");
}
/* ------------------------------------------------------ */
/* Testing ungetc */
/* ------------------------------------------------------ */
printf("\n......... Testing ungetc .........\n\n");
printf("Case 1: ungetc onto a file stream or command pipe\n");
sp = fopen(argv[1], "r");
if (sp == NULL)
{
printf("\n\nfopen failed\n\n");
return 1;
}
count = 1;
while ((i = fgetc(sp)) != EOF && count < 5)
{
printf("%c", i);
count++;
}
ungetc(i, sp);
opRet = fgetc(sp);
fclose(sp);
if (opRet != i)
{
printf(".........failed");
return 1;
}
else
{
printf("\nchar = %c\n", i);
printf(".........passed\n\n");
}
printf("\nAll testing cases passed\n\n");
return 0;
}
static int
TransformInputProc(
ClientData instanceData,
char *buf,
int toRead,
int *errorCodePtr)
{
TransformChannelData *dataPtr = instanceData;
int gotBytes, read, copied;
Tcl_Channel downChan;
/*
* Should assert(dataPtr->mode & TCL_READABLE);
*/
if (toRead == 0 || dataPtr->self == NULL) {
/*
* Catch a no-op. TODO: Is this a panic()?
*/
return 0;
}
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
PreserveData(dataPtr);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
* below, possibly EOF).
*/
copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
toRead -= copied;
buf += copied;
gotBytes += copied;
if (toRead == 0) {
/*
* The request was completely satisfied from our buffers. We can
* break out of the loop and return to the caller.
*/
break;
}
/*
* Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming
* 'buf'! as target to store the intermediary information read from
* the underlying channel.
*
* Ask the tcl level how much data it allows us to read from the
* underlying channel. This feature allows the transform to signal EOF
* upstream although there is none downstream. Useful to control an
* unbounded 'fcopy', either through counting bytes, or by pattern
* matching.
*/
ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0,
TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
if (dataPtr->maxRead >= 0) {
if (dataPtr->maxRead < toRead) {
toRead = dataPtr->maxRead;
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
break;
}
if (dataPtr->eofPending) {
/*
* Already saw EOF from downChan; don't ask again.
* NOTE: Could move this up to avoid the last maxRead
* execution. Believe this would still be correct behavior,
* but the test suite tests the whole command callback
* sequence, so leave it unchanged for now.
*/
break;
}
/*
* Get bytes from the underlying channel.
*/
read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
/*
* Zero bytes available from downChan because blocked.
* But nonzero bytes already copied, so total is a
* valid blocked short read. Return to caller.
*/
break;
}
/*
* Either downChan is not blocked (there's a real error).
* or it is and there are no bytes copied yet. In either
* case we want to pass the "error" along to the caller,
* either to report an error, or to signal to the caller
* that zero bytes are available because blocked.
*/
*errorCodePtr = Tcl_GetErrno();
gotBytes = -1;
break;
} else if (read == 0) {
/*
* Zero returned from Tcl_ReadRaw() always indicates EOF
* on the down channel.
*/
dataPtr->eofPending = 1;
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
if (ResultEmpty(&dataPtr->result)) {
/*
* We had nothing to flush.
*/
break;
}
continue; /* at: while (toRead > 0) */
} /* read == 0 */
/*
* Transform the read chunk and add the result to our read buffer
* (dataPtr->result).
*/
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
gotBytes = -1;
break;
}
} /* while toRead > 0 */
if (gotBytes == 0) {
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
return gotBytes;
}
static int
TransformInputProc(
ClientData instanceData,
char *buf,
int toRead,
int *errorCodePtr)
{
TransformChannelData *dataPtr = instanceData;
int gotBytes, read, copied;
Tcl_Channel downChan;
/*
* Should assert(dataPtr->mode & TCL_READABLE);
*/
if (toRead == 0) {
/*
* Catch a no-op.
*/
return 0;
}
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
* below, possibly EOF).
*/
copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
toRead -= copied;
buf += copied;
gotBytes += copied;
if (toRead == 0) {
/*
* The request was completely satisfied from our buffers. We can
* break out of the loop and return to the caller.
*/
return gotBytes;
}
/*
* Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming
* 'buf'! as target to store the intermediary information read from
* the underlying channel.
*
* Ask the tcl level how much data it allows us to read from the
* underlying channel. This feature allows the transform to signal EOF
* upstream although there is none downstream. Useful to control an
* unbounded 'fcopy', either through counting bytes, or by pattern
* matching.
*/
ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0,
TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
if (dataPtr->maxRead >= 0) {
if (dataPtr->maxRead < toRead) {
toRead = dataPtr->maxRead;
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
return gotBytes;
}
/*
* Get bytes from the underlying channel.
*/
read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
/*
* Report errors to caller. EAGAIN is a special situation. If we
* had some data before we report that instead of the request to
* re-try.
*/
if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
return gotBytes;
}
*errorCodePtr = Tcl_GetErrno();
return -1;
} else if (read == 0) {
/*
* Check wether we hit on EOF in the underlying channel or not. If
* not differentiate between blocking and non-blocking modes. In
* non-blocking mode we ran temporarily out of data. Signal this
* to the caller via EWOULDBLOCK and error return (-1). In the
* other cases we simply return what we got and let the caller
* wait for more. On the other hand, if we got an EOF we have to
* convert and flush all waiting partial data.
*/
if (!Tcl_Eof(downChan)) {
if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
return gotBytes;
}
if (dataPtr->readIsFlushed) {
/*
* Already flushed, nothing to do anymore.
*/
return gotBytes;
}
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
if (ResultEmpty(&dataPtr->result)) {
/*
* We had nothing to flush.
*/
return gotBytes;
}
continue; /* at: while (toRead > 0) */
} /* read == 0 */
/*
* Transform the read chunk and add the result to our read buffer
* (dataPtr->result).
*/
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
return -1;
}
} /* while toRead > 0 */
return gotBytes;
}
static int
TlsOutputProc(ClientData instanceData, /* Socket state. */
CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCodePtr) /* Where to store error code. */
{
State *statePtr = (State *) instanceData;
int written, err;
*errorCodePtr = 0;
dprintf(stderr,"\nBIO_write(0x%x, %d)", (unsigned int) statePtr, toWrite);
if (statePtr->flags & TLS_TCL_CALLBACK) {
/* don't process any bytes while verify callback is running */
written = -1;
*errorCodePtr = EAGAIN;
goto output;
}
if (!SSL_is_init_finished(statePtr->ssl)) {
written = Tls_WaitForConnect(statePtr, errorCodePtr);
if (written <= 0) {
goto output;
}
}
if (statePtr->flags & TLS_TCL_INIT) {
statePtr->flags &= ~(TLS_TCL_INIT);
}
if (toWrite == 0) {
dprintf(stderr, "zero-write\n");
BIO_flush(statePtr->bio);
written = 0;
goto output;
} else {
/*
* We need to clear the SSL error stack now because we sometimes reach
* this function with leftover errors in the stack. If BIO_write
* returns -1 and intends EAGAIN, there is a leftover error, it will be
* misconstrued as an error, not EAGAIN.
*
* Alternatively, we may want to handle the <0 return codes from
* BIO_write specially (as advised in the RSA docs). TLS's lower level
* BIO functions play with the retry flags though, and this seems to
* work correctly. Similar fix in TlsInputProc. - hobbs
*/
ERR_clear_error();
written = BIO_write(statePtr->bio, buf, toWrite);
dprintf(stderr,"\nBIO_write(0x%x, %d) -> [%d]",
(unsigned int) statePtr, toWrite, written);
}
if (written <= 0) {
switch ((err = SSL_get_error(statePtr->ssl, written))) {
case SSL_ERROR_NONE:
if (written < 0) {
written = 0;
}
break;
case SSL_ERROR_WANT_WRITE:
dprintf(stderr," write W BLOCK");
break;
case SSL_ERROR_WANT_READ:
dprintf(stderr," write R BLOCK");
break;
case SSL_ERROR_WANT_X509_LOOKUP:
dprintf(stderr," write X BLOCK");
break;
case SSL_ERROR_ZERO_RETURN:
dprintf(stderr," closed\n");
written = 0;
break;
case SSL_ERROR_SYSCALL:
*errorCodePtr = Tcl_GetErrno();
dprintf(stderr," [%d] syscall errr: %d",
written, *errorCodePtr);
written = -1;
break;
case SSL_ERROR_SSL:
Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written));
*errorCodePtr = ECONNABORTED;
written = -1;
break;
default:
dprintf(stderr," unknown err: %d\n", err);
break;
}
}
output:
dprintf(stderr, "\nOutput(%d) -> %d", toWrite, written);
return written;
}
static int
TlsInputProc(ClientData instanceData, /* Socket state. */
char *buf, /* Where to store data read. */
int bufSize, /* How much space is available
* in the buffer? */
int *errorCodePtr) /* Where to store error code. */
{
State *statePtr = (State *) instanceData;
int bytesRead; /* How many bytes were read? */
*errorCodePtr = 0;
dprintf(stderr,"\nBIO_read(%d)", bufSize);
if (statePtr->flags & TLS_TCL_CALLBACK) {
/* don't process any bytes while verify callback is running */
bytesRead = 0;
goto input;
}
if (!SSL_is_init_finished(statePtr->ssl)) {
bytesRead = Tls_WaitForConnect(statePtr, errorCodePtr);
if (bytesRead <= 0) {
goto input;
}
}
if (statePtr->flags & TLS_TCL_INIT) {
statePtr->flags &= ~(TLS_TCL_INIT);
}
/*
* We need to clear the SSL error stack now because we sometimes reach
* this function with leftover errors in the stack. If BIO_read
* returns -1 and intends EAGAIN, there is a leftover error, it will be
* misconstrued as an error, not EAGAIN.
*
* Alternatively, we may want to handle the <0 return codes from
* BIO_read specially (as advised in the RSA docs). TLS's lower level BIO
* functions play with the retry flags though, and this seems to work
* correctly. Similar fix in TlsOutputProc. - hobbs
*/
ERR_clear_error();
bytesRead = BIO_read(statePtr->bio, buf, bufSize);
dprintf(stderr,"\nBIO_read -> %d", bytesRead);
if (bytesRead < 0) {
int err = SSL_get_error(statePtr->ssl, bytesRead);
if (err == SSL_ERROR_SSL) {
Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead));
*errorCodePtr = ECONNABORTED;
} else if (BIO_should_retry(statePtr->bio)) {
dprintf(stderr,"RE! ");
*errorCodePtr = EAGAIN;
} else {
*errorCodePtr = Tcl_GetErrno();
if (*errorCodePtr == ECONNRESET) {
/* Soft EOF */
*errorCodePtr = 0;
bytesRead = 0;
}
}
}
input:
dprintf(stderr, "\nInput(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
return bytesRead;
}
static int
DoRemoveDirectory(
Tcl_DString *pathPtr, /* Pathname of directory to be removed
* (native). */
int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
CONST TCHAR *nativePath;
DWORD attr;
nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
/*
* Win32s thinks that "" is the same as "." and then reports EACCES
* instead of ENOENT.
*/
if (tclWinProcs->useWide) {
if (((WCHAR *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
} else {
if (((char *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
}
if (Tcl_GetErrno() == EACCES) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Windows 95 reports calling RemoveDirectory on a file as an
* EACCES, not an ENOTDIR.
*/
Tcl_SetErrno(ENOTDIR);
goto end;
}
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
goto end;
}
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
(*tclWinProcs->setFileAttributesProc)(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
/*
* Windows 95 and Win32s report removing a non-empty directory
* as EACCES, not EEXIST. If the directory is not empty,
* change errno so caller knows what's going on.
*/
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
char *path, *find;
HANDLE handle;
WIN32_FIND_DATAA data;
Tcl_DString buffer;
int len;
path = (char *) nativePath;
Tcl_DStringInit(&buffer);
len = strlen(path);
find = Tcl_DStringAppend(&buffer, path, len);
if ((len > 0) && (find[len - 1] != '\\')) {
Tcl_DStringAppend(&buffer, "\\", 1);
}
find = Tcl_DStringAppend(&buffer, "*.*", 3);
handle = FindFirstFileA(find, &data);
if (handle != INVALID_HANDLE_VALUE) {
while (1) {
if ((strcmp(data.cFileName, ".") != 0)
&& (strcmp(data.cFileName, "..") != 0)) {
/*
* Found something in this directory.
*/
Tcl_SetErrno(EEXIST);
break;
}
if (FindNextFileA(handle, &data) == FALSE) {
break;
}
}
FindClose(handle);
}
Tcl_DStringFree(&buffer);
}
}
}
if (Tcl_GetErrno() == ENOTEMPTY) {
/*
* The caller depends on EEXIST to signify that the directory is
* not empty, not ENOTEMPTY.
*/
Tcl_SetErrno(EEXIST);
}
if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
/*
* The directory is nonempty, but the recursive flag has been
* specified, so we recursively remove all the files in the directory.
*/
return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
}
end:
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
}
static int
DoDeleteFile(
Tcl_DString *pathPtr) /* Pathname of file to be removed (native). */
{
DWORD attr;
CONST TCHAR *nativePath;
nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
/*
* Win32s thinks that "" is the same as "." and then reports EISDIR
* instead of ENOENT.
*/
if (tclWinProcs->useWide) {
if (((WCHAR *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
} else {
if (((char *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
}
if (Tcl_GetErrno() == EACCES) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Windows NT reports removing a directory as EACCES instead
* of EISDIR.
*/
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
(*tclWinProcs->setFileAttributesProc)(nativePath,
attr & ~FILE_ATTRIBUTE_READONLY);
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
(*tclWinProcs->setFileAttributesProc)(nativePath, attr);
}
}
} else if (Tcl_GetErrno() == ENOENT) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Windows 95 reports removing a directory as ENOENT instead
* of EISDIR.
*/
Tcl_SetErrno(EISDIR);
}
}
} else if (Tcl_GetErrno() == EINVAL) {
/*
* Windows NT reports removing a char device as EINVAL instead of
* EACCES.
*/
Tcl_SetErrno(EACCES);
}
return TCL_ERROR;
}
static int
DoRenameFile(
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
Tcl_DString *dstPtr) /* New pathname for file or directory
* (native). */
{
const TCHAR *nativeDst;
DWORD srcAttr, dstAttr;
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
/*
* Would throw an exception under NT if one of the arguments is a
* char block device.
*/
__try {
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
} __except (-1) {}
TclWinConvertError(GetLastError());
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr == 0xffffffff) {
if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
dstAttr = 0;
}
if (errno == EBADF) {
errno = EACCES;
return TCL_ERROR;
}
if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32s) && (errno == EACCES)) {
if ((srcAttr != 0) && (dstAttr != 0)) {
/*
* Win32s reports trying to overwrite an existing file or directory
* as EACCES.
*/
errno = EEXIST;
}
}
if (errno == EACCES) {
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
char **srcArgv, **dstArgv;
int size, srcArgc, dstArgc;
WCHAR nativeSrcPath[MAX_PATH];
WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
CONST char *src, *dst;
size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
(*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
(*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
if (strncmp(src, dst, Tcl_DStringLength(&srcString)) == 0) {
/*
* Trying to move a directory into itself.
*/
errno = EINVAL;
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
return TCL_ERROR;
}
Tcl_SplitPath(src, &srcArgc, &srcArgv);
Tcl_SplitPath(dst, &dstArgc, &dstArgv);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
if (srcArgc == 1) {
/*
* They are trying to move a root directory. Whether
* or not it is across filesystems, this cannot be
* done.
*/
Tcl_SetErrno(EINVAL);
} else if ((srcArgc > 0) && (dstArgc > 0) &&
(strcmp(srcArgv[0], dstArgv[0]) != 0)) {
/*
* If src is a directory and dst filesystem != src
* filesystem, errno should be EXDEV. It is very
* important to get this behavior, so that the caller
* can respond to a cross filesystem rename by
* simulating it with copy and delete. The MoveFile
* system call already handles the case of moving a
* file between filesystems.
*/
Tcl_SetErrno(EXDEV);
}
ckfree((char *) srcArgv);
ckfree((char *) dstArgv);
}
/*
* Other types of access failure is that dst is a read-only
* filesystem, that an open file referred to src or dest, or that
* src or dest specified the current working directory on the
* current filesystem. EACCES is returned for those cases.
*/
} else if (Tcl_GetErrno() == EEXIST) {
/*
* Reports EEXIST any time the target already exists. If it makes
* sense, remove the old file and try renaming again.
*/
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Overwrite empty dst directory with src directory. The
* following call will remove an empty directory. If it
* fails, it's because it wasn't empty.
*/
if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
* renaming again. If that fails, we'll put this empty
* directory back, for completeness.
*/
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
/*
* Some new error has occurred. Don't know what it
* could be, but report this one.
*/
TclWinConvertError(GetLastError());
(*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
}
} else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
Tcl_SetErrno(ENOTDIR);
}
} else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
Tcl_SetErrno(EISDIR);
} else {
/*
* Overwrite existing file by:
*
* 1. Rename existing file to temp name.
* 2. Rename old file to new name.
* 3. If success, delete temp file. If failure,
* put temp file back to old name.
*/
TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
WCHAR tempBuf[MAX_PATH];
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
}
nativeTmp = (TCHAR *) tempBuf;
((char *) nativeRest)[0] = '\0';
((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
result = TCL_ERROR;
nativePrefix = (tclWinProcs->useWide)
? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
* MoveFile to be joined as an atomic operation so no
* other app comes along in the meantime and creates the
* same temp file.
*/
nativeTmp = (TCHAR *) tempBuf;
(*tclWinProcs->deleteFileProc)(nativeTmp);
if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
(*tclWinProcs->setFileAttributesProc)(nativeTmp,
FILE_ATTRIBUTE_NORMAL);
(*tclWinProcs->deleteFileProc)(nativeTmp);
return TCL_OK;
} else {
(*tclWinProcs->deleteFileProc)(nativeDst);
(*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
}
}
/*
* Can't backup dst file or move src file. Return that
* error. Could happen if an open file refers to dst.
*/
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
}
return result;
}
}
}
return TCL_ERROR;
}
