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