Commit | Line | Data |
---|---|---|
7dc6e754 | 1 | /* Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. |
86667910 JB |
2 | * |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program is distributed in the hope that it will be useful, | |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
82892bed JB |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
16 | * Boston, MA 02111-1307 USA | |
86667910 JB |
17 | * |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
82892bed | 40 | * If you do not wish that, delete this exception notice. */ |
0f2d19dd JB |
41 | \f |
42 | ||
43 | #include <stdio.h> | |
370312ae | 44 | |
0f2d19dd | 45 | #include "_scm.h" |
370312ae | 46 | #include "unif.h" |
20e6290e | 47 | #include "feature.h" |
370312ae | 48 | #include "fports.h" |
20e6290e JB |
49 | |
50 | #include "socket.h" | |
95b88819 GH |
51 | |
52 | #ifdef HAVE_STRING_H | |
53 | #include <string.h> | |
54 | #endif | |
370312ae GH |
55 | #ifdef HAVE_UNISTD_H |
56 | #include <unistd.h> | |
57 | #endif | |
0f2d19dd JB |
58 | #include <sys/types.h> |
59 | #include <sys/socket.h> | |
1ba8c23a | 60 | #ifdef HAVE_UNIX_DOMAIN_SOCKETS |
0f2d19dd | 61 | #include <sys/un.h> |
0e958795 | 62 | #endif |
0f2d19dd JB |
63 | #include <netinet/in.h> |
64 | #include <netdb.h> | |
65 | #include <arpa/inet.h> | |
66 | ||
67 | \f | |
68 | ||
5c11cc9d GH |
69 | SCM_PROC (s_htons, "htons", 1, 0, 0, scm_htons); |
70 | SCM | |
71 | scm_htons (SCM in) | |
72 | { | |
73 | unsigned short c_in; | |
74 | ||
75 | SCM_ASSERT (SCM_INUMP (in), in, SCM_ARG1, s_htons); | |
76 | c_in = SCM_INUM (in); | |
77 | if (c_in != SCM_INUM (in)) | |
78 | scm_out_of_range (s_htons, in); | |
79 | ||
80 | return SCM_MAKINUM (htons (c_in)); | |
81 | } | |
82 | ||
83 | SCM_PROC (s_ntohs, "ntohs", 1, 0, 0, scm_ntohs); | |
84 | SCM | |
85 | scm_ntohs (SCM in) | |
86 | { | |
87 | unsigned short c_in; | |
88 | ||
89 | SCM_ASSERT (SCM_INUMP (in), in, SCM_ARG1, s_ntohs); | |
90 | c_in = SCM_INUM (in); | |
91 | if (c_in != SCM_INUM (in)) | |
92 | scm_out_of_range (s_ntohs, in); | |
93 | ||
94 | return SCM_MAKINUM (ntohs (c_in)); | |
95 | } | |
96 | ||
97 | SCM_PROC (s_htonl, "htonl", 1, 0, 0, scm_htonl); | |
98 | SCM | |
99 | scm_htonl (SCM in) | |
100 | { | |
101 | unsigned long c_in = scm_num2ulong (in, (char *) SCM_ARG1, s_htonl); | |
102 | ||
103 | return scm_ulong2num (htonl (c_in)); | |
104 | } | |
105 | ||
106 | SCM_PROC (s_ntohl, "ntohl", 1, 0, 0, scm_ntohl); | |
107 | SCM | |
108 | scm_ntohl (SCM in) | |
109 | { | |
110 | unsigned long c_in = scm_num2ulong (in, (char *) SCM_ARG1, s_ntohl); | |
111 | ||
112 | return scm_ulong2num (ntohl (c_in)); | |
113 | } | |
114 | ||
bc45012d | 115 | SCM_SYMBOL (sym_socket, "socket"); |
3eeba8d4 | 116 | static SCM scm_sock_fd_to_port SCM_P ((int fd, const char *proc)); |
82ddea4e | 117 | |
370312ae GH |
118 | static SCM |
119 | scm_sock_fd_to_port (fd, proc) | |
120 | int fd; | |
3eeba8d4 | 121 | const char *proc; |
0f2d19dd | 122 | { |
370312ae | 123 | SCM result; |
0f2d19dd | 124 | |
370312ae GH |
125 | if (fd == -1) |
126 | scm_syserror (proc); | |
ee149d03 | 127 | result = scm_fdes_to_port (fd, "r+0", sym_socket); |
370312ae GH |
128 | return result; |
129 | } | |
0f2d19dd | 130 | |
370312ae | 131 | SCM_PROC (s_socket, "socket", 3, 0, 0, scm_socket); |
1cc91f1b | 132 | |
0f2d19dd | 133 | SCM |
370312ae GH |
134 | scm_socket (family, style, proto) |
135 | SCM family; | |
136 | SCM style; | |
137 | SCM proto; | |
0f2d19dd | 138 | { |
370312ae GH |
139 | int fd; |
140 | SCM result; | |
141 | ||
142 | SCM_ASSERT (SCM_INUMP (family), family, SCM_ARG1, s_socket); | |
143 | SCM_ASSERT (SCM_INUMP (style), style, SCM_ARG2, s_socket); | |
144 | SCM_ASSERT (SCM_INUMP (proto), proto, SCM_ARG3, s_socket); | |
370312ae GH |
145 | fd = socket (SCM_INUM (family), SCM_INUM (style), SCM_INUM (proto)); |
146 | result = scm_sock_fd_to_port (fd, s_socket); | |
370312ae | 147 | return result; |
0f2d19dd JB |
148 | } |
149 | ||
1cc91f1b | 150 | |
0f2d19dd | 151 | |
0e958795 | 152 | #ifdef HAVE_SOCKETPAIR |
370312ae | 153 | SCM_PROC (s_socketpair, "socketpair", 3, 0, 0, scm_socketpair); |
1cc91f1b | 154 | |
0f2d19dd | 155 | SCM |
370312ae GH |
156 | scm_socketpair (family, style, proto) |
157 | SCM family; | |
158 | SCM style; | |
159 | SCM proto; | |
0f2d19dd | 160 | { |
370312ae GH |
161 | int fam; |
162 | int fd[2]; | |
163 | SCM a; | |
164 | SCM b; | |
165 | ||
166 | SCM_ASSERT (SCM_INUMP (family), family, SCM_ARG1, s_socketpair); | |
167 | SCM_ASSERT (SCM_INUMP (style), style, SCM_ARG2, s_socketpair); | |
168 | SCM_ASSERT (SCM_INUMP (proto), proto, SCM_ARG3, s_socketpair); | |
169 | ||
170 | fam = SCM_INUM (family); | |
171 | ||
370312ae GH |
172 | if (socketpair (fam, SCM_INUM (style), SCM_INUM (proto), fd) == -1) |
173 | scm_syserror (s_socketpair); | |
174 | ||
175 | a = scm_sock_fd_to_port (fd[0], s_socketpair); | |
176 | b = scm_sock_fd_to_port (fd[1], s_socketpair); | |
370312ae | 177 | return scm_cons (a, b); |
0f2d19dd | 178 | } |
0e958795 | 179 | #endif |
0f2d19dd | 180 | |
370312ae | 181 | SCM_PROC (s_getsockopt, "getsockopt", 3, 0, 0, scm_getsockopt); |
1cc91f1b | 182 | |
370312ae GH |
183 | SCM |
184 | scm_getsockopt (sock, level, optname) | |
185 | SCM sock; | |
186 | SCM level; | |
187 | SCM optname; | |
0f2d19dd | 188 | { |
370312ae GH |
189 | int fd; |
190 | int optlen; | |
191 | #ifdef HAVE_STRUCT_LINGER | |
192 | char optval[sizeof (struct linger)]; | |
193 | #else | |
194 | char optval[sizeof (scm_sizet)]; | |
195 | #endif | |
196 | int ilevel; | |
197 | int ioptname; | |
0f2d19dd | 198 | |
370312ae GH |
199 | #ifdef HAVE_STRUCT_LINGER |
200 | optlen = (int) sizeof (struct linger); | |
201 | #else | |
202 | optlen = (int) sizeof (scm_sizet); | |
203 | #endif | |
0f2d19dd | 204 | |
78446828 | 205 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 206 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, |
370312ae GH |
207 | s_getsockopt); |
208 | SCM_ASSERT (SCM_INUMP (level), level, SCM_ARG2, s_getsockopt); | |
209 | SCM_ASSERT (SCM_INUMP (optname), optname, SCM_ARG3, s_getsockopt); | |
0f2d19dd | 210 | |
ee149d03 | 211 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
212 | ilevel = SCM_INUM (level); |
213 | ioptname = SCM_INUM (optname); | |
214 | if (getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen) == -1) | |
215 | scm_syserror (s_getsockopt); | |
1cc91f1b | 216 | |
370312ae GH |
217 | #ifdef SO_LINGER |
218 | if (ilevel == SOL_SOCKET && ioptname == SO_LINGER) | |
0f2d19dd | 219 | { |
370312ae GH |
220 | #ifdef HAVE_STRUCT_LINGER |
221 | struct linger *ling = (struct linger *) optval; | |
222 | return scm_cons (SCM_MAKINUM (ling->l_onoff), | |
223 | SCM_MAKINUM (ling->l_linger)); | |
224 | #else | |
225 | scm_sizet *ling = (scm_sizet *) optval; | |
226 | return scm_cons (SCM_MAKINUM (*ling), | |
227 | SCM_MAKINUM (0)); | |
0f2d19dd | 228 | #endif |
0f2d19dd | 229 | } |
370312ae GH |
230 | #endif |
231 | #ifdef SO_SNDBUF | |
232 | if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF) | |
0f2d19dd | 233 | { |
370312ae GH |
234 | scm_sizet *bufsize = (scm_sizet *) optval; |
235 | return SCM_MAKINUM (*bufsize); | |
0f2d19dd | 236 | } |
370312ae GH |
237 | #endif |
238 | #ifdef SO_RCVBUF | |
239 | if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF) | |
0f2d19dd | 240 | { |
370312ae GH |
241 | scm_sizet *bufsize = (scm_sizet *) optval; |
242 | return SCM_MAKINUM (*bufsize); | |
0f2d19dd | 243 | } |
370312ae GH |
244 | #endif |
245 | return SCM_MAKINUM (*(int *) optval); | |
0f2d19dd JB |
246 | } |
247 | ||
370312ae | 248 | SCM_PROC (s_setsockopt, "setsockopt", 4, 0, 0, scm_setsockopt); |
0f2d19dd | 249 | |
370312ae GH |
250 | SCM |
251 | scm_setsockopt (sock, level, optname, value) | |
252 | SCM sock; | |
253 | SCM level; | |
254 | SCM optname; | |
255 | SCM value; | |
0f2d19dd | 256 | { |
370312ae GH |
257 | int fd; |
258 | int optlen; | |
259 | #ifdef HAVE_STRUCT_LINGER | |
260 | char optval[sizeof (struct linger)]; /* Biggest option :-( */ | |
261 | #else | |
262 | char optval[sizeof (scm_sizet)]; | |
263 | #endif | |
264 | int ilevel, ioptname; | |
78446828 | 265 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 266 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, |
370312ae GH |
267 | s_setsockopt); |
268 | SCM_ASSERT (SCM_INUMP (level), level, SCM_ARG2, s_setsockopt); | |
269 | SCM_ASSERT (SCM_INUMP (optname), optname, SCM_ARG3, s_setsockopt); | |
ee149d03 | 270 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
271 | ilevel = SCM_INUM (level); |
272 | ioptname = SCM_INUM (optname); | |
273 | if (0); | |
274 | #ifdef SO_LINGER | |
275 | else if (ilevel == SOL_SOCKET && ioptname == SO_LINGER) | |
276 | { | |
277 | #ifdef HAVE_STRUCT_LINGER | |
278 | struct linger ling; | |
279 | SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) | |
280 | && SCM_INUMP (SCM_CAR (value)) | |
281 | && SCM_INUMP (SCM_CDR (value)), | |
282 | value, SCM_ARG4, s_setsockopt); | |
283 | ling.l_onoff = SCM_INUM (SCM_CAR (value)); | |
284 | ling.l_linger = SCM_INUM (SCM_CDR (value)); | |
285 | optlen = (int) sizeof (struct linger); | |
286 | memcpy (optval, (void *) &ling, optlen); | |
287 | #else | |
288 | scm_sizet ling; | |
289 | SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) | |
290 | && SCM_INUMP (SCM_CAR (value)) | |
291 | && SCM_INUMP (SCM_CDR (value)), | |
292 | value, SCM_ARG4, s_setsockopt); | |
293 | ling = SCM_INUM (SCM_CAR (value)); | |
294 | optlen = (int) sizeof (scm_sizet); | |
295 | (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); | |
296 | #endif | |
297 | } | |
298 | #endif | |
299 | #ifdef SO_SNDBUF | |
300 | else if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF) | |
0f2d19dd | 301 | { |
370312ae GH |
302 | SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); |
303 | optlen = (int) sizeof (scm_sizet); | |
304 | (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); | |
0f2d19dd | 305 | } |
370312ae GH |
306 | #endif |
307 | #ifdef SO_RCVBUF | |
308 | else if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF) | |
0f2d19dd | 309 | { |
370312ae GH |
310 | SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); |
311 | optlen = (int) sizeof (scm_sizet); | |
312 | (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); | |
0f2d19dd | 313 | } |
370312ae | 314 | #endif |
0f2d19dd JB |
315 | else |
316 | { | |
370312ae GH |
317 | /* Most options just take an int. */ |
318 | SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); | |
319 | optlen = (int) sizeof (int); | |
320 | (*(int *) optval) = (int) SCM_INUM (value); | |
0f2d19dd | 321 | } |
370312ae GH |
322 | if (setsockopt (fd, ilevel, ioptname, (void *) optval, optlen) == -1) |
323 | scm_syserror (s_setsockopt); | |
324 | return SCM_UNSPECIFIED; | |
0f2d19dd JB |
325 | } |
326 | ||
370312ae | 327 | SCM_PROC (s_shutdown, "shutdown", 2, 0, 0, scm_shutdown); |
1cc91f1b | 328 | |
0f2d19dd | 329 | SCM |
370312ae GH |
330 | scm_shutdown (sock, how) |
331 | SCM sock; | |
332 | SCM how; | |
0f2d19dd | 333 | { |
370312ae | 334 | int fd; |
78446828 | 335 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 336 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, |
370312ae GH |
337 | s_shutdown); |
338 | SCM_ASSERT (SCM_INUMP (how) && 0 <= SCM_INUM (how) && 2 >= SCM_INUM (how), | |
339 | how, SCM_ARG2, s_shutdown); | |
ee149d03 | 340 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
341 | if (shutdown (fd, SCM_INUM (how)) == -1) |
342 | scm_syserror (s_shutdown); | |
343 | return SCM_UNSPECIFIED; | |
344 | } | |
0f2d19dd | 345 | |
370312ae GH |
346 | /* convert fam/address/args into a sockaddr of the appropriate type. |
347 | args is modified by removing the arguments actually used. | |
348 | which_arg and proc are used when reporting errors: | |
349 | which_arg is the position of address in the original argument list. | |
350 | proc is the name of the original procedure. | |
351 | size returns the size of the structure allocated. */ | |
352 | ||
353 | ||
3eeba8d4 | 354 | static struct sockaddr * scm_fill_sockaddr SCM_P ((int fam, SCM address, SCM *args, int which_arg, const char *proc, scm_sizet *size)); |
370312ae GH |
355 | |
356 | static struct sockaddr * | |
357 | scm_fill_sockaddr (fam, address, args, which_arg, proc, size) | |
358 | int fam; | |
359 | SCM address; | |
360 | SCM *args; | |
361 | int which_arg; | |
3eeba8d4 | 362 | const char *proc; |
370312ae GH |
363 | scm_sizet *size; |
364 | { | |
365 | switch (fam) | |
0f2d19dd | 366 | { |
370312ae GH |
367 | case AF_INET: |
368 | { | |
369 | SCM isport; | |
370 | struct sockaddr_in *soka; | |
371 | ||
372 | soka = (struct sockaddr_in *) | |
373 | scm_must_malloc (sizeof (struct sockaddr_in), proc); | |
93a6b6f5 GH |
374 | /* e.g., for BSDs which don't like invalid sin_len. */ |
375 | memset (soka, 0, sizeof (struct sockaddr_in)); | |
370312ae GH |
376 | soka->sin_family = AF_INET; |
377 | soka->sin_addr.s_addr = | |
378 | htonl (scm_num2ulong (address, (char *) which_arg, proc)); | |
379 | SCM_ASSERT (SCM_NIMP (*args) && SCM_CONSP (*args), *args, | |
380 | which_arg + 1, proc); | |
381 | isport = SCM_CAR (*args); | |
382 | *args = SCM_CDR (*args); | |
383 | SCM_ASSERT (SCM_INUMP (isport), isport, which_arg + 1, proc); | |
384 | soka->sin_port = htons (SCM_INUM (isport)); | |
385 | *size = sizeof (struct sockaddr_in); | |
386 | return (struct sockaddr *) soka; | |
387 | } | |
1ba8c23a | 388 | #ifdef HAVE_UNIX_DOMAIN_SOCKETS |
370312ae GH |
389 | case AF_UNIX: |
390 | { | |
391 | struct sockaddr_un *soka; | |
392 | ||
393 | soka = (struct sockaddr_un *) | |
394 | scm_must_malloc (sizeof (struct sockaddr_un), proc); | |
93a6b6f5 | 395 | memset (soka, 0, sizeof (struct sockaddr_un)); |
370312ae | 396 | soka->sun_family = AF_UNIX; |
ae2fa5bc GH |
397 | SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, |
398 | which_arg, proc); | |
399 | memcpy (soka->sun_path, SCM_ROCHARS (address), | |
400 | 1 + SCM_ROLENGTH (address)); | |
370312ae GH |
401 | *size = sizeof (struct sockaddr_un); |
402 | return (struct sockaddr *) soka; | |
403 | } | |
0e958795 | 404 | #endif |
370312ae GH |
405 | default: |
406 | scm_out_of_range (proc, SCM_MAKINUM (fam)); | |
0f2d19dd | 407 | } |
0f2d19dd | 408 | } |
370312ae GH |
409 | |
410 | SCM_PROC (s_connect, "connect", 3, 0, 1, scm_connect); | |
0f2d19dd | 411 | |
370312ae GH |
412 | SCM |
413 | scm_connect (sock, fam, address, args) | |
1cc91f1b | 414 | |
370312ae GH |
415 | SCM sock; |
416 | SCM fam; | |
417 | SCM address; | |
418 | SCM args; | |
0f2d19dd | 419 | { |
370312ae GH |
420 | int fd; |
421 | struct sockaddr *soka; | |
422 | scm_sizet size; | |
0f2d19dd | 423 | |
78446828 | 424 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 425 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_connect); |
370312ae | 426 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_connect); |
ee149d03 | 427 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
428 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_connect, &size); |
429 | if (connect (fd, soka, size) == -1) | |
430 | scm_syserror (s_connect); | |
431 | scm_must_free ((char *) soka); | |
370312ae | 432 | return SCM_UNSPECIFIED; |
0f2d19dd JB |
433 | } |
434 | ||
370312ae | 435 | SCM_PROC (s_bind, "bind", 3, 0, 1, scm_bind); |
1cc91f1b | 436 | |
0f2d19dd | 437 | SCM |
370312ae GH |
438 | scm_bind (sock, fam, address, args) |
439 | SCM sock; | |
440 | SCM fam; | |
441 | SCM address; | |
442 | SCM args; | |
443 | { | |
444 | int rv; | |
445 | struct sockaddr *soka; | |
446 | scm_sizet size; | |
447 | int fd; | |
448 | ||
78446828 | 449 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 450 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_bind); |
370312ae GH |
451 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_bind); |
452 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_bind, &size); | |
ee149d03 | 453 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
454 | rv = bind (fd, soka, size); |
455 | if (rv == -1) | |
456 | scm_syserror (s_bind); | |
ef9ff3fd | 457 | scm_must_free ((char *) soka); |
370312ae GH |
458 | return SCM_UNSPECIFIED; |
459 | } | |
460 | ||
461 | SCM_PROC (s_listen, "listen", 2, 0, 0, scm_listen); | |
462 | ||
463 | SCM | |
464 | scm_listen (sock, backlog) | |
465 | SCM sock; | |
466 | SCM backlog; | |
467 | { | |
468 | int fd; | |
78446828 | 469 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 470 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_listen); |
370312ae | 471 | SCM_ASSERT (SCM_INUMP (backlog), backlog, SCM_ARG2, s_listen); |
ee149d03 | 472 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
473 | if (listen (fd, SCM_INUM (backlog)) == -1) |
474 | scm_syserror (s_listen); | |
475 | return SCM_UNSPECIFIED; | |
476 | } | |
477 | ||
478 | /* Put the components of a sockaddr into a new SCM vector. */ | |
479 | ||
3eeba8d4 | 480 | static SCM scm_addr_vector SCM_P ((struct sockaddr *address, const char *proc)); |
370312ae GH |
481 | |
482 | static SCM | |
483 | scm_addr_vector (address, proc) | |
484 | struct sockaddr *address; | |
3eeba8d4 | 485 | const char *proc; |
0f2d19dd | 486 | { |
370312ae GH |
487 | short int fam = address->sa_family; |
488 | SCM result; | |
489 | SCM *ve; | |
1ba8c23a | 490 | #ifdef HAVE_UNIX_DOMAIN_SOCKETS |
370312ae | 491 | if (fam == AF_UNIX) |
0f2d19dd | 492 | { |
370312ae | 493 | struct sockaddr_un *nad = (struct sockaddr_un *) address; |
a8741caa | 494 | result = scm_make_vector (SCM_MAKINUM (2), SCM_UNSPECIFIED); |
370312ae GH |
495 | ve = SCM_VELTS (result); |
496 | ve[0] = scm_ulong2num ((unsigned long) fam); | |
497 | ve[1] = scm_makfromstr (nad->sun_path, | |
498 | (scm_sizet) strlen (nad->sun_path), 0); | |
0f2d19dd | 499 | } |
0e958795 JB |
500 | else |
501 | #endif | |
502 | if (fam == AF_INET) | |
0f2d19dd | 503 | { |
370312ae | 504 | struct sockaddr_in *nad = (struct sockaddr_in *) address; |
a8741caa | 505 | result = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED); |
370312ae GH |
506 | ve = SCM_VELTS (result); |
507 | ve[0] = scm_ulong2num ((unsigned long) fam); | |
508 | ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); | |
509 | ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); | |
0f2d19dd JB |
510 | } |
511 | else | |
65b376c7 | 512 | scm_misc_error (proc, "Unrecognised address family: %s", |
d636d18c | 513 | scm_listify (SCM_MAKINUM (fam), SCM_UNDEFINED)); |
370312ae GH |
514 | |
515 | return result; | |
516 | } | |
517 | ||
518 | /* Allocate a buffer large enough to hold any sockaddr type. */ | |
519 | static char *scm_addr_buffer; | |
520 | static int scm_addr_buffer_size; | |
521 | ||
522 | static void scm_init_addr_buffer SCM_P ((void)); | |
523 | ||
524 | static void | |
525 | scm_init_addr_buffer () | |
526 | { | |
0e958795 | 527 | scm_addr_buffer_size = |
1ba8c23a | 528 | #ifdef HAVE_UNIX_DOMAIN_SOCKETS |
0e958795 JB |
529 | (int) sizeof (struct sockaddr_un) |
530 | #else | |
531 | 0 | |
532 | #endif | |
533 | ; | |
370312ae GH |
534 | if (sizeof (struct sockaddr_in) > scm_addr_buffer_size) |
535 | scm_addr_buffer_size = (int) sizeof (struct sockaddr_in); | |
536 | scm_addr_buffer = scm_must_malloc (scm_addr_buffer_size, "address buffer"); | |
0f2d19dd JB |
537 | } |
538 | ||
370312ae | 539 | SCM_PROC (s_accept, "accept", 1, 0, 0, scm_accept); |
1cc91f1b | 540 | |
0f2d19dd | 541 | SCM |
370312ae GH |
542 | scm_accept (sock) |
543 | SCM sock; | |
0f2d19dd | 544 | { |
370312ae GH |
545 | int fd; |
546 | int newfd; | |
547 | SCM address; | |
548 | SCM newsock; | |
549 | ||
550 | int tmp_size; | |
78446828 | 551 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 JB |
552 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_accept); |
553 | fd = SCM_FPORT_FDES (sock); | |
370312ae GH |
554 | tmp_size = scm_addr_buffer_size; |
555 | newfd = accept (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size); | |
556 | newsock = scm_sock_fd_to_port (newfd, s_accept); | |
557 | if (tmp_size > 0) | |
558 | address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_accept); | |
0f2d19dd | 559 | else |
370312ae GH |
560 | address = SCM_BOOL_F; |
561 | ||
370312ae | 562 | return scm_cons (newsock, address); |
0f2d19dd JB |
563 | } |
564 | ||
370312ae | 565 | SCM_PROC (s_getsockname, "getsockname", 1, 0, 0, scm_getsockname); |
1cc91f1b | 566 | |
0f2d19dd | 567 | SCM |
370312ae GH |
568 | scm_getsockname (sock) |
569 | SCM sock; | |
0f2d19dd | 570 | { |
370312ae GH |
571 | int tmp_size; |
572 | int fd; | |
573 | SCM result; | |
78446828 | 574 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 JB |
575 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_getsockname); |
576 | fd = SCM_FPORT_FDES (sock); | |
370312ae GH |
577 | tmp_size = scm_addr_buffer_size; |
578 | if (getsockname (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) | |
579 | scm_syserror (s_getsockname); | |
580 | if (tmp_size > 0) | |
581 | result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getsockname); | |
0f2d19dd | 582 | else |
370312ae | 583 | result = SCM_BOOL_F; |
370312ae | 584 | return result; |
0f2d19dd JB |
585 | } |
586 | ||
370312ae | 587 | SCM_PROC (s_getpeername, "getpeername", 1, 0, 0, scm_getpeername); |
1cc91f1b | 588 | |
0f2d19dd | 589 | SCM |
370312ae GH |
590 | scm_getpeername (sock) |
591 | SCM sock; | |
0f2d19dd | 592 | { |
370312ae GH |
593 | int tmp_size; |
594 | int fd; | |
595 | SCM result; | |
78446828 | 596 | sock = SCM_COERCE_OUTPORT (sock); |
370312ae | 597 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getpeername); |
ee149d03 | 598 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
599 | tmp_size = scm_addr_buffer_size; |
600 | if (getpeername (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) | |
601 | scm_syserror (s_getpeername); | |
602 | if (tmp_size > 0) | |
603 | result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getpeername); | |
0f2d19dd | 604 | else |
370312ae | 605 | result = SCM_BOOL_F; |
370312ae | 606 | return result; |
0f2d19dd JB |
607 | } |
608 | ||
1146b6cd | 609 | SCM_PROC (s_recv, "recv!", 2, 1, 0, scm_recv); |
1cc91f1b | 610 | |
370312ae | 611 | SCM |
1146b6cd | 612 | scm_recv (sock, buf, flags) |
370312ae | 613 | SCM sock; |
1146b6cd | 614 | SCM buf; |
370312ae | 615 | SCM flags; |
0f2d19dd | 616 | { |
370312ae GH |
617 | int rv; |
618 | int fd; | |
619 | int flg; | |
370312ae | 620 | |
ee149d03 | 621 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_recv); |
1146b6cd | 622 | SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recv); |
370312ae | 623 | |
ee149d03 | 624 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
625 | if (SCM_UNBNDP (flags)) |
626 | flg = 0; | |
627 | else | |
628 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recv); | |
629 | ||
1146b6cd | 630 | SCM_SYSCALL (rv = recv (fd, SCM_CHARS (buf), SCM_LENGTH (buf), flg)); |
370312ae GH |
631 | if (rv == -1) |
632 | scm_syserror (s_recv); | |
633 | ||
1146b6cd | 634 | return SCM_MAKINUM (rv); |
370312ae GH |
635 | } |
636 | ||
637 | SCM_PROC (s_send, "send", 2, 1, 0, scm_send); | |
638 | ||
639 | SCM | |
640 | scm_send (sock, message, flags) | |
641 | SCM sock; | |
642 | SCM message; | |
643 | SCM flags; | |
644 | { | |
645 | int rv; | |
646 | int fd; | |
647 | int flg; | |
648 | ||
78446828 | 649 | sock = SCM_COERCE_OUTPORT (sock); |
ee149d03 | 650 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, s_send); |
ae2fa5bc | 651 | SCM_ASSERT (SCM_NIMP (message) && SCM_ROSTRINGP (message), message, SCM_ARG2, s_send); |
370312ae | 652 | |
ee149d03 | 653 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
654 | if (SCM_UNBNDP (flags)) |
655 | flg = 0; | |
656 | else | |
657 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_send); | |
658 | ||
ae2fa5bc | 659 | SCM_SYSCALL (rv = send (fd, SCM_ROCHARS (message), SCM_ROLENGTH (message), flg)); |
370312ae GH |
660 | if (rv == -1) |
661 | scm_syserror (s_send); | |
662 | return SCM_MAKINUM (rv); | |
663 | } | |
664 | ||
1146b6cd | 665 | SCM_PROC (s_recvfrom, "recvfrom!", 2, 3, 0, scm_recvfrom); |
370312ae GH |
666 | |
667 | SCM | |
1146b6cd | 668 | scm_recvfrom (sock, buf, flags, start, end) |
370312ae | 669 | SCM sock; |
1146b6cd | 670 | SCM buf; |
370312ae | 671 | SCM flags; |
1146b6cd GH |
672 | SCM start; |
673 | SCM end; | |
370312ae GH |
674 | { |
675 | int rv; | |
676 | int fd; | |
677 | int flg; | |
1146b6cd GH |
678 | int offset = 0; |
679 | int cend; | |
370312ae GH |
680 | int tmp_size; |
681 | SCM address; | |
682 | ||
ee149d03 | 683 | SCM_ASSERT (SCM_NIMP (sock) && SCM_OPFPORTP (sock), sock, SCM_ARG1, |
1146b6cd GH |
684 | s_recvfrom); |
685 | SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recvfrom); | |
686 | cend = SCM_LENGTH (buf); | |
687 | ||
688 | if (SCM_UNBNDP (flags)) | |
689 | flg = 0; | |
370312ae GH |
690 | else |
691 | { | |
1146b6cd GH |
692 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom); |
693 | ||
694 | if (!SCM_UNBNDP (start)) | |
678b8532 | 695 | { |
1146b6cd GH |
696 | offset = (int) scm_num2long (start, |
697 | (char *) SCM_ARG4, s_recvfrom); | |
698 | ||
699 | if (offset < 0 || offset >= cend) | |
700 | scm_out_of_range (s_recvfrom, start); | |
701 | ||
702 | if (!SCM_UNBNDP (end)) | |
703 | { | |
704 | int tend = (int) scm_num2long (end, | |
705 | (char *) SCM_ARG5, s_recvfrom); | |
706 | ||
707 | if (tend <= offset || tend > cend) | |
708 | scm_out_of_range (s_recvfrom, end); | |
709 | ||
710 | cend = tend; | |
711 | } | |
678b8532 | 712 | } |
370312ae | 713 | } |
370312ae | 714 | |
ee149d03 | 715 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
716 | |
717 | tmp_size = scm_addr_buffer_size; | |
1146b6cd GH |
718 | SCM_SYSCALL (rv = recvfrom (fd, SCM_CHARS (buf) + offset, |
719 | cend - offset, flg, | |
720 | (struct sockaddr *) scm_addr_buffer, | |
721 | &tmp_size)); | |
370312ae GH |
722 | if (rv == -1) |
723 | scm_syserror (s_recvfrom); | |
724 | if (tmp_size > 0) | |
725 | address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_recvfrom); | |
726 | else | |
727 | address = SCM_BOOL_F; | |
728 | ||
1146b6cd | 729 | return scm_cons (SCM_MAKINUM (rv), address); |
0f2d19dd JB |
730 | } |
731 | ||
370312ae | 732 | SCM_PROC (s_sendto, "sendto", 4, 0, 1, scm_sendto); |
1cc91f1b | 733 | |
370312ae GH |
734 | SCM |
735 | scm_sendto (sock, message, fam, address, args_and_flags) | |
736 | SCM sock; | |
737 | SCM message; | |
738 | SCM fam; | |
739 | SCM address; | |
740 | SCM args_and_flags; | |
741 | { | |
742 | int rv; | |
743 | int fd; | |
744 | int flg; | |
745 | struct sockaddr *soka; | |
746 | scm_sizet size; | |
ee149d03 | 747 | int save_err; |
370312ae | 748 | |
78446828 | 749 | sock = SCM_COERCE_OUTPORT (sock); |
370312ae | 750 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_sendto); |
ae2fa5bc GH |
751 | SCM_ASSERT (SCM_NIMP (message) && SCM_ROSTRINGP (message), message, |
752 | SCM_ARG2, s_sendto); | |
370312ae | 753 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG3, s_sendto); |
ee149d03 | 754 | fd = SCM_FPORT_FDES (sock); |
370312ae GH |
755 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, |
756 | s_sendto, &size); | |
757 | if (SCM_NULLP (args_and_flags)) | |
758 | flg = 0; | |
759 | else | |
760 | { | |
761 | SCM_ASSERT (SCM_NIMP (args_and_flags) && SCM_CONSP (args_and_flags), | |
762 | args_and_flags, SCM_ARG5, s_sendto); | |
763 | flg = scm_num2ulong (SCM_CAR (args_and_flags), (char *) SCM_ARG5, s_sendto); | |
764 | } | |
ae2fa5bc GH |
765 | SCM_SYSCALL (rv = sendto (fd, SCM_ROCHARS (message), SCM_ROLENGTH (message), |
766 | flg, soka, size)); | |
ee149d03 JB |
767 | save_err = errno; |
768 | scm_must_free ((char *) soka); | |
769 | errno = save_err; | |
370312ae GH |
770 | if (rv == -1) |
771 | scm_syserror (s_sendto); | |
370312ae GH |
772 | return SCM_MAKINUM (rv); |
773 | } | |
774 | \f | |
775 | ||
776 | ||
777 | void | |
0f2d19dd | 778 | scm_init_socket () |
0f2d19dd | 779 | { |
370312ae GH |
780 | /* protocol families. */ |
781 | #ifdef AF_UNSPEC | |
782 | scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC)); | |
783 | #endif | |
784 | #ifdef AF_UNIX | |
785 | scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX)); | |
786 | #endif | |
787 | #ifdef AF_INET | |
788 | scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET)); | |
789 | #endif | |
790 | ||
791 | #ifdef PF_UNSPEC | |
792 | scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC)); | |
793 | #endif | |
794 | #ifdef PF_UNIX | |
795 | scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX)); | |
796 | #endif | |
797 | #ifdef PF_INET | |
798 | scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET)); | |
799 | #endif | |
800 | ||
801 | /* socket types. */ | |
802 | #ifdef SOCK_STREAM | |
803 | scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM)); | |
804 | #endif | |
805 | #ifdef SOCK_DGRAM | |
806 | scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM)); | |
807 | #endif | |
808 | #ifdef SOCK_RAW | |
809 | scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW)); | |
810 | #endif | |
811 | ||
812 | /* setsockopt level. */ | |
813 | #ifdef SOL_SOCKET | |
814 | scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET)); | |
815 | #endif | |
816 | #ifdef SOL_IP | |
817 | scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP)); | |
818 | #endif | |
819 | #ifdef SOL_TCP | |
820 | scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP)); | |
821 | #endif | |
822 | #ifdef SOL_UDP | |
823 | scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP)); | |
824 | #endif | |
825 | ||
826 | /* setsockopt names. */ | |
827 | #ifdef SO_DEBUG | |
828 | scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG)); | |
829 | #endif | |
830 | #ifdef SO_REUSEADDR | |
831 | scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR)); | |
832 | #endif | |
833 | #ifdef SO_STYLE | |
834 | scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE)); | |
835 | #endif | |
836 | #ifdef SO_TYPE | |
837 | scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE)); | |
838 | #endif | |
839 | #ifdef SO_ERROR | |
840 | scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR)); | |
841 | #endif | |
842 | #ifdef SO_DONTROUTE | |
843 | scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE)); | |
844 | #endif | |
845 | #ifdef SO_BROADCAST | |
846 | scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST)); | |
847 | #endif | |
848 | #ifdef SO_SNDBUF | |
849 | scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF)); | |
850 | #endif | |
851 | #ifdef SO_RCVBUF | |
852 | scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF)); | |
853 | #endif | |
854 | #ifdef SO_KEEPALIVE | |
855 | scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE)); | |
856 | #endif | |
857 | #ifdef SO_OOBINLINE | |
858 | scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE)); | |
859 | #endif | |
860 | #ifdef SO_NO_CHECK | |
861 | scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK)); | |
862 | #endif | |
863 | #ifdef SO_PRIORITY | |
864 | scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY)); | |
865 | #endif | |
866 | #ifdef SO_LINGER | |
867 | scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER)); | |
868 | #endif | |
869 | ||
870 | /* recv/send options. */ | |
871 | #ifdef MSG_OOB | |
872 | scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB)); | |
873 | #endif | |
874 | #ifdef MSG_PEEK | |
875 | scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK)); | |
876 | #endif | |
877 | #ifdef MSG_DONTROUTE | |
878 | scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE)); | |
879 | #endif | |
880 | ||
0f2d19dd | 881 | scm_add_feature ("socket"); |
370312ae GH |
882 | scm_init_addr_buffer (); |
883 | ||
0f2d19dd JB |
884 | #include "socket.x" |
885 | } | |
886 |