1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #include <stddef.h>
17 #include <caml/mlvalues.h>
18 #include <caml/callback.h>
19 #include <caml/alloc.h>
20 #include <caml/memory.h>
21 #include <caml/fail.h>
22 #include <caml/custom.h>
23 #include "unixsupport.h"
24 #include "cst2constr.h"
25 #include <errno.h>
26
27 /* Heap-allocation of Windows file handles */
28
win_handle_compare(value v1,value v2)29 static int win_handle_compare(value v1, value v2)
30 {
31 HANDLE h1 = Handle_val(v1);
32 HANDLE h2 = Handle_val(v2);
33 return h1 == h2 ? 0 : h1 < h2 ? -1 : 1;
34 }
35
win_handle_hash(value v)36 static intnat win_handle_hash(value v)
37 {
38 return (intnat) Handle_val(v);
39 }
40
41 static struct custom_operations win_handle_ops = {
42 "_handle",
43 custom_finalize_default,
44 win_handle_compare,
45 win_handle_hash,
46 custom_serialize_default,
47 custom_deserialize_default,
48 custom_compare_ext_default
49 };
50
win_alloc_handle(HANDLE h)51 value win_alloc_handle(HANDLE h)
52 {
53 value res = caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
54 Handle_val(res) = h;
55 Descr_kind_val(res) = KIND_HANDLE;
56 CRT_fd_val(res) = NO_CRT_FD;
57 Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
58 return res;
59 }
60
win_alloc_socket(SOCKET s)61 value win_alloc_socket(SOCKET s)
62 {
63 value res = caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
64 Socket_val(res) = s;
65 Descr_kind_val(res) = KIND_SOCKET;
66 CRT_fd_val(res) = NO_CRT_FD;
67 Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
68 return res;
69 }
70
71 #if 0
72 /* PR#4750: this function is no longer used */
73 value win_alloc_handle_or_socket(HANDLE h)
74 {
75 value res = win_alloc_handle(h);
76 int opt;
77 int optlen = sizeof(opt);
78 if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
79 Descr_kind_val(res) = KIND_SOCKET;
80 return res;
81 }
82 #endif
83
84 /* Mapping of Windows error codes to POSIX error codes */
85
86 struct error_entry { DWORD win_code; int range; int posix_code; };
87
88 static struct error_entry win_error_table[] = {
89 { ERROR_INVALID_FUNCTION, 0, EINVAL},
90 { ERROR_FILE_NOT_FOUND, 0, ENOENT},
91 { ERROR_PATH_NOT_FOUND, 0, ENOENT},
92 { ERROR_TOO_MANY_OPEN_FILES, 0, EMFILE},
93 { ERROR_ACCESS_DENIED, 0, EACCES},
94 { ERROR_INVALID_HANDLE, 0, EBADF},
95 { ERROR_ARENA_TRASHED, 0, ENOMEM},
96 { ERROR_NOT_ENOUGH_MEMORY, 0, ENOMEM},
97 { ERROR_INVALID_BLOCK, 0, ENOMEM},
98 { ERROR_BAD_ENVIRONMENT, 0, E2BIG},
99 { ERROR_BAD_FORMAT, 0, ENOEXEC},
100 { ERROR_INVALID_ACCESS, 0, EINVAL},
101 { ERROR_INVALID_DATA, 0, EINVAL},
102 { ERROR_INVALID_DRIVE, 0, ENOENT},
103 { ERROR_CURRENT_DIRECTORY, 0, EACCES},
104 { ERROR_NOT_SAME_DEVICE, 0, EXDEV},
105 { ERROR_NO_MORE_FILES, 0, ENOENT},
106 { ERROR_LOCK_VIOLATION, 0, EACCES},
107 { ERROR_BAD_NETPATH, 0, ENOENT},
108 { ERROR_NETWORK_ACCESS_DENIED, 0, EACCES},
109 { ERROR_BAD_NET_NAME, 0, ENOENT},
110 { ERROR_FILE_EXISTS, 0, EEXIST},
111 { ERROR_CANNOT_MAKE, 0, EACCES},
112 { ERROR_FAIL_I24, 0, EACCES},
113 { ERROR_INVALID_PARAMETER, 0, EINVAL},
114 { ERROR_NO_PROC_SLOTS, 0, EAGAIN},
115 { ERROR_DRIVE_LOCKED, 0, EACCES},
116 { ERROR_BROKEN_PIPE, 0, EPIPE},
117 { ERROR_NO_DATA, 0, EPIPE},
118 { ERROR_DISK_FULL, 0, ENOSPC},
119 { ERROR_INVALID_TARGET_HANDLE, 0, EBADF},
120 { ERROR_INVALID_HANDLE, 0, EINVAL},
121 { ERROR_WAIT_NO_CHILDREN, 0, ECHILD},
122 { ERROR_CHILD_NOT_COMPLETE, 0, ECHILD},
123 { ERROR_DIRECT_ACCESS_HANDLE, 0, EBADF},
124 { ERROR_NEGATIVE_SEEK, 0, EINVAL},
125 { ERROR_SEEK_ON_DEVICE, 0, EACCES},
126 { ERROR_DIR_NOT_EMPTY, 0, ENOTEMPTY},
127 { ERROR_NOT_LOCKED, 0, EACCES},
128 { ERROR_BAD_PATHNAME, 0, ENOENT},
129 { ERROR_MAX_THRDS_REACHED, 0, EAGAIN},
130 { ERROR_LOCK_FAILED, 0, EACCES},
131 { ERROR_ALREADY_EXISTS, 0, EEXIST},
132 { ERROR_FILENAME_EXCED_RANGE, 0, ENOENT},
133 { ERROR_NESTING_NOT_ALLOWED, 0, EAGAIN},
134 { ERROR_NOT_ENOUGH_QUOTA, 0, ENOMEM},
135 { ERROR_INVALID_STARTING_CODESEG,
136 ERROR_INFLOOP_IN_RELOC_CHAIN - ERROR_INVALID_STARTING_CODESEG,
137 ENOEXEC },
138 { ERROR_WRITE_PROTECT,
139 ERROR_SHARING_BUFFER_EXCEEDED - ERROR_WRITE_PROTECT,
140 EACCES },
141 { WSAEINVAL, 0, EINVAL },
142 { WSAEACCES, 0, EACCES },
143 { WSAEBADF, 0, EBADF },
144 { WSAEFAULT, 0, EFAULT },
145 { WSAEINTR, 0, EINTR },
146 { WSAEINVAL, 0, EINVAL },
147 { WSAEMFILE, 0, EMFILE },
148 #ifdef WSANAMETOOLONG
149 { WSANAMETOOLONG, 0, ENAMETOOLONG },
150 #endif
151 #ifdef WSAENFILE
152 { WSAENFILE, 0, ENFILE },
153 #endif
154 { WSAENOTEMPTY, 0, ENOTEMPTY },
155 { 0, -1, 0 }
156 };
157
win32_maperr(DWORD errcode)158 void win32_maperr(DWORD errcode)
159 {
160 int i;
161
162 for (i = 0; win_error_table[i].range >= 0; i++) {
163 if (errcode >= win_error_table[i].win_code &&
164 errcode <= win_error_table[i].win_code + win_error_table[i].range) {
165 errno = win_error_table[i].posix_code;
166 return;
167 }
168 }
169 /* Not found: save original error code, negated so that we can
170 recognize it in unix_error_message */
171 errno = -errcode;
172 }
173
174 /* Windows socket errors */
175 #undef EWOULDBLOCK
176 #define EWOULDBLOCK -WSAEWOULDBLOCK
177 #undef EINPROGRESS
178 #define EINPROGRESS -WSAEINPROGRESS
179 #undef EALREADY
180 #define EALREADY -WSAEALREADY
181 #undef ENOTSOCK
182 #define ENOTSOCK -WSAENOTSOCK
183 #undef EDESTADDRREQ
184 #define EDESTADDRREQ -WSAEDESTADDRREQ
185 #undef EMSGSIZE
186 #define EMSGSIZE -WSAEMSGSIZE
187 #undef EPROTOTYPE
188 #define EPROTOTYPE -WSAEPROTOTYPE
189 #undef ENOPROTOOPT
190 #define ENOPROTOOPT -WSAENOPROTOOPT
191 #undef EPROTONOSUPPORT
192 #define EPROTONOSUPPORT -WSAEPROTONOSUPPORT
193 #undef ESOCKTNOSUPPORT
194 #define ESOCKTNOSUPPORT -WSAESOCKTNOSUPPORT
195 #undef EOPNOTSUPP
196 #define EOPNOTSUPP -WSAEOPNOTSUPP
197 #undef EPFNOSUPPORT
198 #define EPFNOSUPPORT -WSAEPFNOSUPPORT
199 #undef EAFNOSUPPORT
200 #define EAFNOSUPPORT -WSAEAFNOSUPPORT
201 #undef EADDRINUSE
202 #define EADDRINUSE -WSAEADDRINUSE
203 #undef EADDRNOTAVAIL
204 #define EADDRNOTAVAIL -WSAEADDRNOTAVAIL
205 #undef ENETDOWN
206 #define ENETDOWN -WSAENETDOWN
207 #undef ENETUNREACH
208 #define ENETUNREACH -WSAENETUNREACH
209 #undef ENETRESET
210 #define ENETRESET -WSAENETRESET
211 #undef ECONNABORTED
212 #define ECONNABORTED -WSAECONNABORTED
213 #undef ECONNRESET
214 #define ECONNRESET -WSAECONNRESET
215 #undef ENOBUFS
216 #define ENOBUFS -WSAENOBUFS
217 #undef EISCONN
218 #define EISCONN -WSAEISCONN
219 #undef ENOTCONN
220 #define ENOTCONN -WSAENOTCONN
221 #undef ESHUTDOWN
222 #define ESHUTDOWN -WSAESHUTDOWN
223 #undef ETOOMANYREFS
224 #define ETOOMANYREFS -WSAETOOMANYREFS
225 #undef ETIMEDOUT
226 #define ETIMEDOUT -WSAETIMEDOUT
227 #undef ECONNREFUSED
228 #define ECONNREFUSED -WSAECONNREFUSED
229 #undef ELOOP
230 #define ELOOP -WSAELOOP
231 #undef EHOSTDOWN
232 #define EHOSTDOWN -WSAEHOSTDOWN
233 #undef EHOSTUNREACH
234 #define EHOSTUNREACH -WSAEHOSTUNREACH
235 #undef EPROCLIM
236 #define EPROCLIM -WSAEPROCLIM
237 #undef EUSERS
238 #define EUSERS -WSAEUSERS
239 #undef EDQUOT
240 #define EDQUOT -WSAEDQUOT
241 #undef ESTALE
242 #define ESTALE -WSAESTALE
243 #undef EREMOTE
244 #define EREMOTE -WSAEREMOTE
245
246 #undef EOVERFLOW
247 #define EOVERFLOW -ERROR_ARITHMETIC_OVERFLOW
248 #undef EACCESS
249 #define EACCESS EACCES
250
251 int error_table[] = {
252 E2BIG, EACCESS, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
253 EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK,
254 ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC,
255 ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE,
256 EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY,
257 ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT,
258 EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT,
259 EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
260 ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
261 ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
262 EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */
263 };
264
265 static value * unix_error_exn = NULL;
266
unix_error_of_code(int errcode)267 value unix_error_of_code (int errcode)
268 {
269 int errconstr;
270 value err;
271
272 errconstr =
273 cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
274 if (errconstr == Val_int(-1)) {
275 err = caml_alloc_small(1, 0);
276 Field(err, 0) = Val_int(errcode);
277 } else {
278 err = errconstr;
279 }
280 return err;
281 }
282
unix_error(int errcode,char * cmdname,value cmdarg)283 void unix_error(int errcode, char *cmdname, value cmdarg)
284 {
285 value res;
286 value name = Val_unit, err = Val_unit, arg = Val_unit;
287 int errconstr;
288
289 Begin_roots3 (name, err, arg);
290 arg = cmdarg == Nothing ? caml_copy_string("") : cmdarg;
291 name = caml_copy_string(cmdname);
292 err = unix_error_of_code (errcode);
293 if (unix_error_exn == NULL) {
294 unix_error_exn = caml_named_value("Unix.Unix_error");
295 if (unix_error_exn == NULL)
296 caml_invalid_argument("Exception Unix.Unix_error not initialized,"
297 " please link unix.cma");
298 }
299 res = caml_alloc_small(4, 0);
300 Field(res, 0) = *unix_error_exn;
301 Field(res, 1) = err;
302 Field(res, 2) = name;
303 Field(res, 3) = arg;
304 End_roots();
305 caml_raise(res);
306 }
307
uerror(char * cmdname,value cmdarg)308 void uerror(char * cmdname, value cmdarg)
309 {
310 unix_error(errno, cmdname, cmdarg);
311 }
312
caml_unix_check_path(value path,char * cmdname)313 void caml_unix_check_path(value path, char * cmdname)
314 {
315 if (! caml_string_is_c_safe(path)) unix_error(ENOENT, cmdname, path);
316 }
317
318 int unix_cloexec_default = 0;
319
unix_cloexec_p(value cloexec)320 int unix_cloexec_p(value cloexec)
321 {
322 /* [cloexec] is a [bool option]. */
323 if (Is_block(cloexec))
324 return Bool_val(Field(cloexec, 0));
325 else
326 return unix_cloexec_default;
327 }
328