1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
/*
* (c) The University of Glasgow 2002
*
* Directory Runtime Support
*/
#include "config.h"
// The following is required on Solaris to force the POSIX versions of
// the various _r functions instead of the Solaris versions.
#ifdef solaris2_TARGET_OS
#define _POSIX_PTHREAD_SEMANTICS
#endif
#include "HsBase.h"
#if defined(mingw32_TARGET_OS) || defined(__MINGW32__) || defined(_MSC_VER)
#include <windows.h>
static
int
toErrno(DWORD rc)
{
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
__hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt )
{
struct dirent **pDirE = (struct dirent**)pDirEnt;
#if HAVE_READDIR_R
struct dirent* p;
int res;
static unsigned int nm_max = -1;
if (pDirE == NULL) {
return -1;
}
if (nm_max == (unsigned int)-1) {
#ifdef NAME_MAX
nm_max = NAME_MAX + 1;
#else
nm_max = pathconf(".", _PC_NAME_MAX);
if (nm_max == -1) { nm_max = 255; }
nm_max++;
#endif
}
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
if (pDirE == NULL) {
return -1;
}
*pDirE = readdir((DIR*)dirPtr);
if (*pDirE == NULL) {
return -1;
} else {
return 0;
}
#endif
}
/*
* 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)
{
#if (defined(_MSC_VER) || defined(_WIN32))
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 rename(src,dest);
#endif
}
|
