static int ChanTruncateObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; Tcl_WideInt length; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { /* * User is supplying an explicit length. */ if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (length < 0) { Tcl_AppendResult(interp, "cannot truncate to negative length of file", NULL); return TCL_ERROR; } } else { /* * User wants to truncate to the current file position. */ length = Tcl_Tell(chan); if (length == Tcl_WideAsLong(-1)) { Tcl_AppendResult(interp, "could not determine current location in \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } } if (Tcl_TruncateChannel(chan, length) != TCL_OK) { Tcl_AppendResult(interp, "error during truncate on \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } return TCL_OK; }
/*----------------------------------------------------------------------------- * BlockSignals -- * * Block or unblock the specified signals. Returns an error if not a Posix * system. * * Parameters:: * o interp - Error messages are returned in result. * o action - SIG_BLOCK or SIG_UNBLOCK. * o signals - Boolean array indexed by signal number that indicates * the requested signals. * Returns: * TCL_OK or TCL_ERROR, with error message in interp. *----------------------------------------------------------------------------- */ static int BlockSignals (Tcl_Interp *interp, int action, unsigned char signals[]) { #ifndef NO_SIGACTION int signalNum; sigset_t sigBlockSet; sigemptyset (&sigBlockSet); for (signalNum = 0; signalNum < MAXSIG; signalNum++) { if (signals [signalNum]) sigaddset (&sigBlockSet, signalNum); } if (sigprocmask (action, &sigBlockSet, NULL)) { TclX_AppendObjResult (interp, Tcl_PosixError (interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; #else TclX_AppendObjResult (interp, "Posix signals are not available on this system, ", "can not block signals"); return TCL_ERROR; #endif }
/*----------------------------------------------------------------------------- * SetSignalActions -- * * Set the signal state for the specified signals. * * Parameters:: * o interp - The list is returned in the result. * o signals - Boolean array indexed by signal number that indicates * the requested signals. * o actionFunc - The function to run when the signal is received. * o restart - Restart systems calls on signal. * o command - If the function is the "trap" function, this is the * Tcl command to run when the trap occurs. Otherwise, NULL. * Returns: * TCL_OK or TCL_ERROR, with error message in interp. *----------------------------------------------------------------------------- */ static int SetSignalActions (Tcl_Interp *interp, unsigned char signals [MAXSIG], signalProcPtr_t actionFunc, int restart, char *command) { int signalNum; for (signalNum = 0; signalNum < MAXSIG; signalNum++) { if (!signals [signalNum]) continue; if (signalTrapCmds [signalNum] != NULL) { ckfree (signalTrapCmds [signalNum]); signalTrapCmds [signalNum] = NULL; } if (command != NULL) signalTrapCmds [signalNum] = ckstrdup (command); if (SetSignalState (signalNum, actionFunc, restart) == TCL_ERROR) { TclX_AppendObjResult (interp, Tcl_PosixError (interp), " while setting ", Tcl_SignalId (signalNum), (char *) NULL); return TCL_ERROR; } } return TCL_OK; }
int TclFileReadLinkCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *contents; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } contents = Tcl_FSLink(objv[1], NULL, 0); if (contents == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read link \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_SetObjResult(interp, contents); Tcl_DecrRefCount(contents); return TCL_OK; }
/*++ GetVolumeInfo Retrieves information about a volume. Arguments: interp - Interpreter to use for error reporting. volumePath - A pointer to a string that specifies the volume. volumeInfo - A pointer to a 'VolumeInfo' structure. Return Value: A standard Tcl result. --*/ int GetVolumeInfo( Tcl_Interp *interp, char *volumePath, VolumeInfo *volumeInfo ) { struct STATFS_T fsInfo; if (STATFS_FN(volumePath, &fsInfo) != 0) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unable to retrieve mount information for \"", volumePath, "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } // Free and total space. volumeInfo->free = (Tcl_WideUInt)fsInfo.f_bsize * (Tcl_WideUInt)fsInfo.f_bfree; volumeInfo->total = (Tcl_WideUInt)fsInfo.f_bsize * (Tcl_WideUInt)fsInfo.f_blocks; volumeInfo->id = (unsigned long)F_FSID(fsInfo); volumeInfo->flags = (unsigned long)F_FLAGS(fsInfo); volumeInfo->length = (unsigned long)F_NAMELEN(fsInfo); // Not supported. volumeInfo->name[0] = '\0'; // File system type. strncpy(volumeInfo->type, F_TYPENAME(fsInfo), ARRAYSIZE(volumeInfo->type)); volumeInfo->type[ARRAYSIZE(volumeInfo->type)-1] = '\0'; return TCL_OK; }
int Tcl_CreatePipe( Tcl_Interp *interp, /* Errors returned in result. */ Tcl_Channel *rchan, /* Returned read side. */ Tcl_Channel *wchan, /* Returned write side. */ int flags) /* Reserved for future use. */ { int fileNums[2]; if (pipe(fileNums) < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } fcntl(fileNums[0], F_SETFD, FD_CLOEXEC); fcntl(fileNums[1], F_SETFD, FD_CLOEXEC); *rchan = Tcl_MakeFileChannel(INT2PTR(fileNums[0]), TCL_READABLE); Tcl_RegisterChannel(interp, *rchan); *wchan = Tcl_MakeFileChannel(INT2PTR(fileNums[1]), TCL_WRITABLE); Tcl_RegisterChannel(interp, *wchan); return TCL_OK; }
static int PutEnv(Tcl_Interp *interp, char *name, char *value) { char *s; size_t len; len = strlen(name); if (value != NULL) { len += strlen(value) + 1; } /* NB: Use malloc() directly as putenv() would expect. */ s = malloc(len + 1); if (s == NULL) { Tcl_SetResult(interp, "could not allocate memory for new env entry", TCL_STATIC); return TCL_ERROR; } strcpy(s, name); if (value != NULL) { strcat(s, "="); strcat(s, value); } if (putenv(s) != 0) { Tcl_AppendResult(interp, "could not put environment entry \"", s, "\": ", Tcl_PosixError(interp), NULL); free(s); return TCL_ERROR; } return TCL_OK; }
/* * 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 }
/*++ GetGroupList Creates a list of groups from the 'group' file located in 'etcPath'. Arguments: interp - Interpreter to use for error reporting. etcPath - Path to glFTPD's 'etc' directory. groupListPtr - Pointer to a receive a list of 'GlGroup' structures. Return Value: A standard Tcl result. Remarks: If the function fails, an error message is left in the interpreter's result. --*/ static int GetGroupList( Tcl_Interp *interp, const char *etcPath, GlGroup **groupListPtr ) { char *p; char line[512]; char groupFile[PATH_MAX]; int nameLength; long userId; FILE *stream; strncpy(groupFile, etcPath, ARRAYSIZE(groupFile)); strncat(groupFile, GLFTPD_GROUP, ARRAYSIZE(groupFile)); groupFile[ARRAYSIZE(groupFile)-1] = '\0'; stream = fopen(groupFile, "r"); if (stream == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unable to open \"", groupFile, "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } while ((p = fgets(line, ARRAYSIZE(line), stream)) != NULL) { // Strip leading spaces and skip empty or commented lines. while (*p == ' ' || *p == '\t') { p++; } if (*p == '\0' || *p == '#') { continue; } // A 'passwd' entry has 3 delimiters for 4 fields. // Format: Group:Description:GID:Irrelevant if (ParseFields(p, 3, &nameLength, &userId) == TCL_OK) { GlGroup *groupPtr = (GlGroup *)ckalloc(sizeof(GlUser)); if (nameLength >= GL_GROUP_LENGTH) { nameLength = GL_GROUP_LENGTH; } else { nameLength++; } strncpy(groupPtr->name, p, nameLength); groupPtr->name[nameLength-1] = '\0'; groupPtr->id = userId; // Insert entry at the list head. groupPtr->next = *groupListPtr; *groupListPtr = groupPtr; } } fclose(stream); return TCL_OK; }
int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ { shl_t handle; CONST char *native; char *fileName = Tcl_GetString(pathPtr); /* * The flags below used to be BIND_IMMEDIATE; they were changed at the * suggestion of Wolfgang Kechel ([email protected]): "This enables * verbosity for missing symbols when loading a shared lib and allows to * load libtk8.0.sl into tclsh8.0 without problems. In general, this * delays resolving symbols until they are actually needed. Shared libs * do no longer need all libraries linked in when they are build." */ /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path. */ Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); Tcl_DStringFree(&ds); } if (handle == NULL) { Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } *loadHandle = (Tcl_LoadHandle) handle; *unloadProcPtr = &TclpUnloadFile; return TCL_OK; }
/*++ GetUserList Creates a list of users from the 'passwd' file located in 'etcPath'. Arguments: interp - Interpreter to use for error reporting. etcPath - Path to glFTPD's 'etc' directory. userListPtr - Pointer to a receive a list of 'GlUser' structures. Return Value: A standard Tcl result. Remarks: If the function fails, an error message is left in the interpreter's result. --*/ static int GetUserList( Tcl_Interp *interp, const char *etcPath, GlUser **userListPtr ) { char *p; char line[512]; char passwdFile[PATH_MAX]; int nameLength; long userId; FILE *stream; strncpy(passwdFile, etcPath, ARRAYSIZE(passwdFile)); strncat(passwdFile, GLFTPD_PASSWD, ARRAYSIZE(passwdFile)); passwdFile[ARRAYSIZE(passwdFile)-1] = '\0'; stream = fopen(passwdFile, "r"); if (stream == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unable to open \"", passwdFile, "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } while ((p = fgets(line, ARRAYSIZE(line), stream)) != NULL) { // Strip leading spaces and skip empty or commented lines. while (*p == ' ' || *p == '\t') { p++; } if (*p == '\0' || *p == '#') { continue; } // A 'passwd' entry has 6 delimiters for 7 fields. // Format: User:Password:UID:GID:Date:HomeDir:Irrelevant if (ParseFields(p, 6, &nameLength, &userId) == TCL_OK) { GlUser *userPtr = (GlUser *)ckalloc(sizeof(GlUser)); if (nameLength >= GL_USER_LENGTH) { nameLength = GL_USER_LENGTH; } else { nameLength++; } strncpy(userPtr->name, p, nameLength); userPtr->name[nameLength-1] = '\0'; userPtr->id = userId; // Insert entry at the list head. userPtr->next = *userListPtr; *userListPtr = userPtr; } } fclose(stream); return TCL_OK; }
static void StatError( Tcl_Interp *interp, /* The interp that has the error */ CONST char *fileName) /* The name of the file which caused the * error. */ { TclWinConvertError(GetLastError()); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not read \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); }
static int SetFileReadOnly( Tcl_Interp *interp, /* The interp to report errors with. */ int objIndex, /* The index of the attribute. */ char *fileName, /* The name of the file. */ Tcl_Obj *readOnlyPtr) /* The command line object. */ { OSErr err; FSSpec fileSpec; HParamBlockRec paramBlock; int hidden; err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec); if (err == noErr) { if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) { return TCL_ERROR; } paramBlock.fileParam.ioCompletion = NULL; paramBlock.fileParam.ioNamePtr = fileSpec.name; paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum; paramBlock.fileParam.ioDirID = fileSpec.parID; if (hidden) { err = PBHSetFLock(¶mBlock, 0); } else { err = PBHRstFLock(¶mBlock, 0); } } if (err == fnfErr) { long dirID; Boolean isDirectory = 0; err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); if ((err == noErr) && isDirectory) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot set a directory to read-only when File Sharing is turned off", (char *) NULL); return TCL_ERROR; } else { err = fnfErr; } } if (err != noErr) { errno = TclMacOSErrorToPosixError(err); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set attributes for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; }
/* ARGSUSED */ int Tcl_SeekObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ Tcl_WideInt offset; /* Where to seek? */ int mode; /* How to seek? */ Tcl_WideInt result; /* Of calling Tcl_Seek. */ int optionIndex; static const char *originOptions[] = { "start", "current", "end", NULL }; static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { return TCL_ERROR; } mode = SEEK_SET; if (objc == 4) { if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } mode = modeArray[optionIndex]; } result = Tcl_Seek(chan, offset, mode); if (result == Tcl_LongAsWide(-1)) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_AppendResult(interp, "error during seek on \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); } return TCL_ERROR; } return TCL_OK; }
static int GetFileFinderAttributes( Tcl_Interp *interp, /* The interp to report errors with. */ int objIndex, /* The index of the attribute option. */ char *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { OSErr err; FSSpec fileSpec; FInfo finfo; err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec); if (err == noErr) { err = FSpGetFInfo(&fileSpec, &finfo); } if (err == noErr) { switch (objIndex) { case MAC_CREATOR_ATTRIBUTE: *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator); break; case MAC_HIDDEN_ATTRIBUTE: *attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags & kIsInvisible); break; case MAC_TYPE_ATTRIBUTE: *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType); break; } } else if (err == fnfErr) { long dirID; Boolean isDirectory = 0; err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); if ((err == noErr) && isDirectory) { if (objIndex == MAC_HIDDEN_ATTRIBUTE) { *attributePtrPtr = Tcl_NewBooleanObj(0); } else { *attributePtrPtr = Tcl_NewOSTypeObj('Fldr'); } } } if (err != noErr) { errno = TclMacOSErrorToPosixError(err); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't get attributes for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; }
Tcl_Obj* TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */ Tcl_Obj* path) /* Path name of the library * in the VFS */ { Tcl_Obj* retval; retval = TclpTempFileName(); if (retval == NULL) { Tcl_AppendResult(interp, "couldn't create temporary file: ", Tcl_PosixError(interp), NULL); } return retval; }
static void AttributesPosixError( Tcl_Interp *interp, /* The interp that has the error */ int objIndex, /* The attribute which caused the problem. */ char *fileName, /* The name of the file which caused the * error. */ int getOrSet) /* 0 for get; 1 for set */ { TclWinConvertError(GetLastError()); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot ", getOrSet ? "set" : "get", " attribute \"", tclpFileAttrStrings[objIndex], "\" for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); }
Tcl_Obj * TclpTempFileNameForLibrary( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *path) /* Path name of the library in the VFS. */ { Tcl_Obj *retval = TclpTempFileName(); if (retval == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't create temporary file: %s", Tcl_PosixError(interp))); } return retval; }
/*++ GetVolumeInfo Retrieves information about a volume. Arguments: interp - Interpreter to use for error reporting. pathObj - A pointer to an object that specifies the volume. volumeInfo - A pointer to a "VolumeInfo" structure. Return Value: A standard Tcl result. --*/ int GetVolumeInfo( Tcl_Interp *interp, Tcl_Obj *pathObj, VolumeInfo *volumeInfo ) { char *path; Tcl_DString buffer; struct STATFS_T fsInfo; assert(interp != NULL); assert(pathObj != NULL); assert(volumeInfo != NULL); if (TranslatePathFromObj(interp, pathObj, &buffer) != TCL_OK) { return TCL_ERROR; } path = Tcl_DStringValue(&buffer); if (STATFS_FN(path, &fsInfo) != 0) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unable to retrieve mount information for \"", Tcl_GetString(pathObj), "\": ", Tcl_PosixError(interp), NULL); Tcl_DStringFree(&buffer); return TCL_ERROR; } // Free and total space. volumeInfo->free = (Tcl_WideUInt)fsInfo.f_bsize * (Tcl_WideUInt)fsInfo.f_bfree; volumeInfo->total = (Tcl_WideUInt)fsInfo.f_bsize * (Tcl_WideUInt)fsInfo.f_blocks; volumeInfo->id = (unsigned long)F_FSID(fsInfo); volumeInfo->flags = (unsigned long)F_FLAGS(fsInfo); volumeInfo->length = (unsigned long)F_NAMELEN(fsInfo); // Not supported. volumeInfo->name[0] = '\0'; // File system type. strncpy(volumeInfo->type, F_TYPENAME(fsInfo), ARRAYSIZE(volumeInfo->type)); volumeInfo->type[ARRAYSIZE(volumeInfo->type)-1] = '\0'; Tcl_DStringFree(&buffer); return TCL_OK; }
/*++ GetVolumeList Retrieves a list of volumes and mount points. Arguments: interp - Interpreter to use for error reporting. options - OR-ed value of flags that determine the returned volumes. Return Value: A Tcl list object with applicable volumes and mount points. If the function fails, NULL is returned and an error message is left in the interpreter's result. --*/ Tcl_Obj * GetVolumeList( Tcl_Interp *interp, unsigned short options ) { Tcl_Obj *volumeList; assert(interp != NULL); volumeList = Tcl_NewObj(); // The only "root" path on a UNIX system is "/". if (options & VOLLIST_FLAG_ROOT) { Tcl_ListObjAppendElement(NULL, volumeList, Tcl_NewStringObj("/", 1)); } // Append all mount points. #ifdef HAVE_GETMNTINFO if (options & VOLLIST_FLAG_MOUNTS) { int count; int i; struct statfs *mounts; count = getmntinfo(&mounts, MNT_NOWAIT); if (count == 0) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unable to retrieve mount points: ", Tcl_PosixError(interp), NULL); Tcl_DecrRefCount(volumeList); return NULL; } for (i = 0; i < count; i++) { if ((options & VOLLIST_FLAG_LOCAL) && !(mounts[i].f_flags & MNT_LOCAL)) { continue; } Tcl_ListObjAppendElement(NULL, volumeList, Tcl_NewStringObj(mounts[i].f_mntonname, -1)); } } #endif // HAVE_GETMNTINFO return volumeList; }
static int GetFileReadOnly( Tcl_Interp *interp, /* The interp to report errors with. */ int objIndex, /* The index of the attribute. */ char *fileName, /* The name of the file. */ Tcl_Obj **readOnlyPtrPtr) /* A pointer to return the object with. */ { OSErr err; FSSpec fileSpec; CInfoPBRec paramBlock; err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec); if (err == noErr) { if (err == noErr) { paramBlock.hFileInfo.ioCompletion = NULL; paramBlock.hFileInfo.ioNamePtr = fileSpec.name; paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum; paramBlock.hFileInfo.ioFDirIndex = 0; paramBlock.hFileInfo.ioDirID = fileSpec.parID; err = PBGetCatInfo(¶mBlock, 0); if (err == noErr) { /* * For some unknown reason, the Mac does not give * symbols for the bits in the ioFlAttrib field. * 1 -> locked. */ *readOnlyPtrPtr = Tcl_NewBooleanObj( paramBlock.hFileInfo.ioFlAttrib & 1); } } } if (err != noErr) { errno = TclMacOSErrorToPosixError(err); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't get attributes for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; }
/* ARGSUSED */ int Tcl_FlushObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *chanObjPtr; Tcl_Channel chan; /* The channel to flush on. */ int mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } chanObjPtr = objv[1]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr), "\" wasn't opened for writing", NULL); return TCL_ERROR; } if (Tcl_Flush(chan) != TCL_OK) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_AppendResult(interp, "error flushing \"", TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp), NULL); } return TCL_ERROR; } return TCL_OK; }
/*----------------------------------------------------------------------------- * 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; }
/* *--------------------------------------------------------------------------- * * CreatePipe -- * * Creates a pipe by simply calling the pipe() function. * * Results: * Returns 1 on success, 0 on failure. * * Side effects: * Creates a pipe. * *--------------------------------------------------------------------------- */ static int CreatePipe( Tcl_Interp *interp, int *inPtr, /* (out) Descriptor for read side of * pipe. */ int *outPtr) /* (out) Descriptor for write side of * pipe. */ { int fd[2]; if (pipe(fd) < 0) { Tcl_AppendResult(interp, "can't create pipe for command: ", Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } fcntl(fd[0], F_SETFD, FD_CLOEXEC); fcntl(fd[1], F_SETFD, FD_CLOEXEC); *inPtr = fd[0]; *outPtr = fd[1]; return TCL_OK; }
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 int TestalarmCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ CONST char **argv) /* Argument strings. */ { #ifdef SA_RESTART unsigned int sec; struct sigaction action; if (argc > 1) { Tcl_GetInt(interp, argv[1], (int *)&sec); } else { sec = 1; } /* * Setup the signal handling that automatically retries any interrupted * I/O system calls. */ action.sa_handler = AlarmHandler; memset((void *) &action.sa_mask, 0, sizeof(sigset_t)); action.sa_flags = SA_RESTART; if (sigaction(SIGALRM, &action, NULL) < 0) { Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } (void) alarm(sec); return TCL_OK; #else Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL); return TCL_ERROR; #endif }
const char * TclpGetCwd( Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of current directory. */ { char buffer[MAXPATHLEN+1]; #ifdef USEGETWD if (getwd(buffer) == NULL) /* INTL: Native. */ #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */ #endif /* USEGETWD */ { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); } return NULL; } return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr); }
/* *---------------------------------------------------------------------- * * Tcl_CreatePipe -- * * System dependent interface to create a pipe for the [chan pipe] * command. Stolen from TclX. * * Parameters: * o interp - Errors returned in result. * o rchan, wchan - Returned read and write side. * o flags - Reserved for future use. * Results: * TCL_OK or TCL_ERROR. * *---------------------------------------------------------------------- */ int Tcl_CreatePipe( Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags) { int fileNums[2]; if (pipe(fileNums) < 0) { Tcl_AppendResult(interp, "pipe creation failed: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } *rchan = Tcl_MakeFileChannel((ClientData) INT2PTR(fileNums[0]), TCL_READABLE); Tcl_RegisterChannel(interp, *rchan); *wchan = Tcl_MakeFileChannel((ClientData) INT2PTR(fileNums[1]), TCL_WRITABLE); Tcl_RegisterChannel(interp, *wchan); return TCL_OK; }
static int SetFileFinderAttributes( Tcl_Interp *interp, /* The interp to report errors with. */ int objIndex, /* The index of the attribute. */ char *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The command line object. */ { OSErr err; FSSpec fileSpec; FInfo finfo; err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec); if (err == noErr) { err = FSpGetFInfo(&fileSpec, &finfo); } if (err == noErr) { switch (objIndex) { case MAC_CREATOR_ATTRIBUTE: if (Tcl_GetOSTypeFromObj(interp, attributePtr, &finfo.fdCreator) != TCL_OK) { return TCL_ERROR; } break; case MAC_HIDDEN_ATTRIBUTE: { int hidden; if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden) != TCL_OK) { return TCL_ERROR; } if (hidden) { finfo.fdFlags |= kIsInvisible; } else { finfo.fdFlags &= ~kIsInvisible; } break; } case MAC_TYPE_ATTRIBUTE: if (Tcl_GetOSTypeFromObj(interp, attributePtr, &finfo.fdType) != TCL_OK) { return TCL_ERROR; } break; } err = FSpSetFInfo(&fileSpec, &finfo); } else if (err == fnfErr) { long dirID; Boolean isDirectory = 0; err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); if ((err == noErr) && isDirectory) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); Tcl_AppendStringsToObj(resultPtr, "cannot set ", tclpFileAttrStrings[objIndex], ": \"", fileName, "\" is a directory", (char *) NULL); return TCL_ERROR; } } if (err != noErr) { errno = TclMacOSErrorToPosixError(err); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set attributes for file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; }
int TclpMatchInDirectory( Tcl_Interp *interp, /* Interpreter to receive errors. */ Tcl_Obj *resultPtr, /* List object to lappend results. */ Tcl_Obj *pathPtr, /* Contains path to directory to search. */ const char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { const char *native; Tcl_Obj *fileNamePtr; int matchResult = 0; if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { /* * The native filesystem never adds mounts. */ return TCL_OK; } fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } if (pattern == NULL || (*pattern == '\0')) { /* * Match a file directly. */ Tcl_Obj *tailPtr; const char *nativeTail; native = Tcl_FSGetNativePath(pathPtr); tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL); nativeTail = Tcl_FSGetNativePath(tailPtr); matchResult = NativeMatchType(interp, native, nativeTail, types); if (matchResult == 1) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } Tcl_DecrRefCount(tailPtr); Tcl_DecrRefCount(fileNamePtr); } else { DIR *d; Tcl_DirEntry *entryPtr; const char *dirName; int dirLength, nativeDirLen; int matchHidden, matchHiddenPat; Tcl_StatBuf statBuf; Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); dirName = TclGetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); /* * Make sure that the directory part of the name really is a * directory. If the directory name is "", use the name "." instead, * because some UNIX systems don't treat "" like "." automatically. * Keep the "" for use in generating file names, otherwise "glob * foo.c" would return "./foo.c". */ if (dirLength == 0) { dirName = "."; } else { dirName = Tcl_DStringValue(&dsOrig); /* * Make sure we have a trailing directory delimiter. */ if (dirName[dirLength-1] != '/') { dirName = TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } } /* * Now open the directory for reading and iterate over the contents. */ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */ || !S_ISDIR(statBuf.st_mode)) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } d = opendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read directory \"%s\": %s", Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); } Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); return TCL_ERROR; } nativeDirLen = Tcl_DStringLength(&ds); /* * Check to see if -type or the pattern requests hidden files. */ matchHiddenPat = (pattern[0] == '.') || ((pattern[0] == '\\') && (pattern[1] == '.')); matchHidden = matchHiddenPat || (types && (types->perm & TCL_GLOB_PERM_HIDDEN)); while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ Tcl_DString utfDs; const char *utfname; /* * Skip this file if it doesn't agree with the hidden parameters * requested by the user (via -type or pattern). */ if (*entryPtr->d_name == '.') { if (!matchHidden) { continue; } } else { #ifdef MAC_OSX_TCL if (matchHiddenPat) { continue; } /* Also need to check HFS hidden flag in TclMacOSXMatchType. */ #else if (matchHidden) { continue; } #endif } /* * Now check to see if the file matches, according to both type * and pattern. If so, add the file to the result. */ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs); if (Tcl_StringCaseMatch(utfname, pattern, 0)) { int typeOk = 1; if (types != NULL) { Tcl_DStringSetLength(&ds, nativeDirLen); native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1); matchResult = NativeMatchType(interp, native, entryPtr->d_name, types); typeOk = (matchResult == 1); } if (typeOk) { Tcl_ListObjAppendElement(interp, resultPtr, TclNewFSPathObj(pathPtr, utfname, Tcl_DStringLength(&utfDs))); } } Tcl_DStringFree(&utfDs); if (matchResult < 0) { break; } } closedir(d); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); } if (matchResult < 0) { return TCL_ERROR; } return TCL_OK; }