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 <caml/mlvalues.h>
17 #include <caml/memory.h>
18 #include <caml/alloc.h>
19 #include <caml/fail.h>
20 #include "unixsupport.h"
21
22 #ifdef HAS_SOCKETS
23
24 #include <errno.h>
25 #include <sys/time.h>
26 #include <sys/types.h>
27 #include <sys/socket.h>
28 #include <netinet/tcp.h>
29
30 #include "socketaddr.h"
31
32 #ifndef SO_DEBUG
33 #define SO_DEBUG (-1)
34 #endif
35 #ifndef SO_BROADCAST
36 #define SO_BROADCAST (-1)
37 #endif
38 #ifndef SO_REUSEADDR
39 #define SO_REUSEADDR (-1)
40 #endif
41 #ifndef SO_KEEPALIVE
42 #define SO_KEEPALIVE (-1)
43 #endif
44 #ifndef SO_DONTROUTE
45 #define SO_DONTROUTE (-1)
46 #endif
47 #ifndef SO_OOBINLINE
48 #define SO_OOBINLINE (-1)
49 #endif
50 #ifndef SO_ACCEPTCONN
51 #define SO_ACCEPTCONN (-1)
52 #endif
53 #ifndef SO_SNDBUF
54 #define SO_SNDBUF (-1)
55 #endif
56 #ifndef SO_RCVBUF
57 #define SO_RCVBUF (-1)
58 #endif
59 #ifndef SO_ERROR
60 #define SO_ERROR (-1)
61 #endif
62 #ifndef SO_TYPE
63 #define SO_TYPE (-1)
64 #endif
65 #ifndef SO_RCVLOWAT
66 #define SO_RCVLOWAT (-1)
67 #endif
68 #ifndef SO_SNDLOWAT
69 #define SO_SNDLOWAT (-1)
70 #endif
71 #ifndef SO_LINGER
72 #define SO_LINGER (-1)
73 #endif
74 #ifndef SO_RCVTIMEO
75 #define SO_RCVTIMEO (-1)
76 #endif
77 #ifndef SO_SNDTIMEO
78 #define SO_SNDTIMEO (-1)
79 #endif
80 #ifndef TCP_NODELAY
81 #define TCP_NODELAY (-1)
82 #endif
83 #ifndef SO_ERROR
84 #define SO_ERROR (-1)
85 #endif
86 #ifndef IPPROTO_IPV6
87 #define IPPROTO_IPV6 (-1)
88 #endif
89 #ifndef IPV6_V6ONLY
90 #define IPV6_V6ONLY (-1)
91 #endif
92
93 enum option_type {
94 TYPE_BOOL = 0,
95 TYPE_INT = 1,
96 TYPE_LINGER = 2,
97 TYPE_TIMEVAL = 3,
98 TYPE_UNIX_ERROR = 4
99 };
100
101 struct socket_option {
102 int level;
103 int option;
104 };
105
106 /* Table of options, indexed by type */
107
108 static struct socket_option sockopt_bool[] = {
109 { SOL_SOCKET, SO_DEBUG },
110 { SOL_SOCKET, SO_BROADCAST },
111 { SOL_SOCKET, SO_REUSEADDR },
112 { SOL_SOCKET, SO_KEEPALIVE },
113 { SOL_SOCKET, SO_DONTROUTE },
114 { SOL_SOCKET, SO_OOBINLINE },
115 { SOL_SOCKET, SO_ACCEPTCONN },
116 { IPPROTO_TCP, TCP_NODELAY },
117 { IPPROTO_IPV6, IPV6_V6ONLY}
118 };
119
120 static struct socket_option sockopt_int[] = {
121 { SOL_SOCKET, SO_SNDBUF },
122 { SOL_SOCKET, SO_RCVBUF },
123 { SOL_SOCKET, SO_ERROR },
124 { SOL_SOCKET, SO_TYPE },
125 { SOL_SOCKET, SO_RCVLOWAT },
126 { SOL_SOCKET, SO_SNDLOWAT } };
127
128 static struct socket_option sockopt_linger[] = {
129 { SOL_SOCKET, SO_LINGER }
130 };
131
132 static struct socket_option sockopt_timeval[] = {
133 { SOL_SOCKET, SO_RCVTIMEO },
134 { SOL_SOCKET, SO_SNDTIMEO }
135 };
136
137 static struct socket_option sockopt_unix_error[] = {
138 { SOL_SOCKET, SO_ERROR }
139 };
140
141 static struct socket_option * sockopt_table[] = {
142 sockopt_bool,
143 sockopt_int,
144 sockopt_linger,
145 sockopt_timeval,
146 sockopt_unix_error
147 };
148
149 static char * getsockopt_fun_name[] = {
150 "getsockopt",
151 "getsockopt_int",
152 "getsockopt_optint",
153 "getsockopt_float",
154 "getsockopt_error"
155 };
156
157 static char * setsockopt_fun_name[] = {
158 "setsockopt",
159 "setsockopt_int",
160 "setsockopt_optint",
161 "setsockopt_float",
162 "setsockopt_error"
163 };
164
165 union option_value {
166 int i;
167 struct linger lg;
168 struct timeval tv;
169 };
170
171 CAMLexport value
unix_getsockopt_aux(char * name,enum option_type ty,int level,int option,value socket)172 unix_getsockopt_aux(char * name,
173 enum option_type ty, int level, int option,
174 value socket)
175 {
176 union option_value optval;
177 socklen_param_type optsize;
178
179
180 switch (ty) {
181 case TYPE_BOOL:
182 case TYPE_INT:
183 case TYPE_UNIX_ERROR:
184 optsize = sizeof(optval.i); break;
185 case TYPE_LINGER:
186 optsize = sizeof(optval.lg); break;
187 case TYPE_TIMEVAL:
188 optsize = sizeof(optval.tv); break;
189 default:
190 unix_error(EINVAL, name, Nothing);
191 }
192
193 if (getsockopt(Int_val(socket), level, option,
194 (void *) &optval, &optsize) == -1)
195 uerror(name, Nothing);
196
197 switch (ty) {
198 case TYPE_BOOL:
199 return Val_bool(optval.i);
200 case TYPE_INT:
201 return Val_int(optval.i);
202 case TYPE_LINGER:
203 if (optval.lg.l_onoff == 0) {
204 return Val_int(0); /* None */
205 } else {
206 value res = caml_alloc_small(1, 0); /* Some */
207 Field(res, 0) = Val_int(optval.lg.l_linger);
208 return res;
209 }
210 case TYPE_TIMEVAL:
211 return caml_copy_double((double) optval.tv.tv_sec
212 + (double) optval.tv.tv_usec / 1e6);
213 case TYPE_UNIX_ERROR:
214 if (optval.i == 0) {
215 return Val_int(0); /* None */
216 } else {
217 value err, res;
218 err = unix_error_of_code(optval.i);
219 Begin_root(err);
220 res = caml_alloc_small(1, 0); /* Some */
221 Field(res, 0) = err;
222 End_roots();
223 return res;
224 }
225 default:
226 unix_error(EINVAL, name, Nothing);
227 }
228 }
229
230 CAMLexport value
unix_setsockopt_aux(char * name,enum option_type ty,int level,int option,value socket,value val)231 unix_setsockopt_aux(char * name,
232 enum option_type ty, int level, int option,
233 value socket, value val)
234 {
235 union option_value optval;
236 socklen_param_type optsize;
237 double f;
238
239 switch (ty) {
240 case TYPE_BOOL:
241 case TYPE_INT:
242 optsize = sizeof(optval.i);
243 optval.i = Int_val(val);
244 break;
245 case TYPE_LINGER:
246 optsize = sizeof(optval.lg);
247 optval.lg.l_onoff = Is_block (val);
248 if (optval.lg.l_onoff)
249 optval.lg.l_linger = Int_val (Field (val, 0));
250 break;
251 case TYPE_TIMEVAL:
252 f = Double_val(val);
253 optsize = sizeof(optval.tv);
254 optval.tv.tv_sec = (int) f;
255 optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec));
256 break;
257 case TYPE_UNIX_ERROR:
258 default:
259 unix_error(EINVAL, name, Nothing);
260 }
261
262 if (setsockopt(Int_val(socket), level, option,
263 (void *) &optval, optsize) == -1)
264 uerror(name, Nothing);
265
266 return Val_unit;
267 }
268
unix_getsockopt(value vty,value vsocket,value voption)269 CAMLprim value unix_getsockopt(value vty, value vsocket, value voption)
270 {
271 enum option_type ty = Int_val(vty);
272 struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
273 return unix_getsockopt_aux(getsockopt_fun_name[ty],
274 ty,
275 opt->level,
276 opt->option,
277 vsocket);
278 }
279
unix_setsockopt(value vty,value vsocket,value voption,value val)280 CAMLprim value unix_setsockopt(value vty, value vsocket, value voption,
281 value val)
282 {
283 enum option_type ty = Int_val(vty);
284 struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
285 return unix_setsockopt_aux(setsockopt_fun_name[ty],
286 ty,
287 opt->level,
288 opt->option,
289 vsocket,
290 val);
291 }
292
293 #else
294
unix_getsockopt(value vty,value socket,value option)295 CAMLprim value unix_getsockopt(value vty, value socket, value option)
296 { caml_invalid_argument("getsockopt not implemented"); }
297
unix_setsockopt(value vty,value socket,value option,value val)298 CAMLprim value unix_setsockopt(value vty, value socket, value option, value val)
299 { caml_invalid_argument("setsockopt not implemented"); }
300
301 #endif
302