X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=cbits%2FdirUtils.c;h=fdcdf295d3d3fe921081ceb0b466bc0f9a699a39;hb=90f7b6cec2b034721ec0b7c015a23ec0aed63100;hp=a2240046384be132c56a21742b551dccd09b0e3b;hpb=260e7f2ed9a43c6ecf5a556d77817f39ed2893ab;p=ghc-base.git diff --git a/cbits/dirUtils.c b/cbits/dirUtils.c index a224004..fdcdf29 100644 --- a/cbits/dirUtils.c +++ b/cbits/dirUtils.c @@ -1,75 +1,174 @@ /* - * (c) The GRASP/AQUA Project, Glasgow University, 1994- + * (c) The University of Glasgow 2002 * * Directory Runtime Support */ -#include "dirUtils.h" -#if defined(mingw32_TARGET_OS) -#include -#endif +#include "ghcconfig.h" -#ifdef HAVE_STDLIB_H -# include -#endif -#ifdef HAVE_STDDEF_H -# include -#endif -#ifdef HAVE_ERRNO_H -# include +// The following is required on Solaris to force the POSIX versions of +// the various _r functions instead of the Solaris versions. +#ifdef solaris2_HOST_OS +#define _POSIX_PTHREAD_SEMANTICS #endif -HsInt -prel_mkdir(HsAddr pathName, HsInt mode) +#include "HsBase.h" + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) || defined(_MSC_VER) +#include + +static +int +toErrno(DWORD rc) { -#if defined(mingw32_TARGET_OS) - return mkdir(pathName); -#else - return mkdir(pathName,mode); -#endif + switch (rc) { + case ERROR_FILE_NOT_FOUND: return ENOENT; + case ERROR_PATH_NOT_FOUND: return ENOENT; + case ERROR_TOO_MANY_OPEN_FILES: return EMFILE; + case ERROR_ACCESS_DENIED: return EACCES; + case ERROR_INVALID_HANDLE: return EBADF; /* kinda sorta */ + case ERROR_NOT_ENOUGH_MEMORY: return ENOMEM; + case ERROR_INVALID_ACCESS: return EINVAL; + case ERROR_INVALID_DATA: return EINVAL; + case ERROR_OUTOFMEMORY: return ENOMEM; + case ERROR_SHARING_VIOLATION: return EACCES; + case ERROR_LOCK_VIOLATION: return EACCES; + case ERROR_ALREADY_EXISTS: return EEXIST; + case ERROR_BUSY: return EBUSY; + case ERROR_BROKEN_PIPE: return EPIPE; + case ERROR_PIPE_CONNECTED: return EBUSY; + case ERROR_PIPE_LISTENING: return EBUSY; + case ERROR_NOT_CONNECTED: return EINVAL; + + case ERROR_NOT_OWNER: return EPERM; + case ERROR_DIRECTORY: return ENOTDIR; + case ERROR_FILE_INVALID: return EACCES; + case ERROR_FILE_EXISTS: return EEXIST; + + default: + return rc; + } } +#endif + +/* + * read an entry from the directory stream; opt for the + * re-entrant friendly way of doing this, if available. + */ HsInt -prel_lstat(HsAddr fname, HsAddr st) +__hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt ) { -#ifdef HAVE_LSTAT - return lstat((const char*)fname, (struct stat*)st); + struct dirent **pDirE = (struct dirent**)pDirEnt; +#if HAVE_READDIR_R + struct dirent* p; + int res; + static unsigned int nm_max = (unsigned int)-1; + + if (pDirE == NULL) { + return -1; + } + if (nm_max == (unsigned int)-1) { +#ifdef NAME_MAX + nm_max = NAME_MAX + 1; #else - return stat((const char*)fname, (struct stat*)st); + nm_max = pathconf(".", _PC_NAME_MAX); + if (nm_max == -1) { nm_max = 255; } + nm_max++; #endif -} - -HsInt prel_s_ISDIR(mode_t m) {return S_ISDIR(m);} -HsInt prel_s_ISREG(mode_t m) {return S_ISREG(m);} - -HsInt prel_sz_stat() { return sizeof(struct stat); } -HsInt prel_path_max() { return PATH_MAX; } -mode_t prel_R_OK() { return R_OK; } -mode_t prel_W_OK() { return W_OK; } -mode_t prel_X_OK() { return X_OK; } - -mode_t prel_S_IRUSR() { return S_IRUSR; } -mode_t prel_S_IWUSR() { return S_IWUSR; } -mode_t prel_S_IXUSR() { return S_IXUSR; } + } + p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max); + if (p == NULL) return -1; + res = readdir_r((DIR*)dirPtr, p, pDirE); + if (res != 0) { + *pDirE = NULL; + free(p); + } + else if (*pDirE == NULL) { + // end of stream + free(p); + } + return res; +#else -time_t prel_st_mtime(struct stat* st) { return st->st_mtime; } -mode_t prel_st_mode(struct stat* st) { return st->st_mode; } + if (pDirE == NULL) { + return -1; + } -HsAddr prel_d_name(struct dirent* d) -{ -#ifndef mingw32_TARGET_OS - return (HsAddr)(&d->d_name); -#else - return (HsAddr)(d->d_name); + *pDirE = readdir((DIR*)dirPtr); + if (*pDirE == NULL) { + return -1; + } else { + return 0; + } #endif } -HsInt prel_end_of_dir() +/* + * Function: __hscore_renameFile() + * + * Provide Haskell98's semantics for renaming files and directories. + * It mirrors that of POSIX.1's behaviour for rename() by overwriting + * the target if it exists (the MS CRT implementation of rename() returns + * an error + * + */ +HsInt +__hscore_renameFile( HsAddr src, + HsAddr dest) { -#ifndef mingw32_TARGET_OS - return 0; +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) || defined(_MSC_VER) + static int forNT = -1; + + /* ToDo: propagate error codes back */ + if (MoveFileA(src, dest)) { + return 0; + } else { + ; + } + + /* Failed...it could be because the target already existed. */ + if ( !GetFileAttributes(dest) ) { + /* No, it's not there - just fail. */ + errno = toErrno(GetLastError()); + return (-1); + } + + if (forNT == -1) { + OSVERSIONINFO ovi; + ovi.dwOSVersionInfoSize = sizeof(ovi); + if ( !GetVersionEx(&ovi) ) { + errno = toErrno(GetLastError()); + return (-1); + } + forNT = ((ovi.dwPlatformId & VER_PLATFORM_WIN32_NT) != 0); + } + + if (forNT) { + /* Easy, go for MoveFileEx() */ + if ( MoveFileExA(src, dest, MOVEFILE_REPLACE_EXISTING) ) { + return 0; + } else { + errno = toErrno(GetLastError()); + return (-1); + } + } + + /* No MoveFileEx() for Win9x, try deleting the target. */ + /* Similarly, if the MoveFile*() ops didn't work out under NT */ + if (DeleteFileA(dest)) { + if (MoveFileA(src,dest)) { + return 0; + } else { + errno = toErrno(GetLastError()); + return (-1); + } + } else { + errno = toErrno(GetLastError()); + return (-1); + } #else - return ENOENT; -#endif + return rename(src,dest); +#endif }