← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netsys/unixsupport_w32.c

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netsys/unixsupport_w32.c
 
1
/* Ocaml does not provide an API for interfacing with the Unix
 
2
   library from a FFI. This is especially problematic on Win32,
 
3
   because the unixsupport functions are not even exported.
 
4
   Because of this, here is a copy of unixsupport.c (win32 variant).
 
5
 
 
6
   To avoid name clashes, some functions have got a prefix (netsysw32_).
 
7
   The "#include" lines are adapted. cst_to_constr and
 
8
   unix_error_of_code have been added.
 
9
*/
 
10
 
 
11
/***********************************************************************/
 
12
/*                                                                     */
 
13
/*                           Objective Caml                            */
 
14
/*                                                                     */
 
15
/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 
16
/*                                                                     */
 
17
/*  Copyright 1996 Institut National de Recherche en Informatique et   */
 
18
/*  en Automatique.  All rights reserved.  This file is distributed    */
 
19
/*  under the terms of the GNU Library General Public License, with    */
 
20
/*  the special exception on linking described in file ../../LICENSE.  */
 
21
/*                                                                     */
 
22
/***********************************************************************/
 
23
 
 
24
/* $Id: unixsupport.c,v 1.20 2005/09/22 14:21:50 xleroy Exp $ */
 
25
 
 
26
static value cst_to_constr(int n, int *tbl, int size, int deflt)
 
27
{
 
28
  int i;
 
29
  for (i = 0; i < size; i++)
 
30
    if (n == tbl[i]) return Val_int(i);
 
31
  return Val_int(deflt);
 
32
}
 
33
 
 
34
/* Heap-allocation of Windows file handles */
 
35
 
 
36
static int win_handle_compare(value v1, value v2)
 
37
{
 
38
  HANDLE h1 = Handle_val(v1);
 
39
  HANDLE h2 = Handle_val(v2);
 
40
  return h1 == h2 ? 0 : h1 < h2 ? -1 : 1;
 
41
}
 
42
 
 
43
static intnat win_handle_hash(value v)
 
44
{
 
45
  return (intnat) Handle_val(v);
 
46
}
 
47
 
 
48
static struct custom_operations win_handle_ops = {
 
49
  "_handle",
 
50
  custom_finalize_default,
 
51
  win_handle_compare,
 
52
  win_handle_hash,
 
53
  custom_serialize_default,
 
54
  custom_deserialize_default
 
55
};
 
56
 
 
57
value netsysw32_win_alloc_handle(HANDLE h)
 
58
{
 
59
  value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
 
60
  Handle_val(res) = h;
 
61
  Descr_kind_val(res) = KIND_HANDLE;
 
62
  CRT_fd_val(res) = NO_CRT_FD;
 
63
  return res;
 
64
}
 
65
 
 
66
value netsysw32_win_alloc_socket(SOCKET s)
 
67
{
 
68
  value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
 
69
  Socket_val(res) = s;
 
70
  Descr_kind_val(res) = KIND_SOCKET;
 
71
  CRT_fd_val(res) = NO_CRT_FD;
 
72
  return res;
 
73
}
 
74
 
 
75
value netsysw32_win_alloc_handle_or_socket(HANDLE h)
 
76
{
 
77
  value res = win_alloc_handle(h);
 
78
  int opt;
 
79
  int optlen = sizeof(opt);
 
80
  if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
 
81
    Descr_kind_val(res) = KIND_SOCKET;
 
82
  return res;
 
83
}
 
84
 
 
85
/* Mapping of Windows error codes to POSIX error codes */
 
86
 
 
87
struct error_entry { DWORD win_code; int range; int posix_code; };
 
