char* findfile (Tcl_Interp *interp, char *name) { int i; char *library, *file; static Tcl_DString *dsPtr = NULL; static char *dirs[] = { "/bitmaps/", "/site/", "/apps/", "/", NULL }; if (! dsPtr) { dsPtr = (Tcl_DString *) ckalloc(sizeof(Tcl_DString)); Tcl_DStringInit(dsPtr); } file = Tcl_TranslateFileName(interp, name, dsPtr); if (file && access(file, R_OK) == 0) { Tcl_ResetResult(interp); return FixPath(file); } buffersize(strlen(name)+20); strcpy(buffer, "~/.tkined/"); strcat(buffer, name); file = Tcl_TranslateFileName(interp, buffer, dsPtr); if (file && access(file, R_OK) == 0) { Tcl_ResetResult(interp); return FixPath(file); } library = Tcl_GetVar2(interp, "tkined", "library", TCL_GLOBAL_ONLY); if (! library) { Tcl_ResetResult(interp); return (char *) NULL; } buffersize(strlen(library)+strlen(name)+20); for (i = 0; dirs[i]; i++) { strcpy(buffer, library); strcat(buffer, dirs[i]); strcat(buffer, name); file = Tcl_TranslateFileName(interp, buffer, dsPtr); if (file && access(file, R_OK) == 0) { Tcl_ResetResult(interp); return FixPath(file); } } return (char *) NULL; }
int tcl_pmepot_writedx(ClientData nodata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { pmepot_data *data; Tcl_DString fstring; char *fname; if ( objc != 3 ) { Tcl_SetResult(interp,"args: handle filename",TCL_VOLATILE); return TCL_ERROR; } data = Tcl_GetAssocData(interp, Tcl_GetString(objv[1]), 0); if ( ! data ) { Tcl_SetResult(interp,"Pmepot bug: unable to access handle.",TCL_VOLATILE); return TCL_ERROR; } fname = Tcl_TranslateFileName(interp,Tcl_GetString(objv[2]),&fstring); if ( 0 == fname ) { return TCL_ERROR; } if ( pmepot_writedx(data,fname) ) { Tcl_DStringFree(&fstring); Tcl_SetResult(interp,"Pmepot bug: unable to write file.",TCL_VOLATILE); return TCL_ERROR; } Tcl_DStringFree(&fstring); return TCL_OK; }
static int SourceRcFile(Tcl_Interp *interp, char *fileName) { Tcl_DString temp; char *fullName; int result = 0; if (! fileName) { return 0; } Tcl_DStringInit(&temp); fullName = Tcl_TranslateFileName(interp, fileName, &temp); if (fullName == NULL) { TnmWriteMessage(Tcl_GetStringResult(interp)); TnmWriteMessage("\n"); } else { Tcl_Channel channel; channel = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (channel) { Tcl_Close((Tcl_Interp *) NULL, channel); result = 1; if (Tcl_EvalFile(interp, fullName) != TCL_OK) { TnmWriteMessage(Tcl_GetStringResult(interp)); TnmWriteMessage("\n"); } } } Tcl_DStringFree(&temp); return result; }
void Tcl_SourceRCFile( Tcl_Interp *interp) /* Interpreter to source rc file into. */ { Tcl_DString temp; const char *fileName; Tcl_Channel chan; fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; Tcl_DStringInit(&temp); fullName = Tcl_TranslateFileName(interp, fileName, &temp); if (fullName == NULL) { /* * Couldn't translate the file name (e.g. it referred to a bogus * user or there was no HOME environment variable). Just do * nothing. */ } else { /* * Test for the existence of the rc file before trying to read it. */ c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1); Tcl_Close(NULL, c); Tcl_IncrRefCount(fullNameObj); if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } Tcl_DecrRefCount(fullNameObj); } } Tcl_DStringFree(&temp); } }
void Tcl_SourceRCFile( Tcl_Interp *interp) /* Interpreter to source rc file into. */ { Tcl_DString temp; CONST char *fileName; Tcl_Channel errChannel; fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; CONST char *fullName; Tcl_DStringInit(&temp); fullName = Tcl_TranslateFileName(interp, fileName, &temp); if (fullName == NULL) { /* * Couldn't translate the file name (e.g. it referred to a bogus * user or there was no HOME environment variable). Just do * nothing. */ } else { /* * Test for the existence of the rc file before trying to read it. */ c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != (Tcl_Channel) NULL) { Tcl_Close(NULL, c); if (Tcl_EvalFile(interp, fullName) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } } } Tcl_DStringFree(&temp); } }
/*----------------------------------------------------------------------------- * ChmodFileNameObj -- * Change the mode of a file by name. * * Parameters: * o interp - Pointer to the current interpreter, error messages will be * returned in the result. * o modeInfo - Infomation with the mode to set the file to. * o fileName - Name of the file to change. * Returns: * TCL_OK or TCL_ERROR. *----------------------------------------------------------------------------- */ static int ChmodFileNameObj (Tcl_Interp *interp, modeInfo_t modeInfo, Tcl_Obj *fileNameObj) { char *filePath; struct stat fileStat; Tcl_DString pathBuf; int newMode; char *fileName; Tcl_DStringInit (&pathBuf); fileName = Tcl_GetStringFromObj (fileNameObj, NULL); filePath = Tcl_TranslateFileName (interp, fileName, &pathBuf); if (filePath == NULL) { Tcl_DStringFree (&pathBuf); return TCL_ERROR; } if (modeInfo.symMode != NULL) { if (stat (filePath, &fileStat) != 0) goto fileError; newMode = ConvSymMode (interp, modeInfo.symMode, fileStat.st_mode & 07777); if (newMode < 0) goto errorExit; } else { newMode = modeInfo.absMode; } if (TclXOSchmod (interp, filePath, (unsigned short) newMode) < 0) return TCL_ERROR; Tcl_DStringFree (&pathBuf); return TCL_OK; fileError: TclX_AppendObjResult (interp, filePath, ": ", Tcl_PosixError (interp), (char *) NULL); errorExit: Tcl_DStringFree (&pathBuf); return TCL_ERROR; }
static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; } mode = (int) strtol(argv[1], &rest, 8); if ((rest == argv[1]) || (*rest != '\0')) { goto usage; } for (i = 2; i < argc; i++) { Tcl_DString buffer; const char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; }
static TkBitmap * GetBitmap( Tcl_Interp *interp, /* Interpreter to use for error reporting, * this may be NULL. */ Tk_Window tkwin, /* Window in which bitmap will be used. */ const char *string) /* Description of bitmap. See manual entry for * details on legal syntax. */ { Tcl_HashEntry *nameHashPtr, *predefHashPtr; TkBitmap *bitmapPtr, *existingBitmapPtr; TkPredefBitmap *predefPtr; Pixmap bitmap; int isNew, width, height, dummy2; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!dispPtr->bitmapInit) { BitmapInit(dispPtr); } nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &isNew); if (!isNew) { existingBitmapPtr = Tcl_GetHashValue(nameHashPtr); for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { if ((Tk_Display(tkwin) == bitmapPtr->display) && (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) { bitmapPtr->resourceRefCount++; return bitmapPtr; } } } else { existingBitmapPtr = NULL; } /* * No suitable bitmap exists. Create a new bitmap from the information * contained in the string. If the string starts with "@" then the rest of * the string is a file name containing the bitmap. Otherwise the string * must refer to a bitmap defined by a call to Tk_DefineBitmap. */ if (*string == '@') { /* INTL: ISO char */ Tcl_DString buffer; int result; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't specify bitmap with '@' in a safe interpreter", -1)); Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); goto error; } /* * Note that we need to cast away the const from the string because * Tcl_TranslateFileName is non-const, even though it doesn't modify * the string. */ string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer); if (string == NULL) { goto error; } result = TkReadBitmapFile(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), string, (unsigned int *) &width, (unsigned int *) &height, &bitmap, &dummy2, &dummy2); if (result != BitmapSuccess) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading bitmap file \"%s\"", string)); Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL); } Tcl_DStringFree(&buffer); goto error; } Tcl_DStringFree(&buffer); } else { predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable, string); if (predefHashPtr == NULL) { /* * The following platform specific call allows the user to define * bitmaps that may only exist during run time. If it returns None * nothing was found and we return the error. */ bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string, &width, &height); if (bitmap == None) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bitmap \"%s\" not defined", string)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", string, NULL); } goto error; } } else { predefPtr = Tcl_GetHashValue(predefHashPtr); width = predefPtr->width; height = predefPtr->height; if (predefPtr->native) { bitmap = TkpCreateNativeBitmap(Tk_Display(tkwin), predefPtr->source); if (bitmap == None) { Tcl_Panic("native bitmap creation failed"); } } else { bitmap = XCreateBitmapFromData(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), predefPtr->source, (unsigned)width, (unsigned)height); } } } /* * Add information about this bitmap to our database. */ bitmapPtr = ckalloc(sizeof(TkBitmap)); bitmapPtr->bitmap = bitmap; bitmapPtr->width = width; bitmapPtr->height = height; bitmapPtr->display = Tk_Display(tkwin); bitmapPtr->screenNum = Tk_ScreenNumber(tkwin); bitmapPtr->resourceRefCount = 1; bitmapPtr->objRefCount = 0; bitmapPtr->nameHashPtr = nameHashPtr; bitmapPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap, &isNew); if (!isNew) { Tcl_Panic("bitmap already registered in Tk_GetBitmap"); } bitmapPtr->nextPtr = existingBitmapPtr; Tcl_SetHashValue(nameHashPtr, bitmapPtr); Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr); return bitmapPtr; error: if (isNew) { Tcl_DeleteHashEntry(nameHashPtr); } return NULL; }
/* ARGSUSED */ static int MemoryCmd( ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[]) { const char *fileName; FILE *fileP; Tcl_DString buffer; int result; size_t len; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option [args..]\"", NULL); return TCL_ERROR; } if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " file\"", NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_AppendResult(interp, "error accessing ", argv[2], NULL); return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"break_on_malloc") == 0) { if (argc != 3) { goto argError; } if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, "maximum bytes allocated", maximum_bytes_malloced)); return TCL_OK; } if (strcmp(argv[1],"init") == 0) { if (argc != 3) { goto bad_suboption; } init_malloced_bodies = (strcmp(argv[2],"on") == 0); return TCL_OK; } if (strcmp(argv[1],"objs") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " objs file\"", NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } fileP = fopen(fileName, "w"); if (fileP == NULL) { Tcl_AppendResult(interp, "cannot open output file", NULL); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); fclose(fileP); Tcl_DStringFree(&buffer); return TCL_OK; } if (strcmp(argv[1],"onexit") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " onexit file\"", NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } onExitMemDumpFileName = dumpFile; strcpy(onExitMemDumpFileName,fileName); Tcl_DStringFree(&buffer); return TCL_OK; } if (strcmp(argv[1],"tag") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " tag string\"", NULL); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { TclpFree((char *) curTagPtr); } len = strlen(argv[2]); curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len)); curTagPtr->refCount = 0; memcpy(curTagPtr->string, argv[2], len + 1); return TCL_OK; } if (strcmp(argv[1],"trace") == 0) { if (argc != 3) { goto bad_suboption; } alloc_tracing = (strcmp(argv[2],"on") == 0); return TCL_OK; } if (strcmp(argv[1],"trace_on_at_malloc") == 0) { if (argc != 3) { goto argError; } if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"validate") == 0) { if (argc != 3) { goto bad_suboption; } validate_memory = (strcmp(argv[2],"on") == 0); return TCL_OK; } Tcl_AppendResult(interp, "bad option \"", argv[1], "\": should be active, break_on_malloc, info, init, objs, onexit, " "tag, trace, trace_on_at_malloc, or validate", NULL); return TCL_ERROR; argError: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " count\"", NULL); return TCL_ERROR; bad_suboption: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " on|off\"", NULL); return TCL_ERROR; }
char * TkGetBitmapData( Tcl_Interp *interp, /* For reporting errors, or NULL. */ const char *string, /* String describing bitmap. May be NULL. */ const char *fileName, /* Name of file containing bitmap description. * Used only if string is NULL. Must not be * NULL if string is NULL. */ int *widthPtr, int *heightPtr, /* Dimensions of bitmap get returned here. */ int *hotXPtr, int *hotYPtr) /* Position of hot spot or -1,-1. */ { int width, height, numBytes, hotX, hotY; const char *expandedFileName; char *p, *end; ParseInfo pi; char *data = NULL; Tcl_DString buffer; pi.string = string; if (string == NULL) { if ((interp != NULL) && Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't get bitmap data from a file in a", " safe interpreter", NULL); return NULL; } expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer); if (expandedFileName == NULL) { return NULL; } pi.chan = Tcl_OpenFileChannel(interp, expandedFileName, "r", 0); Tcl_DStringFree(&buffer); if (pi.chan == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read bitmap file \"", fileName, "\": ", Tcl_PosixError(interp), NULL); } return NULL; } if (Tcl_SetChannelOption(interp, pi.chan, "-translation", "binary") != TCL_OK) { return NULL; } if (Tcl_SetChannelOption(interp, pi.chan, "-encoding", "binary") != TCL_OK) { return NULL; } } else { pi.chan = NULL; } /* * Parse the lines that define the dimensions of the bitmap, plus the * first line that defines the bitmap data (it declares the name of a data * variable but doesn't include any actual data). These lines look * something like the following: * * #define foo_width 16 * #define foo_height 16 * #define foo_x_hot 3 * #define foo_y_hot 3 * static char foo_bits[] = { * * The x_hot and y_hot lines may or may not be present. It's important to * check for "char" in the last line, in order to reject old X10-style * bitmaps that used shorts. */ width = 0; height = 0; hotX = -1; hotY = -1; while (1) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_') && (strcmp(pi.word+pi.wordLength-6, "_width") == 0)) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } width = strtol(pi.word, &end, 0); if ((end == pi.word) || (*end != 0)) { goto error; } } else if ((pi.wordLength >= 7) && (pi.word[pi.wordLength-7] == '_') && (strcmp(pi.word+pi.wordLength-7, "_height") == 0)) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } height = strtol(pi.word, &end, 0); if ((end == pi.word) || (*end != 0)) { goto error; } } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_') && (strcmp(pi.word+pi.wordLength-6, "_x_hot") == 0)) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } hotX = strtol(pi.word, &end, 0); if ((end == pi.word) || (*end != 0)) { goto error; } } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_') && (strcmp(pi.word+pi.wordLength-6, "_y_hot") == 0)) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } hotY = strtol(pi.word, &end, 0); if ((end == pi.word) || (*end != 0)) { goto error; } } else if ((pi.word[0] == 'c') && (strcmp(pi.word, "char") == 0)) { while (1) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } if ((pi.word[0] == '{') && (pi.word[1] == 0)) { goto getData; } } } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) { if (interp != NULL) { Tcl_AppendResult(interp, "format error in bitmap data; ", "looks like it's an obsolete X10 bitmap file", NULL); } goto errorCleanup; } } /* * Now we've read everything but the data. Allocate an array and read in * the data. */ getData: if ((width <= 0) || (height <= 0)) { goto error; } numBytes = ((width+7)/8) * height; data = ckalloc((unsigned) numBytes); for (p = data; numBytes > 0; p++, numBytes--) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; } *p = (char) strtol(pi.word, &end, 0); if (end == pi.word) { goto error; } } /* * All done. Clean up and return. */ if (pi.chan != NULL) { Tcl_Close(NULL, pi.chan); } *widthPtr = width; *heightPtr = height; *hotXPtr = hotX; *hotYPtr = hotY; return data; error: if (interp != NULL) { Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); } errorCleanup: if (data != NULL) { ckfree(data); } if (pi.chan != NULL) { Tcl_Close(NULL, pi.chan); } return NULL; }
static int ReadOptionFile( Tcl_Interp *interp, /* Interpreter to use for reporting results. */ Tk_Window tkwin, /* Token for window: options are entered for * this window's main window. */ const char *fileName, /* Name of file containing options. */ int priority) /* Priority level to use for options in this * file, such as TK_USER_DEFAULT_PRIO or * TK_INTERACTIVE_PRIO. Must be between 0 and * TK_MAX_PRIO. */ { const char *realName; char *buffer; int result, bufferSize; Tcl_Channel chan; Tcl_DString newName; /* * Prevent file system access in a safe interpreter. */ if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't read options from a file in a", " safe interpreter", NULL); return TCL_ERROR; } realName = Tcl_TranslateFileName(interp, fileName, &newName); if (realName == NULL) { return TCL_ERROR; } chan = Tcl_OpenFileChannel(interp, realName, "r", 0); Tcl_DStringFree(&newName); if (chan == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } /* * Compute size of file by seeking to the end of the file. This will * overallocate if we are performing CRLF translation. */ bufferSize = (int) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_END); Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); if (bufferSize < 0) { Tcl_AppendResult(interp, "error seeking to end of file \"", fileName, "\":", Tcl_PosixError(interp), NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } buffer = ckalloc((unsigned) bufferSize+1); bufferSize = Tcl_Read(chan, buffer, bufferSize); if (bufferSize < 0) { Tcl_AppendResult(interp, "error reading file \"", fileName, "\":", Tcl_PosixError(interp), NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } Tcl_Close(NULL, chan); buffer[bufferSize] = 0; result = AddFromString(interp, tkwin, buffer, priority); ckfree(buffer); return result; }
/* *--------------------------------------------------------------------------- * * Blt_CreatePipeline -- * * Given an objc/objv array, instantiate a pipeline of processes as * described by the objv. * * Results: * The return value is a count of the number of new processes created, or * -1 if an error occurred while creating the pipeline. *pidArrayPtr is * filled in with the address of a dynamically allocated array giving the * ids of all of the processes. * * It is up to the caller to free this array when it isn't needed * anymore. * * If stdinPipePtr isn't NULL, then *stdinPipePtr is filled with the file * id for the input pipe for the pipeline (if any): the caller must * eventually close this file. * * If stdoutPipePtr isn't NULL, then *stdoutPipePtr is filled with the * file id for the output pipe from the pipeline: the caller must close * this file. * * If stderrPipePtr isn't NULL, then *stderrPipePtr is filled with a file * id that may be used to read error output after the pipeline completes. * * Side effects: * Processes and pipes are created. * *--------------------------------------------------------------------------- */ int Blt_CreatePipeline( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ int objc, /* Number of entries in objv. */ Tcl_Obj *const *objv, /* Array of strings describing commands in * pipeline plus I/O redirection with <, <<, * >, etc. Objv[objc] must be NULL. */ ProcessId **pidArrayPtr, /* (out) Word at *pidArrayPtr gets filled in * with address of array of pids for processes * in pipeline (first pid is first process in * pipeline). */ int *stdinPipePtr, /* (out) If non-NULL, input to the pipeline * comes from a pipe (unless overridden by * redirection in the command). The file id * with which to write to this pipe is stored * at *stdinPipePtr. NULL means command * specified its own input source. */ int *stdoutPipePtr, /* (out) If non-NULL, output to the pipeline * goes to a pipe, unless overriden by * redirection in the command. The file id * with which to read frome this pipe is * stored at *stdoutPipePtr. NULL means * command specified its own output sink. */ int *stderrPipePtr) /* (out) If non-NULL, all stderr output from * the pipeline will go to a temporary file * created here, and a descriptor to read the * file will be left at *stderrPipePtr. The * file will be removed already, so closing * this descriptor will be the end of the * file. If this is NULL, then all stderr * output goes to our stderr. If the pipeline * specifies redirection then the file will * still be created but it will never get any * data. */ { int *pids = NULL; /* Points to malloc-ed array holding all the * pids of child processes. */ int nPids; /* Actual number of processes that exist at * *pids right now. */ int cmdCount; /* Count of number of distinct commands found * in objc/objv. */ char *inputLiteral = NULL; /* If non-null, then this points to a string * containing input data (specified via <<) to * be piped to the first process in the * pipeline. */ char *p; int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput; Tcl_DString execBuffer; int pipeIn; int isOpen[3]; int curFd[3]; /* If non-zero, then fd should be closed * when cleaning up. */ int fd[3]; char **argv; fd[0] = fd[1] = fd[2] = -1; isOpen[0] = isOpen[1] = isOpen[2] = FALSE; if (stdinPipePtr != NULL) { *stdinPipePtr = -1; } if (stdoutPipePtr != NULL) { *stdoutPipePtr = -1; } if (stderrPipePtr != NULL) { *stderrPipePtr = -1; } Tcl_DStringInit(&execBuffer); pipeIn = curFd[0] = curFd[1] = -1; nPids = 0; /* * First, scan through all the arguments to figure out the structure of * the pipeline. Process all of the input and output redirection * arguments and remove them from the argument list in the pipeline. * Count the number of distinct processes (it's the number of "|" * arguments plus one) but don't remove the "|" arguments because they'll * be used in the second pass to seperate the individual child processes. * * Cannot start the child processes in this pass because the redirection * symbols may appear anywhere in the command line -- e.g., the '<' that * specifies the input to the entire pipe may appear at the very end of * the argument list. */ /* Convert all the Tcl_Objs to strings. */ argv = Blt_AssertMalloc((objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } argv[i] = NULL; lastBar = -1; cmdCount = 1; for (i = 0; i < objc; i++) { skip = 0; p = argv[i]; switch (*p++) { case '\\': p++; continue; case '|': if (*p == '&') { p++; } if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (objc - 1))) { Tcl_AppendResult(interp, "illegal use of | or |& in command", (char *)NULL); goto error; } } lastBar = i; cmdCount++; break; case '<': if (isOpen[0] != 0) { isOpen[0] = FALSE; CloseFile(fd[0]); } if (*p == '<') { fd[0] = -1; inputLiteral = p + 1; skip = 1; if (*inputLiteral == '\0') { inputLiteral = argv[i + 1]; if (inputLiteral == NULL) { Tcl_AppendResult(interp, "can't specify \"", argv[i], "\" as last word in command", (char *)NULL); goto error; } skip = 2; } } else { inputLiteral = NULL; fd[0] = FileForRedirect(interp, p, argv[i], TRUE, argv[i + 1], O_RDONLY, &skip, &isOpen[0]); if (fd[0] < 0) { goto error; } } break; case '>': atOK = TRUE; flags = O_WRONLY | O_CREAT | O_TRUNC; errorToOutput = FALSE; if (*p == '>') { p++; atOK = FALSE; flags = O_WRONLY | O_CREAT; } if (*p == '&') { if (isOpen[2] != 0) { isOpen[2] = FALSE; CloseFile(fd[2]); } errorToOutput = TRUE; p++; } if (isOpen[1] != 0) { isOpen[1] = FALSE; CloseFile(fd[1]); } fd[1] = FileForRedirect(interp, p, argv[i], atOK, argv[i + 1], flags, &skip, &isOpen[1]); if (fd[1] < 0) { goto error; } if (errorToOutput) { isOpen[2] = FALSE; fd[2] = fd[1]; } break; case '2': if (*p != '>') { break; } p++; atOK = TRUE; flags = O_WRONLY | O_CREAT | O_TRUNC; if (*p == '>') { p++; atOK = FALSE; flags = O_WRONLY | O_CREAT; } if (isOpen[2] != 0) { isOpen[2] = FALSE; CloseFile(fd[2]); } fd[2] = FileForRedirect(interp, p, argv[i], atOK, argv[i + 1], flags, &skip, &isOpen[2]); if (fd[2] < 0) { goto error; } break; } if (skip != 0) { for (j = i + skip; j < objc; j++) { argv[j - skip] = argv[j]; } objc -= skip; i -= 1; } } if (fd[0] == -1) { if (inputLiteral != NULL) { /* * The input for the first process is immediate data coming from * Tcl. Create a temporary file for it and put the data into the * file. */ fd[0] = CreateTempFile(inputLiteral); if (fd[0] < 0) { Tcl_AppendResult(interp, "can't create input file for command: ", Tcl_PosixError(interp), (char *)NULL); goto error; } isOpen[0] = TRUE; } else if (stdinPipePtr != NULL) { /* * The input for the first process in the pipeline is to come from * a pipe that can be written from by the caller. */ if (CreatePipe(interp, &fd[0], stdinPipePtr) != TCL_OK) { goto error; } isOpen[0] = TRUE; } else { /* * The input for the first process comes from stdin. */ fd[0] = 0; } } if (fd[1] == -1) { if (stdoutPipePtr != NULL) { /* * Output from the last process in the pipeline is to go to a pipe * that can be read by the caller. */ if (CreatePipe(interp, stdoutPipePtr, &fd[1]) != TCL_OK) { goto error; } isOpen[1] = TRUE; } else { /* * The output for the last process goes to stdout. */ fd[1] = 1; } } if (fd[2] == -1) { if (stderrPipePtr != NULL) { /* * Stderr from the last process in the pipeline is to go to a pipe * that can be read by the caller. */ if (CreatePipe(interp, stderrPipePtr, &fd[2]) != TCL_OK) { goto error; } isOpen[2] = TRUE; } else { /* * Errors from the pipeline go to stderr. */ fd[2] = 2; } } /* * Scan through the objc array, creating a process for each group of * arguments between the "|" characters. */ Tcl_ReapDetachedProcs(); pids = Blt_AssertMalloc(cmdCount * sizeof(int)); curFd[0] = fd[0]; lastArg = 0; /* Suppress compiler warning */ for (i = 0; i < objc; i = lastArg + 1) { int joinThisError; int pid; /* * Convert the program name into native form. */ argv[i] = Tcl_TranslateFileName(interp, argv[i], &execBuffer); if (argv[i] == NULL) { goto error; } /* * Find the end of the curent segment of the pipeline. */ joinThisError = 0; for (lastArg = i + 1; lastArg < objc; lastArg++) { if (argv[lastArg][0] == '|') { if (argv[lastArg][1] == '\0') { break; } if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) { joinThisError = 1; break; } } } argv[lastArg] = NULL; /* * If this is the last segment, use the specified fd[1]. Otherwise * create an intermediate pipe. pipeIn will become the curInFile for * the next segment of the pipe. */ if (lastArg == objc) { curFd[1] = fd[1]; } else { if (CreatePipe(interp, &pipeIn, &curFd[1]) != TCL_OK) { goto error; } } if (joinThisError != 0) { curFd[2] = curFd[1]; } else { curFd[2] = fd[2]; } if (CreateProcess(interp, lastArg - i, argv + i, curFd[0], curFd[1], curFd[2], &pid) != TCL_OK) { goto error; } Tcl_DStringFree(&execBuffer); pids[nPids] = pid; nPids++; /* * Close off our copies of file descriptors that were set up for this * child, then set up the input for the next child. */ if ((curFd[0] >= 0) && (curFd[0] != fd[0])) { CloseFile(curFd[0]); } curFd[0] = pipeIn; pipeIn = -1; if ((curFd[1] >= 0) && (curFd[1] != fd[1])) { CloseFile(curFd[1]); } curFd[1] = -1; } *pidArrayPtr = pids; /* * All done. Cleanup open files lying around and then return. */ cleanup: Tcl_DStringFree(&execBuffer); for (i = 0; i < 3; i++) { if (isOpen[i]) { CloseFile(fd[i]); } } if (argv != NULL) { Blt_Free(argv); } return nPids; /* * An error occured. There could have been extra files open, such as * pipes between children. Clean them all up. Detach any child processes * that have been created. */ error: if (pipeIn >= 0) { CloseFile(pipeIn); } if ((curFd[2] >= 0) && (curFd[2] != fd[2])) { CloseFile(curFd[2]); } if ((curFd[1] >= 0) && (curFd[1] != fd[1])) { CloseFile(curFd[1]); } if ((curFd[0] >= 0) && (curFd[0] != fd[0])) { CloseFile(curFd[0]); } if ((stdinPipePtr != NULL) && (*stdinPipePtr >= 0)) { CloseFile(*stdinPipePtr); *stdinPipePtr = -1; } if ((stdoutPipePtr != NULL) && (*stdoutPipePtr >= 0)) { CloseFile(*stdoutPipePtr); *stdoutPipePtr = -1; } if ((stderrPipePtr != NULL) && (*stderrPipePtr >= 0)) { CloseFile(*stderrPipePtr); *stderrPipePtr = -1; } if (pids != NULL) { for (i = 0; i < nPids; i++) { if (pids[i] != -1) { Tcl_DetachPids(1, (Tcl_Pid *)(pids + i)); } } Blt_Free(pids); } nPids = -1; goto cleanup; }
static int FileForRedirect( Tcl_Interp *interp, /* Intepreter to use for error reporting. */ char *spec, /* Points to character just after redirection * character. */ char *arg, /* Pointer to entire argument containing spec: * used for error reporting. */ int atOK, /* Non-zero means that '@' notation can be * used to specify a channel, zero means that * it isn't. */ char *nextArg, /* Next argument in argc/argv array, if needed * for file name or channel name. May be * NULL. */ int flags, /* Flags to use for opening file or to specify * mode for channel. */ int *skipPtr, /* (out) Filled with 1 if redirection target * was in spec, 2 if it was in nextArg. */ int *closePtr) /* (out) Filled with one if the caller should * close the file when done with it, zero * otherwise. */ { int writing = (flags & O_WRONLY); int fd; *skipPtr = 1; if ((atOK != 0) && (*spec == '@')) { int direction; Tcl_Channel chan; spec++; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } chan = Tcl_GetChannel(interp, spec, NULL); if (chan == NULL) { return -1; } direction = (writing) ? TCL_WRITABLE : TCL_READABLE; fd = GetFdFromChannel(chan, direction); if (fd < 0) { Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan), "\" wasn't opened for ", ((writing) ? "writing" : "reading"), (char *)NULL); return -1; } if (writing) { /* * Be sure to flush output to the file, so that anything * written by the child appears after stuff we've already * written. */ Tcl_Flush(chan); } } else { char *name; Tcl_DString nameString; if (*spec == '\0') { spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } name = Tcl_TranslateFileName(interp, spec, &nameString); if (name != NULL) { fd = OpenFile(name, flags); } else { fd = -1; } Tcl_DStringFree(&nameString); if (fd < 0) { Tcl_AppendResult(interp, "can't ", ((writing) ? "write" : "read"), " file \"", spec, "\": ", Tcl_PosixError(interp), (char *)NULL); return -1; } *closePtr = TRUE; } return fd; badLastArg: Tcl_AppendResult(interp, "can't specify \"", arg, "\" as last word in command", (char *)NULL); return -1; }
/* Implement the Windows version of the ide_get_directory command. */ static int get_directory_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv) { BROWSEINFO bi; char buf[MAX_PATH + 1]; Tk_Window parent; int i, oldMode; LPITEMIDLIST idlist; char *p; int atts; Tcl_DString tempBuffPtr; #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1) Tcl_DString titleDString; Tcl_DString initialDirDString; Tcl_DString resultDString; Tcl_DStringInit(&titleDString); Tcl_DStringInit(&initialDirDString); #endif Tcl_DStringInit(&tempBuffPtr); bi.hwndOwner = NULL; bi.pidlRoot = NULL; bi.pszDisplayName = buf; bi.lpszTitle = NULL; bi.ulFlags = 0; bi.lpfn = NULL; bi.lParam = 0; bi.iImage = 0; parent = Tk_MainWindow (interp); for (i = 1; i < argc; i += 2) { int v; int len; v = i + 1; len = strlen (argv[i]); if (strncmp (argv[i], "-parent", len) == 0) { if (v == argc) goto arg_missing; parent = Tk_NameToWindow (interp, argv[v], Tk_MainWindow (interp)); if (parent == NULL) return TCL_ERROR; } else if (strncmp (argv[i], "-title", len) == 0) { if (v == argc) goto arg_missing; #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1) Tcl_UtfToExternalDString(NULL, argv[v], -1, &titleDString); bi.lpszTitle = Tcl_DStringValue(&titleDString); #else bi.lpszTitle = argv[v]; #endif } else if (strncmp (argv[i], "-initialdir", len) == 0) { if (v == argc) goto arg_missing; /* bi.lParam will be passed to the callback function.(save the need for globals)*/ bi.lParam = (LPARAM) Tcl_TranslateFileName(interp, argv[v], &tempBuffPtr); #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1) Tcl_UtfToExternalDString(NULL, (char *) bi.lParam, -1, &initialDirDString); bi.lParam = (LPARAM) Tcl_DStringValue(&initialDirDString); #endif bi.lpfn = MyBrowseCallbackProc; } else { Tcl_AppendResult (interp, "unknown option \"", argv[i], "\", must be -parent or -title", (char *) NULL); return TCL_ERROR; } } if (Tk_WindowId (parent) == None) Tk_MakeWindowExist (parent); bi.hwndOwner = Tk_GetHWND (Tk_WindowId (parent)); oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); idlist = SHBrowseForFolder (&bi); Tcl_SetServiceMode(oldMode); if (idlist == NULL) { /* User pressed the cancel button. */ return TCL_OK; } if (! SHGetPathFromIDList (idlist, buf)) { Tcl_SetResult (interp, "could not get path for directory", TCL_STATIC); return TCL_ERROR; } /* Ensure the directory exists. */ atts = GetFileAttributesA (buf); if (atts == -1 || ! (atts & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_AppendResult (interp, "path \"", buf, "\" is not a directory", (char *) NULL); /* FIXME: free IDLIST. */ return TCL_ERROR; } /* FIXME: We are supposed to free IDLIST using the shell task allocator, but cygwin32 doesn't define the required interfaces yet. */ /* Normalize the path for Tcl. */ #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1) Tcl_ExternalToUtfDString(NULL, buf, -1, &resultDString); p = Tcl_DStringValue(&resultDString); #else p = buf; #endif for (; *p != '\0'; ++p) if (*p == '\\') *p = '/'; Tcl_ResetResult(interp); #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1) Tcl_SetResult(interp, Tcl_DStringValue(&resultDString), TCL_VOLATILE); Tcl_DStringFree(&resultDString); Tcl_DStringFree(&titleDString); Tcl_DStringFree(&initialDirDString); #else Tcl_SetResult(interp, buf, TCL_VOLATILE); #endif Tcl_DStringFree(&tempBuffPtr); return TCL_OK; arg_missing: Tcl_AppendResult(interp, "value for \"", argv[argc - 1], "\" missing", NULL); return TCL_ERROR; }