/* * Primitives needed to implement the Haskell 98 Directory module. * * This file has to be included by builtin.c, and won't compile on its own. */  /* -------------------------------------------------------------------------- * Directory control: * ------------------------------------------------------------------------*/ static Void dirControl Args((Int)); static Void dirControl(what)Int what; {} /* -------------------------------------------------------------------------- * Directory primitive table: * ------------------------------------------------------------------------*/ PROTO_PRIM(primCreateDirectory);PROTO_PRIM(primRemoveDirectory);PROTO_PRIM(primRemoveFile);PROTO_PRIM(primRenameDirectory);PROTO_PRIM(primRenameFile);PROTO_PRIM(primGetDirectory);PROTO_PRIM(primSetDirectory);PROTO_PRIM(primFileExist);PROTO_PRIM(primDirExist);PROTO_PRIM(primGetPermissions);PROTO_PRIM(primSetPermissions);PROTO_PRIM(primGetDirContents);PROTO_PRIM(primGetModTime); static struct primitive dirPrimTable[] = {  {"createDirectory",      1+IOArity, primCreateDirectory},  {"removeDirectory",      1+IOArity, primRemoveDirectory},  {"removeFile",           1+IOArity, primRemoveFile},  {"renameDirectory",      2+IOArity, primRenameDirectory},  {"renameFile",           2+IOArity, primRenameFile},  {"getCurrentDirectory",  0+IOArity, primGetDirectory},  {"setCurrentDirectory",  1+IOArity, primSetDirectory},  {"doesFileExist",        1+IOArity, primFileExist},  {"doesDirectoryExist",   1+IOArity, primDirExist},  {"getPerms",             1+IOArity, primGetPermissions},  {"setPerms",             5+IOArity, primSetPermissions},  {"getDirContents",       1+IOArity, primGetDirContents},  {"getModTime",           1+IOArity, primGetModTime},   {0,			0, 0}}; static struct primInfo dirPrims = { dirControl, dirPrimTable, 0 }; static	Bool	local	isDirectory	Args((String)); #define ToBool(v) ( (v) ? nameTrue : nameFalse) #ifdef _MSC_VER/* If not provided, define em. */#ifndef R_OK#define R_OK 04#endif#ifndef W_OK#define W_OK 02#endif#ifndef X_OK#define X_OK 06#endif#endif /* MSVC6 doesn't define these helper macros in <sys/stat.h> there * might be other platforms too, so... The assumption here is that * S_ISDIR() and friends indeed are CPP macros - if that's not the * case, please adjust the conditional below to suit your platform * (and feed back the tweak you make.) */#if !defined(S_ISDIR)#define S_ISDIR(st_mode)  ((st_mode & S_IFMT) == S_IFDIR)#endif #if !defined(S_ISREG)#define S_ISREG(st_mode)  ((st_mode & S_IFMT) == S_IFREG)#endif /* -------------------------------------------------------------------------- * Directory primitives: * ------------------------------------------------------------------------*/ primFun(primCreateDirectory) { /* create a directory, :: String -> IO ()   */  int rc;  String s = evalName(IOArg(1));    if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.createDirectory",		     "illegal directory name",		     &IOArg(1)));  }  #if defined(_MSC_VER) || mingw32_HOST_OS   rc = mkdir(s);#else   rc = mkdir(s,0777);#endif   if (rc != 0)      throwErrno("Directory.createDirectory", FALSE, NO_HANDLE, &IOArg(1));  IOReturn(nameUnit);} primFun(primRemoveDirectory) { /* remove a directory	   */  int rc;  String s = evalName(IOArg(1));    if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.removeDirectory",		     "illegal directory name",		     &IOArg(1)));  }     rc = rmdir(s);    if (rc != 0)      throwErrno("Directory.removeDirectory", FALSE, NO_HANDLE, &IOArg(1));  IOReturn(nameUnit);} primFun(primRemoveFile) { /* remove a file	   */  int rc;  String s = evalName(IOArg(1));    if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.removeFile",		     "illegal file name",		     &IOArg(1)));  }     rc = unlink(s);   if (rc != 0)    throwErrno("Directory.removeFile", TRUE, NO_HANDLE, &IOArg(1));  IOReturn(nameUnit);} /* Pair of macros for creating temporary strings */#if HAVE_ALLOCA# define ALLOC_STRING(x) (String)alloca(sizeof(char)*(x + 1))# define FREE_STRING(x)#elif HAVE__ALLOCA# define ALLOC_STRING(x) (String)_alloca(sizeof(char)*(x + 1))# define FREE_STRING(x)#else# define ALLOC_STRING(x) (String)malloc(sizeof(char)*(x + 1))# define FREE_STRING(x)  free(x)#endif primFun(primRenameDirectory) { /* rename a directory	   */  int rc;  String tmpStr;  String to;  String from;   tmpStr = evalName(IOArg(1));  if (!tmpStr) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.renameDirectory",		     "illegal directory name",		     &IOArg(1)));  }  to = ALLOC_STRING(strlen(tmpStr));  strcpy(to, tmpStr);   from = evalName(IOArg(2));  if (!from) {    FREE_STRING(to);    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.renameDirectory",		     "illegal directory name",		     &IOArg(2)));  }   rc = rename(from,to);   FREE_STRING(to);   if (rc != 0)    throwErrno("Directory.renameDirectory", FALSE, NO_HANDLE, &IOArg(1));  IOReturn(nameUnit);} primFun(primRenameFile) { /* rename a file	   */  int rc;  String tmpStr;  String to;  String from;   tmpStr = evalName(IOArg(1));  if (!tmpStr) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.renameFile",		     "illegal file name",		     &IOArg(1)));  }  to = ALLOC_STRING(strlen(tmpStr));  strcpy(to, tmpStr);   from = evalName(IOArg(2));  if (!from) {    FREE_STRING(to);    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.renameFile",		     "illegal file name",		     &IOArg(2)));  }   if (isDirectory(from)) {    FREE_STRING(to);    IOFail(mkIOError(NULL,		     namePermDenied,		     "Directory.renameFile",		     "is a directory",		     &IOArg(2)));  }   if (isDirectory(to)) {    FREE_STRING(to);    IOFail(mkIOError(NULL,		     namePermDenied,		     "Directory.renameFile",		     "is a directory",		     &IOArg(1)));  }   rc = rename(from,to);    FREE_STRING(to);   if (rc != 0)    throwErrno("Directory.renameFile", TRUE, NO_HANDLE, &IOArg(1));  IOReturn(nameUnit);}  primFun(primGetDirectory) { /* IO String - get current directory. */  char buffer[FILENAME_MAX+1];  if ((char*)(getcwd(buffer,FILENAME_MAX)) == (char*)NULL)    throwErrno("Directory.getCurrentDirectory", FALSE, NO_HANDLE, NULL);  pushString(buffer);  IOReturn(pop());} primFun(primSetDirectory) { /* String -> IO () - set current directory. */  int rc;  String s = evalName(IOArg(1));   if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.setCurrentDirectory",		     "illegal directory name",		     &IOArg(1)));  }     rc = chdir(s);    if (rc != 0)      throwErrno("Directory.setCurrentDirectory", FALSE, NO_HANDLE, &IOArg(1));   IOReturn(nameUnit);} primFun(primFileExist) { /* FilePath -> IO Bool - check to see if file exists. */  int rc;  String s = evalName(IOArg(1));  struct stat st;   if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.doesFileExist",		     "illegal file name",		     &IOArg(1)));  }    rc = stat(s, &st);    IOBoolResult(rc == 0 && !S_ISDIR(st.st_mode) );} primFun(primDirExist) { /* FilePath -> IO Bool - check to see if directory exists. */  String s = evalName(IOArg(1));   if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.doesDirectoryExist",		     "illegal directory name",		     &IOArg(1)));  }  IOBoolResult(isDirectory(s));} static Bool local isDirectory(s)String s; {  int rc;  struct stat st;#ifdef _WIN32  /* For whatever reason, stat()ing a directory name   * like "foo/" returns an error, while both "foo" and "foo/."   * is fine. We want them all to be treated equal.   */  int len = strlen(s);  while (len > 0 && 	 (s[len-1] == '/' || s[len-1] == '\\')) {      s[len-1] = '\0';      len--;  }#endif  rc = stat(s, &st);  return (rc==0 && S_ISDIR(st.st_mode));} primFun(primGetPermissions) { /* FilePath -> IO (Bool,Bool,Bool,Bool) */  int rc;  String s = evalName(IOArg(1));  struct stat st;  int isR, isW, isX;   #if __MWERKS__ && macintosh    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.primGetPermissions",		     "operation not supported",		     &IOArg(1)));#else  if (!s) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.getPermissions",		     "illegal file name",		     &IOArg(1)));  }    isR = access(s, R_OK);  isW = access(s, W_OK);  isX = access(s, X_OK);  rc = stat(s, &st);    if (rc != 0)    throwErrno("Directory.getPermissions", FALSE, NO_HANDLE, &IOArg(1));  IOReturn(ap(ap(ap(ap( mkTuple(4),			ToBool(isR == 0)),		    ToBool(isW == 0)),		 ToBool(isX == 0 && !S_ISDIR(st.st_mode))),	      ToBool(isX == 0 && S_ISDIR(st.st_mode))));#endif} #define EVAL_BOOL(x,y) \   eval(y);\   if (whnfHead==nameTrue) { \      x = TRUE; \   } else if (whnfHead==nameFalse) { \      x = FALSE; \   } else { \      IOFail(mkIOError(NULL, \	     nameIllegal, \	     "Directory.setPermissions", \	     "illegal flag", \	     NULL)); \   } #ifdef _MSC_VER#define READ_FLAG   S_IREAD#define WRITE_FLAG  S_IWRITE#define EXEC_FLAG   S_IEXEC#else#define READ_FLAG   S_IRUSR#define WRITE_FLAG  S_IWUSR#define EXEC_FLAG   S_IXUSR#endif #define SET_CHMOD_FLAG(x,y)  (x ? y : 0) primFun(primSetPermissions) { /* FilePath -> Bool -> Bool -> Bool -> Bool -> IO () */  int rc;  String str;  struct stat st;   Bool   r;  Bool   w;  Bool   e;  Bool   s;  #if __MWERKS__ && macintosh    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.primSetPermissions",		     "operation not supported",		     &IOArg(1)));#else  EVAL_BOOL(s, IOArg(1));  EVAL_BOOL(e, IOArg(2));  EVAL_BOOL(w, IOArg(3));  EVAL_BOOL(r, IOArg(4));    str = evalName(IOArg(5));    if (!str) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.setPermissions",		     "illegal file name",		     &IOArg(5)));  }   rc = stat(str, &st);  if (rc == 0)    rc = chmod(str,	       (st.st_mode & ~(READ_FLAG|WRITE_FLAG|EXEC_FLAG)) |	       SET_CHMOD_FLAG(r, READ_FLAG)  |	       SET_CHMOD_FLAG(w, WRITE_FLAG) |	       SET_CHMOD_FLAG(e||s, EXEC_FLAG));	       if (rc != 0)    throwErrno("Directory.setPermissions", TRUE, NO_HANDLE, &IOArg(5));  IOReturn(nameUnit);  #endif} /* Pedantically remove these local defs. */#undef READ_FLAG#undef WRITE_FLAG#undef EXEC_FLAG#undef SET_CHMOD_FLAG primFun(primGetDirContents) { /* FilePath -> IO [FilePath] */#ifdef _MSC_VER  /* The MS CRT doesn't provide opendir()/readdir(), but uses     the 'std' MS find first/next/close group of functions for     iterating over the contents of a directory. */  int rc;  long dirHandle;  struct _finddata_t fData;  char buffer[FILENAME_MAX+20];  struct stat st;  Cell ls;  String fName = evalName(IOArg(1));    if (!fName) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.getDirectoryContents",		     "illegal directory name",		     &IOArg(1)));  }    if (strlen(fName) > FILENAME_MAX) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.getDirectoryContents",		     "file name too long",		     &IOArg(1)));  }    /* First, check whether the directory exists... */  if (stat(fName, &st) < 0)    throwErrno("Directory.getDirectoryContents", FALSE, NO_HANDLE, &IOArg(1));  if (!S_ISDIR(st.st_mode)) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.getDirectoryContents",		     "not a directory",		     &IOArg(1)));  }    if (snprintf(buffer,sizeof(buffer)-1,"%s\\*.*",fName) < 0) {    IOFail(mkIOError(NULL,		     nameIllegal,		     "Directory.getDirectoryContents",		     "illegal directory name",		     &IOArg(1)));  } else {      buffer[sizeof(buffer)-1] = '\0';  }   dirHandle = _findfirst(buffer, &fData);  rc = dirHandle;  

Lines 1–500 of 596. Load more