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;
}