88
 
 
89
static struct error_entry win_error_table[] = {
 
90
  { ERROR_INVALID_FUNCTION, 0, EINVAL},
 
91
  { ERROR_FILE_NOT_FOUND, 0, ENOENT},
 
92
  { ERROR_PATH_NOT_FOUND, 0, ENOENT},
 
93
  { ERROR_TOO_MANY_OPEN_FILES, 0, EMFILE},
 
94
  { ERROR_ACCESS_DENIED, 0, EACCES},
 
95
  { ERROR_INVALID_HANDLE, 0, EBADF},
 
96
  { ERROR_ARENA_TRASHED, 0, ENOMEM},
 
97
  { ERROR_NOT_ENOUGH_MEMORY, 0, ENOMEM},
 
98
  { ERROR_INVALID_BLOCK, 0, ENOMEM},
 
99
  { ERROR_BAD_ENVIRONMENT, 0, E2BIG},
 
100
  { ERROR_BAD_FORMAT, 0, ENOEXEC},
 
101
  { ERROR_INVALID_ACCESS, 0, EINVAL},
 
102
  { ERROR_INVALID_DATA, 0, EINVAL},
 
103
  { ERROR_INVALID_DRIVE, 0, ENOENT},
 
104
  { ERROR_CURRENT_DIRECTORY, 0, EACCES},
 
105
  { ERROR_NOT_SAME_DEVICE, 0, EXDEV},
 
106
  { ERROR_NO_MORE_FILES, 0, ENOENT},
 
107
  { ERROR_LOCK_VIOLATION, 0, EACCES},
 
108
  { ERROR_BAD_NETPATH, 0, ENOENT},
 
109
  { ERROR_NETWORK_ACCESS_DENIED, 0, EACCES},
 
110
  { ERROR_BAD_NET_NAME, 0, ENOENT},
 
111
  { ERROR_FILE_EXISTS, 0, EEXIST},
 
112
  { ERROR_CANNOT_MAKE, 0, EACCES},
 
113
  { ERROR_FAIL_I24, 0, EACCES},
 
114
  { ERROR_INVALID_PARAMETER, 0, EINVAL},
 
115
  { ERROR_NO_PROC_SLOTS, 0, EAGAIN},
 
116
  { ERROR_DRIVE_LOCKED, 0, EACCES},
 
117
  { ERROR_BROKEN_PIPE, 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
 
 
158
void netsysw32_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
 
 
176
#define EWOULDBLOCK             -WSAEWOULDBLOCK
 
177
#define EINPROGRESS             -WSAEINPROGRESS
 
178
#define EALREADY                -WSAEALREADY
 
179
#define ENOTSOCK                -WSAENOTSOCK
 
180
#define EDESTADDRREQ            -WSAEDESTADDRREQ
 
181
#define EMSGSIZE                -WSAEMSGSIZE
 
182
#define EPROTOTYPE              -WSAEPROTOTYPE
 
183
#define ENOPROTOOPT             -WSAENOPROTOOPT
 
184
#define EPROTONOSUPPORT         -WSAEPROTONOSUPPORT
 
185
#define ESOCKTNOSUPPORT         -WSAESOCKTNOSUPPORT
 
186
#define EOPNOTSUPP              -WSAEOPNOTSUPP
 
187
#define EPFNOSUPPORT            -WSAEPFNOSUPPORT
 
188
#define EAFNOSUPPORT            -WSAEAFNOSUPPORT
 
189
#define EADDRINUSE              -WSAEADDRINUSE
 
190
#define EADDRNOTAVAIL           -WSAEADDRNOTAVAIL
 
191
#define ENETDOWN                -WSAENETDOWN
 
192
#define ENETUNREACH             -WSAENETUNREACH
 
193
#define ENETRESET               -WSAENETRESET
 
194
#define ECONNABORTED            -WSAECONNABORTED
 
195
#define ECONNRESET              -WSAECONNRESET
 
196
#define ENOBUFS                 -WSAENOBUFS
 
197
#define EISCONN                 -WSAEISCONN
 
198
#define ENOTCONN                -WSAENOTCONN
 
199
#define ESHUTDOWN               -WSAESHUTDOWN
 
200
#define ETOOMANYREFS            -WSAETOOMANYREFS
 
201
#define ETIMEDOUT               -WSAETIMEDOUT
 
202
#define ECONNREFUSED            -WSAECONNREFUSED
 
203
#define ELOOP                   -WSAELOOP
 
204
#define EHOSTDOWN               -WSAEHOSTDOWN
 
205
#define EHOSTUNREACH            -WSAEHOSTUNREACH
 
206
#define EPROCLIM                -WSAEPROCLIM
 
207
#define EUSERS                  -WSAEUSERS
 
208
#define EDQUOT                  -WSAEDQUOT
 
209
#define ESTALE                  -WSAESTALE
 
210
#define EREMOTE                 -WSAEREMOTE
 
211
 
 
212
#define EOVERFLOW -ERROR_ARITHMETIC_OVERFLOW
 
213
#define EACCESS EACCES
 
214
 
 
215
int netsysw32_error_table[] = {
 
216
  E2BIG, EACCESS, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
 
217
  EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK,
 
218
  ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC,
 
219
  ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE,
 
220
  EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY,
 
221
  ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT,
 
222
  EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT,
 
223
  EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
 
224
  ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
 
225
  ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
 
226
  EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */
 
227
};
 
228
 
 
229
static value * unix_error_exn = NULL;
 
230
 
 
231
value netsysw32_unix_error_of_code (int errcode)
 
232
{
 
233
  int errconstr;
 
234
  value err;
 
235
 
 
236
  errconstr = 
 
237
      cst_to_constr(errcode, netsysw32_error_table, sizeof(netsysw32_error_table)/sizeof(int), -1);
 
238
  if (errconstr == Val_int(-1)) {
 
239
    err = alloc_small(1, 0);
 
240
    Field(err, 0) = Val_int(errcode);
 
241
  } else {
 
242
    err = errconstr;
 
243
  }
 
244
  return err;
 
245
}
 
246
 
 
247
 
 
248
void netsysw32_unix_error(int errcode, char *cmdname, value cmdarg)
 
249
{
 
250
  value res;
 
251
  value name = Val_unit, err = Val_unit, arg = Val_unit;
 
252
 
 
253
  Begin_roots3 (name, err, arg);
 
254
    arg = cmdarg == Nothing ? copy_string("") : cmdarg;
 
255
    name = copy_string(cmdname);
 
256
    err = unix_error_of_code(errcode);
 
257
    if (unix_error_exn == NULL) {
 
258
      unix_error_exn = caml_named_value("Unix.Unix_error");
 
259
      if (unix_error_exn == NULL)
 
260
        invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
 
261
    }
 
262
    res = alloc_small(4, 0);
 
263
    Field(res, 0) = *unix_error_exn;
 
264
    Field(res, 1) = err;
 
265
    Field(res, 2) = name;
 
266
    Field(res, 3) = arg;
 
267
  End_roots();
 
268
  mlraise(res);
 
269
}
 
270
 
 
271
void netsysw32_uerror(cmdname, cmdarg)
 
272
     char * cmdname;
 
273
     value cmdarg;
 
274
{
 
275
  unix_error(errno, cmdname, cmdarg);
 
276
}