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

1607 lines
40 KiB
C
Raw Normal View History

Update tcl/tk for tcl-dp
2024-05-27 16:40:40 +02:00
/*
* tclMacFile.c --
*
* This file implements the channel drivers for Macintosh
* files. It also comtains Macintosh version of other Tcl
* functions that deal with the file system.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclMacFile.c 1.49 96/10/10 10:11:36
*/
/*
* Note: This code eventually needs to support async I/O. In doing this
* we will need to keep track of all current async I/O. If exit to shell
* is called - we shouldn't exit until all asyc I/O completes.
*/
#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <Aliases.h>
#include <Errors.h>
#include <Processes.h>
#include <Strings.h>
#include <Types.h>
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
#include <FSpCompat.h>
/*
* The following are flags returned by GetOpenMode. They
* are or'd together to determine how opening and handling
* a file should occur.
*/
#define TCL_RDONLY (1<<0)
#define TCL_WRONLY (1<<1)
#define TCL_RDWR (1<<2)
#define TCL_CREAT (1<<3)
#define TCL_TRUNC (1<<4)
#define TCL_APPEND (1<<5)
#define TCL_ALWAYS_APPEND (1<<6)
#define TCL_EXCL (1<<7)
#define TCL_NOCTTY (1<<8)
#define TCL_NONBLOCK (1<<9)
#define TCL_RW_MODES (TCL_RDONLY|TCL_WRONLY|TCL_RDWR)
/*
* This structure describes per-instance state of a
* macintosh file based channel.
*/
typedef struct FileState {
short fileRef; /* Macintosh file reference number. */
Tcl_Channel fileChan; /* Pointer to the channel for this file. */
int appendMode; /* Flag to tell if in O_APPEND mode or not. */
int volumeRef; /* Flag to tell if in O_APPEND mode or not. */
} FileState;
/*
* The variable below caches the name of the current working directory
* in order to avoid repeated calls to getcwd. The string is malloc-ed.
* NULL means the cache needs to be refreshed.
*/
static char *currentDir = NULL;
/*
* Static routines for this file:
*/
static int FileBlockMode _ANSI_ARGS_((ClientData instanceData,
int mode));
static int FileClose _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static Tcl_File FileGet _ANSI_ARGS_((ClientData instanceData,
int direction));
static int FileInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite, int *errorCode));
static int FileReady _ANSI_ARGS_((ClientData instanceData,
int mask));
static int FileSeek _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
static void FileWatch _ANSI_ARGS_((ClientData instanceData,
int mask));
static int GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
char *string));
static Tcl_Channel OpenFileChannel _ANSI_ARGS_((char *fileName, int mode,
int permissions, int *errorCodePtr));
/*
* This variable describes the channel type structure for file based IO.
*/
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
FileBlockMode, /* Set blocking or
* non-blocking mode.*/
FileClose, /* Close proc. */
FileInput, /* Input proc. */
FileOutput, /* Output proc. */
FileSeek, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
FileWatch, /* Initialize notifier. */
FileReady, /* Are there events? */
FileGet /* Get Tcl_Files out of channel. */
};
/*
*----------------------------------------------------------------------
*
* TclChdir --
*
* Change the current working directory.
*
* Results:
* The result is a standard Tcl result. If an error occurs and
* interp isn't NULL, an error message is left in interp->result.
*
* Side effects:
* The working directory for this application is changed. Also
* the cache maintained used by TclGetCwd is deallocated and
* set to NULL.
*
*----------------------------------------------------------------------
*/
int
TclChdir(interp, dirName)
Tcl_Interp *interp; /* If non NULL, used for error reporting. */
char *dirName; /* Path to new working directory. */
{
FSSpec spec;
OSErr err;
Boolean isFolder;
long dirID;
if (currentDir != NULL) {
ckfree(currentDir);
currentDir = NULL;
}
err = FSpLocationFromPath(strlen(dirName), dirName, &spec);
if (err != noErr) {
errno = ENOENT;
goto chdirError;
}
err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
if (err != noErr) {
errno = ENOENT;
goto chdirError;
}
if (isFolder != true) {
errno = ENOTDIR;
goto chdirError;
}
err = FSpSetDefaultDir(&spec);
if (err != noErr) {
switch (err) {
case afpAccessDenied:
errno = EACCES;
break;
default:
errno = ENOENT;
}
goto chdirError;
}
return TCL_OK;
chdirError:
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't change working directory to \"",
dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* TclGetCwd --
*
* Return the path name of the current working directory.
*
* Results:
* The result is the full path name of the current working
* directory, or NULL if an error occurred while figuring it
* out. If an error occurs and interp isn't NULL, an error
* message is left in interp->result.
*
* Side effects:
* The path name is cached to avoid having to recompute it
* on future calls; if it is already cached, the cached
* value is returned.
*
*----------------------------------------------------------------------
*/
char *
TclGetCwd(interp)
Tcl_Interp *interp; /* If non NULL, used for error reporting. */
{
FSSpec theSpec;
int length;
Handle pathHandle = NULL;
if (currentDir == NULL) {
if (FSpGetDefaultDir(&theSpec) != noErr) {
if (interp != NULL) {
interp->result = "error getting working directory name";
}
return NULL;
}
if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
if (interp != NULL) {
interp->result = "error getting working directory name";
}
return NULL;
}
HLock(pathHandle);
currentDir = (char *) ckalloc((unsigned) (length + 1));
strcpy(currentDir, *pathHandle);
HUnlock(pathHandle);
DisposeHandle(pathHandle);
}
return currentDir;
}
/*
*----------------------------------------------------------------------
*
* Tcl_WaitPid --
*
* Fakes a call to wait pid.
*
* Results:
* Always returns -1.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_WaitPid(pid, statPtr, options)
int pid;
int *statPtr;
int options;
{
return -1;
}
/*
*----------------------------------------------------------------------
*
* TclCreateTempFile --
*
* This function creates a temporary file initialized with an
* optional string, and returns a file handle with the file pointer
* at the beginning of the file.
*
* Results:
* A handle to a file.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_File
TclCreateTempFile(contents, namePtr)
char *contents; /* String to write into temp file, or NULL. */
Tcl_DString *namePtr; /* If non-NULL, pointer to initialized
* DString that is filled with the name of
* the temp file that was created. */
{
char fileName[L_tmpnam];
Tcl_File file;
int length = (contents == NULL) ? 0 : strlen(contents);
tmpnam(fileName);
file = TclOpenFile(fileName, O_RDWR|O_CREAT|O_TRUNC);
unlink(fileName);
if ((file != NULL) && (length > 0)) {
int fd = (int)Tcl_GetFileInfo(file, NULL);
while (1) {
if (write(fd, contents, length) != -1) {
break;
} else if (errno != EINTR) {
close(fd);
Tcl_FreeFile(file);
return NULL;
}
}
lseek(fd, 0, SEEK_SET);
}
if (namePtr != NULL) {
Tcl_DStringAppend(namePtr, fileName, -1);
}
return file;
}
/*
*----------------------------------------------------------------------
*
* Tcl_FindExecutable --
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value. However, this
* implementation doesn't use of need the argv[0] value. NULL
* may be passed in its place.
*
* Results:
* None.
*
* Side effects:
* The variable tclExecutableName gets filled in with the file
* name for the application, if we figured it out. If we couldn't
* figure it out, Tcl_FindExecutable is set to NULL.
*
*----------------------------------------------------------------------
*/
void
Tcl_FindExecutable(argv0)
char *argv0; /* The value of the application's argv[0]. */
{
ProcessSerialNumber psn;
ProcessInfoRec info;
Str63 appName;
FSSpec fileSpec;
int pathLength;
Handle pathName = NULL;
OSErr err;
GetCurrentProcess(&psn);
info.processInfoLength = sizeof(ProcessInfoRec);
info.processName = appName;
info.processAppSpec = &fileSpec;
GetProcessInformation(&psn, &info);
if (tclExecutableName != NULL) {
ckfree(tclExecutableName);
tclExecutableName = NULL;
}
err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
tclExecutableName = (char *) ckalloc((unsigned) pathLength + 1);
HLock(pathName);
strcpy(tclExecutableName, *pathName);
HUnlock(pathName);
DisposeHandle(pathName);
}
/*
*----------------------------------------------------------------------
*
* TclGetUserHome --
*
* This function takes the passed in user name and finds the
* corresponding home directory specified in the password file.
*
* Results:
* On a Macintosh we always return a NULL.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
char *
TclGetUserHome(name, bufferPtr)
char *name; /* User name to use to find home directory. */
Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
* anything at the time of the call, and need
* not even be initialized. */
{
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TclMatchFiles --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
* added to the interp->result. Otherwise, TclDoGlob is called
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------- */
int
TclMatchFiles(interp, separators, dirPtr, pattern, tail)
Tcl_Interp *interp; /* Interpreter to receive results. */
char *separators; /* Directory separators to pass to TclDoGlob. */
Tcl_DString *dirPtr; /* Contains path to directory to search. */
char *pattern; /* Pattern to match against. */
char *tail; /* Pointer to end of pattern. Tail must
* point to a location in pattern. */
{
char *dirName, *patternEnd = tail;
char savedChar;
int result = TCL_OK;
int baseLength = Tcl_DStringLength(dirPtr);
CInfoPBRec pb;
OSErr err;
FSSpec dirSpec;
Boolean isDirectory;
long dirID;
short itemIndex;
Str255 fileName;
/*
* Make sure that the directory part of the name really is a
* directory.
*/
dirName = dirPtr->string;
FSpLocationFromPath(strlen(dirName), dirName, &dirSpec);
err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
if ((err != noErr) || !isDirectory) {
return TCL_OK;
}
/*
* Now open the directory for reading and iterate over the contents.
*/
pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
pb.hFileInfo.ioDirID = dirID;
pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
pb.hFileInfo.ioFDirIndex = itemIndex = 1;
/*
* Clean up the end of the pattern and the tail pointer. Leave
* the tail pointing to the first character after the path separator
* following the pattern, or NULL. Also, ensure that the pattern
* is null-terminated.
*/
if (*tail == '\\') {
tail++;
}
if (*tail == '\0') {
tail = NULL;
} else {
tail++;
}
savedChar = *patternEnd;
*patternEnd = '\0';
while (1) {
pb.hFileInfo.ioFDirIndex = itemIndex;
pb.hFileInfo.ioDirID = dirID;
err = PBGetCatInfoSync(&pb);
if (err != noErr) {
break;
}
/*
* Now check to see if the file matches. If there are more
* characters to be processed, then ensure matching files are
* directories before calling TclDoGlob. Otherwise, just add
* the file to the result.
*/
p2cstr(fileName);
if (Tcl_StringMatch((char *) fileName, pattern)) {
Tcl_DStringSetLength(dirPtr, baseLength);
Tcl_DStringAppend(dirPtr, (char *) fileName, -1);
if (tail == NULL) {
if ((dirPtr->length > 1) &&
(strchr(dirPtr->string+1, ':') == NULL)) {
Tcl_AppendElement(interp, dirPtr->string+1);
} else {
Tcl_AppendElement(interp, dirPtr->string);
}
} else if ((pb.hFileInfo.ioFlAttrib & ioDirMask) != 0) {
Tcl_DStringAppend(dirPtr, ":", 1);
result = TclDoGlob(interp, separators, dirPtr, tail);
if (result != TCL_OK) {
break;
}
}
}
itemIndex++;
}
*patternEnd = savedChar;
return result;
}
/*
*----------------------------------------------------------------------
*
* TclMacStat --
*
* This function replaces the library version of stat. The stat
* function provided by most Mac compiliers is rather broken and
* incomplete.
*
* Results:
* See stat documentation.
*
* Side effects:
* See stat documentation.
*
*----------------------------------------------------------------------
*/
int
TclMacStat(path, buf)
char *path;
struct stat *buf;
{
HFileInfo fpb;
HVolumeParam vpb;
OSErr err;
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
}
/*
* Fill the fpb & vpb struct up with info about file or directory.
*/
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
if (isDirectory) {
fpb.ioDirID = fileSpec.parID;
} else {
fpb.ioDirID = dirID;
}
fpb.ioFDirIndex = 0;
err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
if (err == noErr) {
vpb.ioVolIndex = 0;
err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
if (err == noErr && buf != NULL) {
/*
* Files are always readable by everyone.
*/
buf->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
/*
* Use the Volume Info & File Info to fill out stat buf.
*/
if (fpb.ioFlAttrib & 0x10) {
buf->st_mode |= S_IFDIR;
buf->st_nlink = 2;
} else {
buf->st_nlink = 1;
if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
buf->st_mode |= S_IFLNK;
} else {
buf->st_mode |= S_IFREG;
}
}
if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
/*
* Directories and applications are executable by everyone.
*/
buf->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
}
if ((fpb.ioFlAttrib & 0x01) == 0){
/*
* If not locked, then everyone has write acces.
*/
buf->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
}
buf->st_ino = fpb.ioDirID;
buf->st_dev = fpb.ioVRefNum;
buf->st_uid = -1;
buf->st_gid = -1;
buf->st_rdev = 0;
buf->st_size = fpb.ioFlLgLen;
buf->st_atime = buf->st_mtime = fpb.ioFlMdDat;
buf->st_ctime = fpb.ioFlCrDat;
buf->st_blksize = vpb.ioVAlBlkSiz;
buf->st_blocks = (buf->st_size + buf->st_blksize - 1) / buf->st_blksize;
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
}
return (err == noErr ? 0 : -1);
}
/*
*----------------------------------------------------------------------
*
* TclMacReadlink --
*
* This function replaces the library version of readlink.
*
* Results:
* See readlink documentation.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclMacReadlink(path, buf, size)
char *path;
char *buf;
int size;
{
HFileInfo fpb;
OSErr err;
FSSpec fileSpec;
Boolean isDirectory;
Boolean wasAlias;
long dirID;
char fileName[256];
char *end;
Handle theString = NULL;
int pathSize;
/*
* Remove ending colons if they exist.
*/
while ((strlen(path) != 0) && (path[strlen(path) - 1] == ':')) {
path[strlen(path) - 1] = NULL;
}
if (strchr(path, ':') == NULL) {
strcpy(fileName, path);
path = NULL;
} else {
end = strrchr(path, ':') + 1;
strcpy(fileName, end);
*end = NULL;
}
c2pstr(fileName);
/*
* Create the file spec for the directory of the file
* we want to look at.
*/
if (path != NULL) {
err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if (err != noErr) {
errno = EINVAL;
return -1;
}
} else {
FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
}
/*
* Fill the fpb struct up with info about file or directory.
*/
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
fpb.ioVRefNum = fileSpec.vRefNum;
fpb.ioDirID = dirID;
fpb.ioNamePtr = (StringPtr) fileName;
fpb.ioFDirIndex = 0;
err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
} else {
if (fpb.ioFlAttrib & 0x10) {
errno = EINVAL;
return -1;
} else {
if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
/*
* The file is a link!
*/
} else {
errno = EINVAL;
return -1;
}
}
}
/*
* If we are here it's really a link - now find out
* where it points to.
*/
err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, &fileSpec);
if (err == noErr) {
err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
}
if ((err == fnfErr) || wasAlias) {
err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
if ((err != noErr) || (pathSize > size)) {
DisposeHandle(theString);
errno = ENAMETOOLONG;
return -1;
}
} else {
errno = EINVAL;
return -1;
}
strncpy(buf, *theString, pathSize);
DisposeHandle(theString);
return pathSize;
}
/*
*----------------------------------------------------------------------
*
* TclMacAccess --
*
* This function replaces the library version of access. The
* access function provided by most Mac compiliers is rather
* broken or incomplete.
*
* Results:
* See access documentation.
*
* Side effects:
* See access documentation.
*
*----------------------------------------------------------------------
*/
int
TclMacAccess(path, mode)
const char *path;
int mode;
{
HFileInfo fpb;
HVolumeParam vpb;
OSErr err;
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
int full_mode = 0;
err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
}
/*
* Fill the fpb & vpb struct up with info about file or directory.
*/
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
if (isDirectory) {
fpb.ioDirID = fileSpec.parID;
} else {
fpb.ioDirID = dirID;
}
fpb.ioFDirIndex = 0;
err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
if (err == noErr) {
vpb.ioVolIndex = 0;
err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
if (err == noErr) {
/*
* Use the Volume Info & File Info to determine
* access information. If we have got this far
* we know the directory is searchable or the file
* exists. (We have F_OK)
*/
/*
* Check to see if the volume is hardware or
* software locked. If so we arn't W_OK.
*/
if (mode & W_OK) {
if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
errno = EROFS;
return -1;
}
if (fpb.ioFlAttrib & 0x01) {
errno = EACCES;
return -1;
}
}
/*
* Directories are always searchable and executable. But only
* files of type 'APPL' are executable.
*/
if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
&& (fpb.ioFlFndrInfo.fdType != 'APPL')) {
return -1;
}
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclMacFOpenHack --
*
* This function replaces fopen. It supports paths with alises.
* Note, remember to undefine the fopen macro!
*
* Results:
* See fopen documentation.
*
* Side effects:
* See fopen documentation.
*
*----------------------------------------------------------------------
*/
#undef fopen
FILE *
TclMacFOpenHack(path, mode)
const char *path;
const char *mode;
{
OSErr err;
FSSpec fileSpec;
Handle pathString = NULL;
int size;
FILE * f;
err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
if ((err != noErr) && (err != fnfErr)) {
return NULL;
}
err = FSpPathFromLocation(&fileSpec, &size, &pathString);
if ((err != noErr) && (err != fnfErr)) {
return NULL;
}
HLock(pathString);
f = fopen(*pathString, mode);
HUnlock(pathString);
DisposeHandle(pathString);
return f;
}
/*
*----------------------------------------------------------------------
*
* Tcl_OpenFileChannel --
*
* Open an File based channel on Unix systems.
*
* Results:
* The new channel or NULL. If NULL, the output argument
* errorCodePtr is set to a POSIX error.
*
* Side effects:
* May open the channel and may cause creation of a file on the
* file system.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
char *fileName; /* Name of file to open. */
char *modeString; /* A list of POSIX open modes or
* a string such as "rw". */
int permissions; /* If the open involves creating a
* file, with what modes to create
* it? */
{
Tcl_Channel chan;
int mode;
char *nativeName;
Tcl_DString buffer;
int errorCode;
mode = GetOpenMode(interp, modeString);
if (mode == -1) {
return NULL;
}
nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
if (nativeName == NULL) {
return NULL;
}
chan = OpenFileChannel(nativeName, mode, permissions, &errorCode);
Tcl_DStringFree(&buffer);
if (chan == NULL) {
Tcl_SetErrno(errorCode);
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* OpenFileChannel--
*
* Opens a Macintosh file and creates a Tcl channel to control it.
*
* Results:
* A Tcl channel.
*
* Side effects:
* Will open a Macintosh file.
*
*----------------------------------------------------------------------
*/
static Tcl_Channel
OpenFileChannel(fileName, mode, permissions, errorCodePtr)
char *fileName; /* Name of file to open. */
int mode; /* Mode for opening file. */
int permissions; /* If the open involves creating a
* file, with what modes to create
* it? */
int *errorCodePtr; /* Where to store error code. */
{
int channelPermissions;
Tcl_Channel chan;
char macPermision;
FSSpec fileSpec;
OSErr err;
short fileRef;
FileState *fileState;
char channelName[64];
/*
* Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
* writes on a file. This isn't common on a mac but is common with
* Windows and UNIX and the feature is used by Tcl.
*/
switch (mode & (TCL_RDONLY | TCL_WRONLY | TCL_RDWR)) {
case TCL_RDWR:
channelPermissions = (TCL_READABLE | TCL_WRITABLE);
macPermision = fsRdWrShPerm;
break;
case TCL_WRONLY:
/*
* Mac's fsRdPerm permission actually defaults to fsRdWrPerm because
* the Mac OS doesn't realy support write only access. We explicitly
* set the permission fsRdWrShPerm so that we can have shared write
* access.
*/
channelPermissions = TCL_WRITABLE;
macPermision = fsRdWrShPerm;
break;
case TCL_RDONLY:
default:
channelPermissions = TCL_READABLE;
macPermision = fsRdPerm;
break;
}
err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
if ((err != noErr) && (err != fnfErr)) {
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
Tcl_SetErrno(errno);
return NULL;
}
if ((err == fnfErr) && (mode & TCL_CREAT)) {
err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, 'MPW ', 'TEXT');
if (err != noErr) {
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
Tcl_SetErrno(errno);
return NULL;
}
} else if ((mode & TCL_CREAT) && (mode & TCL_EXCL)) {
*errorCodePtr = errno = EEXIST;
Tcl_SetErrno(errno);
return NULL;
}
err = HOpenDF(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, macPermision, &fileRef);
if (err != noErr) {
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
Tcl_SetErrno(errno);
return NULL;
}
if (mode & TCL_TRUNC) {
SetEOF(fileRef, 0);
}
sprintf(channelName, "file%d", (int) fileRef);
fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
chan = Tcl_CreateChannel(&fileChannelType, channelName,
(ClientData) fileState, channelPermissions);
if (chan == (Tcl_Channel) NULL) {
*errorCodePtr = errno = EFAULT;
Tcl_SetErrno(errno);
FSClose(fileRef);
ckfree((char *) fileState);
return NULL;
}
fileState->fileChan = chan;
fileState->volumeRef = fileSpec.vRefNum;
fileState->fileRef = fileRef;
if (mode & TCL_ALWAYS_APPEND) {
fileState->appendMode = true;
} else {
fileState->appendMode = false;
}
if ((mode & TCL_ALWAYS_APPEND) || (mode & TCL_APPEND)) {
if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
*errorCodePtr = errno = EFAULT;
Tcl_SetErrno(errno);
Tcl_Close(NULL, chan);
FSClose(fileRef);
ckfree((char *) fileState);
return NULL;
}
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* FileBlockMode --
*
* Set blocking or non-blocking mode on channel. Macintosh files
* can never really be set to blocking or non-blocking modes.
* However, we don't generate an error - we just return success.
*
* Results:
* 0 if successful, errno when failed.
*
* Side effects:
* Sets the device into blocking or non-blocking mode.
*
*----------------------------------------------------------------------
*/
static int
FileBlockMode(instanceData, mode)
ClientData instanceData; /* Unused. */
int mode; /* The mode to set. */
{
return 0;
}
/*
*----------------------------------------------------------------------
*
* FileClose --
*
* Closes the IO channel.
*
* Results:
* 0 if successful, the value of errno if failed.
*
* Side effects:
* Closes the physical channel
*
*----------------------------------------------------------------------
*/
static int
FileClose(instanceData, interp)
ClientData instanceData; /* Unused. */
Tcl_Interp *interp; /* Unused. */
{
FileState *fileState = (FileState *) instanceData;
int errorCode = 0;
OSErr err;
err = FSClose(fileState->fileRef);
FlushVol(NULL, fileState->volumeRef);
if (err != noErr) {
errorCode = errno = TclMacOSErrorToPosixError(err);
panic("error during file close");
}
ckfree((char *) fileState);
Tcl_SetErrno(errorCode);
return errorCode;
}
/*
*----------------------------------------------------------------------
*
* FileGet --
*
* Called from Tcl_GetChannelFile to retrieve Tcl_Files from inside
* a file based channel.
*
* Results:
* The appropriate Tcl_File or NULL if not present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static Tcl_File
FileGet(instanceData, direction)
ClientData instanceData; /* The file state. */
int direction; /* Which Tcl_File to retrieve? */
{
FileState *fileState = (FileState *) instanceData;
if ((direction == TCL_READABLE) || (direction == TCL_WRITABLE)) {
return (Tcl_File) fileState->fileRef;
}
return (Tcl_File) NULL;
}
/*
*----------------------------------------------------------------------
*
* FileInput --
*
* Reads input from the IO channel into the buffer given. Returns
* count of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
* indication is returned in an output argument.
*
* Side effects:
* Reads input from the actual channel.
*
*----------------------------------------------------------------------
*/
int
FileInput(instanceData, buffer, bufSize, errorCodePtr)
ClientData instanceData; /* Unused. */
char *buffer; /* Where to store data read. */
int bufSize; /* How much space is available
* in the buffer? */
int *errorCodePtr; /* Where to store error code. */
{
FileState *fileState = (FileState *) instanceData;
OSErr err;
long length = bufSize;
*errorCodePtr = 0;
errno = 0;
err = FSRead(fileState->fileRef, &length, buffer);
if ((err == noErr) || (err == eofErr)) {
return length;
} else {
switch (err) {
case ioErr:
*errorCodePtr = errno = EIO;
case afpAccessDenied:
*errorCodePtr = errno = EACCES;
default:
*errorCodePtr = errno = EINVAL;
}
return -1;
}
*errorCodePtr = errno;
return -1;
}
/*
*----------------------------------------------------------------------
*
* FileOutput--
*
* Writes the given output on the IO channel. Returns count of how
* many characters were actually written, and an error indication.
*
* Results:
* A count of how many characters were written is returned and an
* error indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
*
*----------------------------------------------------------------------
*/
static int
FileOutput(instanceData, buffer, toWrite, errorCodePtr)
ClientData instanceData; /* Unused. */
char *buffer; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCodePtr; /* Where to store error code. */
{
FileState *fileState = (FileState *) instanceData;
long length = toWrite;
OSErr err;
*errorCodePtr = 0;
errno = 0;
if (fileState->appendMode == true) {
FileSeek(instanceData, 0, SEEK_END, errorCodePtr);
*errorCodePtr = 0;
}
err = FSWrite(fileState->fileRef, &length, buffer);
if (err == noErr) {
err = FlushFile(fileState->fileRef);
} else {
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
return -1;
}
return length;
}
/*
*----------------------------------------------------------------------
*
* FileReady --
*
* Called by the notifier to check whether events of interest are
* present on the channel. On the Macintosh all files are always
* considered to be readable and writeable.
*
* Results:
* Returns OR-ed combination of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION to indicate which events of interest are present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
FileReady(instanceData, mask)
ClientData instanceData; /* The file state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
return (TCL_READABLE | TCL_WRITABLE);
}
/*
*----------------------------------------------------------------------
*
* FileSeek --
*
* Seeks on an IO channel. Returns the new position.
*
* Results:
* -1 if failed, the new position if successful. If failed, it
* also sets *errorCodePtr to the error code.
*
* Side effects:
* Moves the location at which the channel will be accessed in
* future operations.
*
*----------------------------------------------------------------------
*/
static int
FileSeek(instanceData, offset, mode, errorCodePtr)
ClientData instanceData; /* Unused. */
long offset; /* Offset to seek to. */
int mode; /* Relative to where
* should we seek? */
int *errorCodePtr; /* To store error code. */
{
FileState *fileState = (FileState *) instanceData;
IOParam pb;
OSErr err;
*errorCodePtr = 0;
pb.ioCompletion = NULL;
pb.ioRefNum = fileState->fileRef;
if (mode == SEEK_SET) {
pb.ioPosMode = fsFromStart;
} else if (mode == SEEK_END) {
pb.ioPosMode = fsFromLEOF;
} else if (mode == SEEK_CUR) {
err = PBGetFPosSync((ParmBlkPtr) &pb);
if (pb.ioResult == noErr) {
if (offset == 0) {
return pb.ioPosOffset;
}
offset += pb.ioPosOffset;
}
pb.ioPosMode = fsFromStart;
}
pb.ioPosOffset = offset;
err = PBSetFPosSync((ParmBlkPtr) &pb);
if (pb.ioResult == noErr){
return pb.ioPosOffset;
} else if (pb.ioResult == eofErr) {
long currentEOF, newEOF;
long buffer, i, length;
err = PBGetEOFSync((ParmBlkPtr) &pb);
currentEOF = (long) pb.ioMisc;
if (mode == SEEK_SET) {
newEOF = offset;
} else if (mode == SEEK_END) {
newEOF = offset + currentEOF;
} else if (mode == SEEK_CUR) {
err = PBGetFPosSync((ParmBlkPtr) &pb);
newEOF = offset + pb.ioPosOffset;
}
/*
* Write 0's to the new EOF.
*/
pb.ioPosOffset = 0;
pb.ioPosMode = fsFromLEOF;
err = PBGetFPosSync((ParmBlkPtr) &pb);
length = 1;
buffer = 0;
for (i = 0; i < (newEOF - currentEOF); i++) {
err = FSWrite(fileState->fileRef, &length, &buffer);
}
err = PBGetFPosSync((ParmBlkPtr) &pb);
if (pb.ioResult == noErr){
return pb.ioPosOffset;
}
}
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
return -1;
}
/*
*----------------------------------------------------------------------
*
* FileWatch --
*
* Initialize the notifier to watch Tcl_Files from this channel.
* This doesn't do anything on the Macintosh.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
FileWatch(instanceData, mask)
ClientData instanceData; /* The file state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
Tcl_Time timeout = { 0, 0 };
/*
* Currently, files are always ready under the Macintosh,
* so we just set a 0 timeout. Since there s no notification
* scheme - we just set the timeout time to zero.
*/
Tcl_SetMaxBlockTime(&timeout);
}
/*
*----------------------------------------------------------------------
*
* TclMacOSErrorToPosixError --
*
* Given a Macintosh OSErr return the appropiate POSIX error.
*
* Results:
* A Posix error.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclMacOSErrorToPosixError(error)
int error; /* A Macintosh error. */
{
switch (error) {
case noErr:
return 0;
case bdNamErr:
return ENAMETOOLONG;
case afpObjectTypeErr:
return ENOTDIR;
case fnfErr:
case dirNFErr:
return ENOENT;
case dupFNErr:
return EEXIST;
case dirFulErr:
case dskFulErr:
return ENOSPC;
case fBsyErr:
return EBUSY;
case tmfoErr:
return ENFILE;
case fLckdErr:
case permErr:
case afpAccessDenied:
return EACCES;
case wPrErr:
case vLckdErr:
return EROFS;
case badMovErr:
return EINVAL;
case diffVolErr:
return EXDEV;
default:
return EINVAL;
}
}
/*
*----------------------------------------------------------------------
*
* GetOpenMode --
*
* Description:
* Computes a POSIX mode mask from a given string and also sets
* a flag to indicate whether the caller should seek to EOF during
* opening of the file.
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
* returns -1 and if interp is not NULL, sets interp->result to an
* error message.
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 if the caller
* should seek to EOF during opening the file.
*
* Special note:
* This code is based on a prototype implementation contributed
* by Mark Diekhans.
*
*----------------------------------------------------------------------
*/
static int
GetOpenMode(interp, string)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
char *string; /* Mode string, e.g. "r+" or
* "RDONLY CREAT". */
{
int mode, modeArgc, c, i, gotRW;
char **modeArgv, *flag;
/*
* Check for the simpler fopen-like access modes (e.g. "r"). They
* are distinguished from the POSIX access modes by the presence
* of a lower-case first letter.
*/
mode = 0;
if (islower(UCHAR(string[0]))) {
switch (string[0]) {
case 'r':
mode = TCL_RDONLY;
break;
case 'w':
mode = TCL_WRONLY|TCL_CREAT|TCL_TRUNC;
break;
case 'a':
mode = TCL_WRONLY|TCL_CREAT|TCL_APPEND;
break;
default:
error:
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp,
"illegal access mode \"", string, "\"",
(char *) NULL);
}
return -1;
}
if (string[1] == '+') {
mode &= ~(TCL_RDONLY|TCL_WRONLY);
mode |= TCL_RDWR;
if (string[2] != 0) {
goto error;
}
} else if (string[1] != 0) {
goto error;
}
return mode;
}
/*
* The access modes are specified using a list of POSIX modes
* such as TCL_CREAT.
*/
if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AddErrorInfo(interp,
"\n while processing open access modes \"");
Tcl_AddErrorInfo(interp, string);
Tcl_AddErrorInfo(interp, "\"");
}
return -1;
}
gotRW = 0;
for (i = 0; i < modeArgc; i++) {
flag = modeArgv[i];
c = flag[0];
if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
mode = (mode & ~TCL_RW_MODES) | TCL_RDONLY;
gotRW = 1;
} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
mode = (mode & ~TCL_RW_MODES) | TCL_WRONLY;
gotRW = 1;
} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
mode = (mode & ~TCL_RW_MODES) | TCL_RDWR;
gotRW = 1;
} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
mode |= TCL_ALWAYS_APPEND;
} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
mode |= TCL_CREAT;
} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
mode |= TCL_EXCL;
} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
mode |= TCL_NOCTTY;
} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
mode |= TCL_NONBLOCK;
} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
mode |= TCL_TRUNC;
} else {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "invalid access mode \"", flag,
"\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
" EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
}
ckfree((char *) modeArgv);
return -1;
}
}
ckfree((char *) modeArgv);
if (!gotRW) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "access mode must include either",
" RDONLY, WRONLY, or RDWR", (char *) NULL);
}
return -1;
}
return mode;
}
Reference in New Issue Copy Permalink