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