Commit | Line | Data |
---|---|---|
3d8d56df | 1 | /* Copyright (C) 1996,1997 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> | |
0e958795 | 60 | #ifdef 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 | ||
370312ae | 69 | static SCM scm_sock_fd_to_port SCM_P ((int fd, char *proc)); |
82ddea4e | 70 | |
370312ae GH |
71 | static SCM |
72 | scm_sock_fd_to_port (fd, proc) | |
73 | int fd; | |
74 | char *proc; | |
0f2d19dd | 75 | { |
370312ae GH |
76 | SCM result; |
77 | FILE *f; | |
0f2d19dd | 78 | |
370312ae GH |
79 | if (fd == -1) |
80 | scm_syserror (proc); | |
81 | f = fdopen (fd, "r+"); | |
82 | if (!f) | |
83 | { | |
84 | SCM_SYSCALL (close (fd)); | |
85 | scm_syserror (proc); | |
86 | } | |
87 | SCM_NEWCELL (result); | |
88 | { | |
89 | struct scm_port_table *pt = scm_add_to_port_table (result); | |
90 | ||
91 | SCM_SETPTAB_ENTRY (result, pt); | |
92 | } | |
93 | SCM_SETCAR (result, scm_tc16_fport | scm_mode_bits ("r+0")); | |
94 | SCM_SETSTREAM (result, (SCM)f); | |
95 | scm_setbuf0 (result); | |
96 | return result; | |
97 | } | |
0f2d19dd | 98 | |
370312ae | 99 | SCM_PROC (s_socket, "socket", 3, 0, 0, scm_socket); |
1cc91f1b | 100 | |
0f2d19dd | 101 | SCM |
370312ae GH |
102 | scm_socket (family, style, proto) |
103 | SCM family; | |
104 | SCM style; | |
105 | SCM proto; | |
0f2d19dd | 106 | { |
370312ae GH |
107 | int fd; |
108 | SCM result; | |
109 | ||
110 | SCM_ASSERT (SCM_INUMP (family), family, SCM_ARG1, s_socket); | |
111 | SCM_ASSERT (SCM_INUMP (style), style, SCM_ARG2, s_socket); | |
112 | SCM_ASSERT (SCM_INUMP (proto), proto, SCM_ARG3, s_socket); | |
0f2d19dd | 113 | SCM_DEFER_INTS; |
370312ae GH |
114 | fd = socket (SCM_INUM (family), SCM_INUM (style), SCM_INUM (proto)); |
115 | result = scm_sock_fd_to_port (fd, s_socket); | |
0f2d19dd | 116 | SCM_ALLOW_INTS; |
370312ae | 117 | return result; |
0f2d19dd JB |
118 | } |
119 | ||
1cc91f1b | 120 | |
0f2d19dd | 121 | |
0e958795 | 122 | #ifdef HAVE_SOCKETPAIR |
370312ae | 123 | SCM_PROC (s_socketpair, "socketpair", 3, 0, 0, scm_socketpair); |
1cc91f1b | 124 | |
0f2d19dd | 125 | SCM |
370312ae GH |
126 | scm_socketpair (family, style, proto) |
127 | SCM family; | |
128 | SCM style; | |
129 | SCM proto; | |
0f2d19dd | 130 | { |
370312ae GH |
131 | int fam; |
132 | int fd[2]; | |
133 | SCM a; | |
134 | SCM b; | |
135 | ||
136 | SCM_ASSERT (SCM_INUMP (family), family, SCM_ARG1, s_socketpair); | |
137 | SCM_ASSERT (SCM_INUMP (style), style, SCM_ARG2, s_socketpair); | |
138 | SCM_ASSERT (SCM_INUMP (proto), proto, SCM_ARG3, s_socketpair); | |
139 | ||
140 | fam = SCM_INUM (family); | |
141 | ||
142 | SCM_DEFER_INTS; | |
143 | if (socketpair (fam, SCM_INUM (style), SCM_INUM (proto), fd) == -1) | |
144 | scm_syserror (s_socketpair); | |
145 | ||
146 | a = scm_sock_fd_to_port (fd[0], s_socketpair); | |
147 | b = scm_sock_fd_to_port (fd[1], s_socketpair); | |
148 | SCM_ALLOW_INTS; | |
149 | return scm_cons (a, b); | |
0f2d19dd | 150 | } |
0e958795 | 151 | #endif |
0f2d19dd | 152 | |
370312ae | 153 | SCM_PROC (s_getsockopt, "getsockopt", 3, 0, 0, scm_getsockopt); |
1cc91f1b | 154 | |
370312ae GH |
155 | SCM |
156 | scm_getsockopt (sock, level, optname) | |
157 | SCM sock; | |
158 | SCM level; | |
159 | SCM optname; | |
0f2d19dd | 160 | { |
370312ae GH |
161 | int fd; |
162 | int optlen; | |
163 | #ifdef HAVE_STRUCT_LINGER | |
164 | char optval[sizeof (struct linger)]; | |
165 | #else | |
166 | char optval[sizeof (scm_sizet)]; | |
167 | #endif | |
168 | int ilevel; | |
169 | int ioptname; | |
0f2d19dd | 170 | |
370312ae GH |
171 | #ifdef HAVE_STRUCT_LINGER |
172 | optlen = (int) sizeof (struct linger); | |
173 | #else | |
174 | optlen = (int) sizeof (scm_sizet); | |
175 | #endif | |
0f2d19dd | 176 | |
370312ae GH |
177 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, |
178 | s_getsockopt); | |
179 | SCM_ASSERT (SCM_INUMP (level), level, SCM_ARG2, s_getsockopt); | |
180 | SCM_ASSERT (SCM_INUMP (optname), optname, SCM_ARG3, s_getsockopt); | |
0f2d19dd | 181 | |
370312ae GH |
182 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
183 | ilevel = SCM_INUM (level); | |
184 | ioptname = SCM_INUM (optname); | |
185 | if (getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen) == -1) | |
186 | scm_syserror (s_getsockopt); | |
1cc91f1b | 187 | |
370312ae GH |
188 | #ifdef SO_LINGER |
189 | if (ilevel == SOL_SOCKET && ioptname == SO_LINGER) | |
0f2d19dd | 190 | { |
370312ae GH |
191 | #ifdef HAVE_STRUCT_LINGER |
192 | struct linger *ling = (struct linger *) optval; | |
193 | return scm_cons (SCM_MAKINUM (ling->l_onoff), | |
194 | SCM_MAKINUM (ling->l_linger)); | |
195 | #else | |
196 | scm_sizet *ling = (scm_sizet *) optval; | |
197 | return scm_cons (SCM_MAKINUM (*ling), | |
198 | SCM_MAKINUM (0)); | |
0f2d19dd | 199 | #endif |
0f2d19dd | 200 | } |
370312ae GH |
201 | #endif |
202 | #ifdef SO_SNDBUF | |
203 | if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF) | |
0f2d19dd | 204 | { |
370312ae GH |
205 | scm_sizet *bufsize = (scm_sizet *) optval; |
206 | return SCM_MAKINUM (*bufsize); | |
0f2d19dd | 207 | } |
370312ae GH |
208 | #endif |
209 | #ifdef SO_RCVBUF | |
210 | if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF) | |
0f2d19dd | 211 | { |
370312ae GH |
212 | scm_sizet *bufsize = (scm_sizet *) optval; |
213 | return SCM_MAKINUM (*bufsize); | |
0f2d19dd | 214 | } |
370312ae GH |
215 | #endif |
216 | return SCM_MAKINUM (*(int *) optval); | |
0f2d19dd JB |
217 | } |
218 | ||
370312ae | 219 | SCM_PROC (s_setsockopt, "setsockopt", 4, 0, 0, scm_setsockopt); |
0f2d19dd | 220 | |
370312ae GH |
221 | SCM |
222 | scm_setsockopt (sock, level, optname, value) | |
223 | SCM sock; | |
224 | SCM level; | |
225 | SCM optname; | |
226 | SCM value; | |
0f2d19dd | 227 | { |
370312ae GH |
228 | int fd; |
229 | int optlen; | |
230 | #ifdef HAVE_STRUCT_LINGER | |
231 | char optval[sizeof (struct linger)]; /* Biggest option :-( */ | |
232 | #else | |
233 | char optval[sizeof (scm_sizet)]; | |
234 | #endif | |
235 | int ilevel, ioptname; | |
236 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, | |
237 | s_setsockopt); | |
238 | SCM_ASSERT (SCM_INUMP (level), level, SCM_ARG2, s_setsockopt); | |
239 | SCM_ASSERT (SCM_INUMP (optname), optname, SCM_ARG3, s_setsockopt); | |
240 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
241 | ilevel = SCM_INUM (level); | |
242 | ioptname = SCM_INUM (optname); | |
243 | if (0); | |
244 | #ifdef SO_LINGER | |
245 | else if (ilevel == SOL_SOCKET && ioptname == SO_LINGER) | |
246 | { | |
247 | #ifdef HAVE_STRUCT_LINGER | |
248 | struct linger ling; | |
249 | SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) | |
250 | && SCM_INUMP (SCM_CAR (value)) | |
251 | && SCM_INUMP (SCM_CDR (value)), | |
252 | value, SCM_ARG4, s_setsockopt); | |
253 | ling.l_onoff = SCM_INUM (SCM_CAR (value)); | |
254 | ling.l_linger = SCM_INUM (SCM_CDR (value)); | |
255 | optlen = (int) sizeof (struct linger); | |
256 | memcpy (optval, (void *) &ling, optlen); | |
257 | #else | |
258 | scm_sizet ling; | |
259 | SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) | |
260 | && SCM_INUMP (SCM_CAR (value)) | |
261 | && SCM_INUMP (SCM_CDR (value)), | |
262 | value, SCM_ARG4, s_setsockopt); | |
263 | ling = SCM_INUM (SCM_CAR (value)); | |
264 | optlen = (int) sizeof (scm_sizet); | |
265 | (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); | |
266 | #endif | |
267 | } | |
268 | #endif | |
269 | #ifdef SO_SNDBUF | |
270 | else if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF) | |
0f2d19dd | 271 | { |
370312ae GH |
272 | SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); |
273 | optlen = (int) sizeof (scm_sizet); | |
274 | (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); | |
0f2d19dd | 275 | } |
370312ae GH |
276 | #endif |
277 | #ifdef SO_RCVBUF | |
278 | else if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF) | |
0f2d19dd | 279 | { |
370312ae GH |
280 | SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); |
281 | optlen = (int) sizeof (scm_sizet); | |
282 | (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); | |
0f2d19dd | 283 | } |
370312ae | 284 | #endif |
0f2d19dd JB |
285 | else |
286 | { | |
370312ae GH |
287 | /* Most options just take an int. */ |
288 | SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); | |
289 | optlen = (int) sizeof (int); | |
290 | (*(int *) optval) = (int) SCM_INUM (value); | |
0f2d19dd | 291 | } |
370312ae GH |
292 | if (setsockopt (fd, ilevel, ioptname, (void *) optval, optlen) == -1) |
293 | scm_syserror (s_setsockopt); | |
294 | return SCM_UNSPECIFIED; | |
0f2d19dd JB |
295 | } |
296 | ||
370312ae | 297 | SCM_PROC (s_shutdown, "shutdown", 2, 0, 0, scm_shutdown); |
1cc91f1b | 298 | |
0f2d19dd | 299 | SCM |
370312ae GH |
300 | scm_shutdown (sock, how) |
301 | SCM sock; | |
302 | SCM how; | |
0f2d19dd | 303 | { |
370312ae GH |
304 | int fd; |
305 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, | |
306 | s_shutdown); | |
307 | SCM_ASSERT (SCM_INUMP (how) && 0 <= SCM_INUM (how) && 2 >= SCM_INUM (how), | |
308 | how, SCM_ARG2, s_shutdown); | |
309 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
310 | if (shutdown (fd, SCM_INUM (how)) == -1) | |
311 | scm_syserror (s_shutdown); | |
312 | return SCM_UNSPECIFIED; | |
313 | } | |
0f2d19dd | 314 | |
370312ae GH |
315 | /* convert fam/address/args into a sockaddr of the appropriate type. |
316 | args is modified by removing the arguments actually used. | |
317 | which_arg and proc are used when reporting errors: | |
318 | which_arg is the position of address in the original argument list. | |
319 | proc is the name of the original procedure. | |
320 | size returns the size of the structure allocated. */ | |
321 | ||
322 | ||
323 | static struct sockaddr * scm_fill_sockaddr SCM_P ((int fam, SCM address, SCM *args, int which_arg, char *proc, scm_sizet *size)); | |
324 | ||
325 | static struct sockaddr * | |
326 | scm_fill_sockaddr (fam, address, args, which_arg, proc, size) | |
327 | int fam; | |
328 | SCM address; | |
329 | SCM *args; | |
330 | int which_arg; | |
331 | char *proc; | |
332 | scm_sizet *size; | |
333 | { | |
334 | switch (fam) | |
0f2d19dd | 335 | { |
370312ae GH |
336 | case AF_INET: |
337 | { | |
338 | SCM isport; | |
339 | struct sockaddr_in *soka; | |
340 | ||
341 | soka = (struct sockaddr_in *) | |
342 | scm_must_malloc (sizeof (struct sockaddr_in), proc); | |
343 | soka->sin_family = AF_INET; | |
344 | soka->sin_addr.s_addr = | |
345 | htonl (scm_num2ulong (address, (char *) which_arg, proc)); | |
346 | SCM_ASSERT (SCM_NIMP (*args) && SCM_CONSP (*args), *args, | |
347 | which_arg + 1, proc); | |
348 | isport = SCM_CAR (*args); | |
349 | *args = SCM_CDR (*args); | |
350 | SCM_ASSERT (SCM_INUMP (isport), isport, which_arg + 1, proc); | |
351 | soka->sin_port = htons (SCM_INUM (isport)); | |
352 | *size = sizeof (struct sockaddr_in); | |
353 | return (struct sockaddr *) soka; | |
354 | } | |
0e958795 | 355 | #ifdef UNIX_DOMAIN_SOCKETS |
370312ae GH |
356 | case AF_UNIX: |
357 | { | |
358 | struct sockaddr_un *soka; | |
359 | ||
360 | soka = (struct sockaddr_un *) | |
361 | scm_must_malloc (sizeof (struct sockaddr_un), proc); | |
362 | soka->sun_family = AF_UNIX; | |
ae2fa5bc GH |
363 | SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, |
364 | which_arg, proc); | |
365 | memcpy (soka->sun_path, SCM_ROCHARS (address), | |
366 | 1 + SCM_ROLENGTH (address)); | |
370312ae GH |
367 | *size = sizeof (struct sockaddr_un); |
368 | return (struct sockaddr *) soka; | |
369 | } | |
0e958795 | 370 | #endif |
370312ae GH |
371 | default: |
372 | scm_out_of_range (proc, SCM_MAKINUM (fam)); | |
0f2d19dd | 373 | } |
0f2d19dd | 374 | } |
370312ae GH |
375 | |
376 | SCM_PROC (s_connect, "connect", 3, 0, 1, scm_connect); | |
0f2d19dd | 377 | |
370312ae GH |
378 | SCM |
379 | scm_connect (sock, fam, address, args) | |
1cc91f1b | 380 | |
370312ae GH |
381 | SCM sock; |
382 | SCM fam; | |
383 | SCM address; | |
384 | SCM args; | |
0f2d19dd | 385 | { |
370312ae GH |
386 | int fd; |
387 | struct sockaddr *soka; | |
388 | scm_sizet size; | |
0f2d19dd | 389 | |
370312ae GH |
390 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_connect); |
391 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_connect); | |
392 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
393 | SCM_DEFER_INTS; | |
394 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_connect, &size); | |
395 | if (connect (fd, soka, size) == -1) | |
396 | scm_syserror (s_connect); | |
397 | scm_must_free ((char *) soka); | |
0f2d19dd | 398 | SCM_ALLOW_INTS; |
370312ae | 399 | return SCM_UNSPECIFIED; |
0f2d19dd JB |
400 | } |
401 | ||
370312ae | 402 | SCM_PROC (s_bind, "bind", 3, 0, 1, scm_bind); |
1cc91f1b | 403 | |
0f2d19dd | 404 | SCM |
370312ae GH |
405 | scm_bind (sock, fam, address, args) |
406 | SCM sock; | |
407 | SCM fam; | |
408 | SCM address; | |
409 | SCM args; | |
410 | { | |
411 | int rv; | |
412 | struct sockaddr *soka; | |
413 | scm_sizet size; | |
414 | int fd; | |
415 | ||
416 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_bind); | |
417 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_bind); | |
418 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_bind, &size); | |
419 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
420 | rv = bind (fd, soka, size); | |
421 | if (rv == -1) | |
422 | scm_syserror (s_bind); | |
423 | return SCM_UNSPECIFIED; | |
424 | } | |
425 | ||
426 | SCM_PROC (s_listen, "listen", 2, 0, 0, scm_listen); | |
427 | ||
428 | SCM | |
429 | scm_listen (sock, backlog) | |
430 | SCM sock; | |
431 | SCM backlog; | |
432 | { | |
433 | int fd; | |
434 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_listen); | |
435 | SCM_ASSERT (SCM_INUMP (backlog), backlog, SCM_ARG2, s_listen); | |
436 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
437 | if (listen (fd, SCM_INUM (backlog)) == -1) | |
438 | scm_syserror (s_listen); | |
439 | return SCM_UNSPECIFIED; | |
440 | } | |
441 | ||
442 | /* Put the components of a sockaddr into a new SCM vector. */ | |
443 | ||
444 | static SCM scm_addr_vector SCM_P ((struct sockaddr *address, char *proc)); | |
445 | ||
446 | static SCM | |
447 | scm_addr_vector (address, proc) | |
448 | struct sockaddr *address; | |
449 | char *proc; | |
0f2d19dd | 450 | { |
370312ae GH |
451 | short int fam = address->sa_family; |
452 | SCM result; | |
453 | SCM *ve; | |
0e958795 | 454 | #ifdef UNIX_DOMAIN_SOCKETS |
370312ae | 455 | if (fam == AF_UNIX) |
0f2d19dd | 456 | { |
370312ae GH |
457 | struct sockaddr_un *nad = (struct sockaddr_un *) address; |
458 | result = scm_make_vector (SCM_MAKINUM (2), SCM_UNSPECIFIED, SCM_BOOL_F); | |
459 | ve = SCM_VELTS (result); | |
460 | ve[0] = scm_ulong2num ((unsigned long) fam); | |
461 | ve[1] = scm_makfromstr (nad->sun_path, | |
462 | (scm_sizet) strlen (nad->sun_path), 0); | |
0f2d19dd | 463 | } |
0e958795 JB |
464 | else |
465 | #endif | |
466 | if (fam == AF_INET) | |
0f2d19dd | 467 | { |
370312ae GH |
468 | struct sockaddr_in *nad = (struct sockaddr_in *) address; |
469 | result = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED, SCM_BOOL_F); | |
470 | ve = SCM_VELTS (result); | |
471 | ve[0] = scm_ulong2num ((unsigned long) fam); | |
472 | ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); | |
473 | ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); | |
0f2d19dd JB |
474 | } |
475 | else | |
65b376c7 | 476 | scm_misc_error (proc, "Unrecognised address family: %s", |
d636d18c | 477 | scm_listify (SCM_MAKINUM (fam), SCM_UNDEFINED)); |
370312ae GH |
478 | |
479 | return result; | |
480 | } | |
481 | ||
482 | /* Allocate a buffer large enough to hold any sockaddr type. */ | |
483 | static char *scm_addr_buffer; | |
484 | static int scm_addr_buffer_size; | |
485 | ||
486 | static void scm_init_addr_buffer SCM_P ((void)); | |
487 | ||
488 | static void | |
489 | scm_init_addr_buffer () | |
490 | { | |
0e958795 JB |
491 | scm_addr_buffer_size = |
492 | #ifdef UNIX_DOMAIN_SOCKETS | |
493 | (int) sizeof (struct sockaddr_un) | |
494 | #else | |
495 | 0 | |
496 | #endif | |
497 | ; | |
370312ae GH |
498 | if (sizeof (struct sockaddr_in) > scm_addr_buffer_size) |
499 | scm_addr_buffer_size = (int) sizeof (struct sockaddr_in); | |
500 | scm_addr_buffer = scm_must_malloc (scm_addr_buffer_size, "address buffer"); | |
0f2d19dd JB |
501 | } |
502 | ||
370312ae | 503 | SCM_PROC (s_accept, "accept", 1, 0, 0, scm_accept); |
1cc91f1b | 504 | |
0f2d19dd | 505 | SCM |
370312ae GH |
506 | scm_accept (sock) |
507 | SCM sock; | |
0f2d19dd | 508 | { |
370312ae GH |
509 | int fd; |
510 | int newfd; | |
511 | SCM address; | |
512 | SCM newsock; | |
513 | ||
514 | int tmp_size; | |
515 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_accept); | |
516 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
517 | SCM_DEFER_INTS; | |
518 | tmp_size = scm_addr_buffer_size; | |
519 | newfd = accept (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size); | |
520 | newsock = scm_sock_fd_to_port (newfd, s_accept); | |
521 | if (tmp_size > 0) | |
522 | address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_accept); | |
0f2d19dd | 523 | else |
370312ae GH |
524 | address = SCM_BOOL_F; |
525 | ||
526 | SCM_ALLOW_INTS; | |
527 | return scm_cons (newsock, address); | |
0f2d19dd JB |
528 | } |
529 | ||
370312ae | 530 | SCM_PROC (s_getsockname, "getsockname", 1, 0, 0, scm_getsockname); |
1cc91f1b | 531 | |
0f2d19dd | 532 | SCM |
370312ae GH |
533 | scm_getsockname (sock) |
534 | SCM sock; | |
0f2d19dd | 535 | { |
370312ae GH |
536 | int tmp_size; |
537 | int fd; | |
538 | SCM result; | |
539 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getsockname); | |
540 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
541 | SCM_DEFER_INTS; | |
542 | tmp_size = scm_addr_buffer_size; | |
543 | if (getsockname (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) | |
544 | scm_syserror (s_getsockname); | |
545 | if (tmp_size > 0) | |
546 | result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getsockname); | |
0f2d19dd | 547 | else |
370312ae GH |
548 | result = SCM_BOOL_F; |
549 | SCM_ALLOW_INTS; | |
550 | return result; | |
0f2d19dd JB |
551 | } |
552 | ||
370312ae | 553 | SCM_PROC (s_getpeername, "getpeername", 1, 0, 0, scm_getpeername); |
1cc91f1b | 554 | |
0f2d19dd | 555 | SCM |
370312ae GH |
556 | scm_getpeername (sock) |
557 | SCM sock; | |
0f2d19dd | 558 | { |
370312ae GH |
559 | int tmp_size; |
560 | int fd; | |
561 | SCM result; | |
562 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getpeername); | |
563 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
564 | SCM_DEFER_INTS; | |
565 | tmp_size = scm_addr_buffer_size; | |
566 | if (getpeername (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) | |
567 | scm_syserror (s_getpeername); | |
568 | if (tmp_size > 0) | |
569 | result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getpeername); | |
0f2d19dd | 570 | else |
370312ae GH |
571 | result = SCM_BOOL_F; |
572 | SCM_ALLOW_INTS; | |
573 | return result; | |
0f2d19dd JB |
574 | } |
575 | ||
1146b6cd | 576 | SCM_PROC (s_recv, "recv!", 2, 1, 0, scm_recv); |
1cc91f1b | 577 | |
370312ae | 578 | SCM |
1146b6cd | 579 | scm_recv (sock, buf, flags) |
370312ae | 580 | SCM sock; |
1146b6cd | 581 | SCM buf; |
370312ae | 582 | SCM flags; |
0f2d19dd | 583 | { |
370312ae GH |
584 | int rv; |
585 | int fd; | |
586 | int flg; | |
370312ae GH |
587 | |
588 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_recv); | |
1146b6cd | 589 | SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recv); |
370312ae GH |
590 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
591 | ||
592 | if (SCM_UNBNDP (flags)) | |
593 | flg = 0; | |
594 | else | |
595 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recv); | |
596 | ||
1146b6cd | 597 | SCM_SYSCALL (rv = recv (fd, SCM_CHARS (buf), SCM_LENGTH (buf), flg)); |
370312ae GH |
598 | if (rv == -1) |
599 | scm_syserror (s_recv); | |
600 | ||
1146b6cd | 601 | return SCM_MAKINUM (rv); |
370312ae GH |
602 | } |
603 | ||
604 | SCM_PROC (s_send, "send", 2, 1, 0, scm_send); | |
605 | ||
606 | SCM | |
607 | scm_send (sock, message, flags) | |
608 | SCM sock; | |
609 | SCM message; | |
610 | SCM flags; | |
611 | { | |
612 | int rv; | |
613 | int fd; | |
614 | int flg; | |
615 | ||
616 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_send); | |
ae2fa5bc | 617 | SCM_ASSERT (SCM_NIMP (message) && SCM_ROSTRINGP (message), message, SCM_ARG2, s_send); |
370312ae GH |
618 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
619 | ||
620 | if (SCM_UNBNDP (flags)) | |
621 | flg = 0; | |
622 | else | |
623 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_send); | |
624 | ||
ae2fa5bc | 625 | SCM_SYSCALL (rv = send (fd, SCM_ROCHARS (message), SCM_ROLENGTH (message), flg)); |
370312ae GH |
626 | if (rv == -1) |
627 | scm_syserror (s_send); | |
628 | return SCM_MAKINUM (rv); | |
629 | } | |
630 | ||
1146b6cd | 631 | SCM_PROC (s_recvfrom, "recvfrom!", 2, 3, 0, scm_recvfrom); |
370312ae GH |
632 | |
633 | SCM | |
1146b6cd | 634 | scm_recvfrom (sock, buf, flags, start, end) |
370312ae | 635 | SCM sock; |
1146b6cd | 636 | SCM buf; |
370312ae | 637 | SCM flags; |
1146b6cd GH |
638 | SCM start; |
639 | SCM end; | |
370312ae GH |
640 | { |
641 | int rv; | |
642 | int fd; | |
643 | int flg; | |
1146b6cd GH |
644 | int offset = 0; |
645 | int cend; | |
370312ae GH |
646 | int tmp_size; |
647 | SCM address; | |
648 | ||
1146b6cd GH |
649 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, |
650 | s_recvfrom); | |
651 | SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recvfrom); | |
652 | cend = SCM_LENGTH (buf); | |
653 | ||
654 | if (SCM_UNBNDP (flags)) | |
655 | flg = 0; | |
370312ae GH |
656 | else |
657 | { | |
1146b6cd GH |
658 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom); |
659 | ||
660 | if (!SCM_UNBNDP (start)) | |
678b8532 | 661 | { |
1146b6cd GH |
662 | offset = (int) scm_num2long (start, |
663 | (char *) SCM_ARG4, s_recvfrom); | |
664 | ||
665 | if (offset < 0 || offset >= cend) | |
666 | scm_out_of_range (s_recvfrom, start); | |
667 | ||
668 | if (!SCM_UNBNDP (end)) | |
669 | { | |
670 | int tend = (int) scm_num2long (end, | |
671 | (char *) SCM_ARG5, s_recvfrom); | |
672 | ||
673 | if (tend <= offset || tend > cend) | |
674 | scm_out_of_range (s_recvfrom, end); | |
675 | ||
676 | cend = tend; | |
677 | } | |
678b8532 | 678 | } |
370312ae | 679 | } |
370312ae | 680 | |
1146b6cd | 681 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
370312ae GH |
682 | |
683 | tmp_size = scm_addr_buffer_size; | |
1146b6cd GH |
684 | SCM_SYSCALL (rv = recvfrom (fd, SCM_CHARS (buf) + offset, |
685 | cend - offset, flg, | |
686 | (struct sockaddr *) scm_addr_buffer, | |
687 | &tmp_size)); | |
370312ae GH |
688 | if (rv == -1) |
689 | scm_syserror (s_recvfrom); | |
690 | if (tmp_size > 0) | |
691 | address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_recvfrom); | |
692 | else | |
693 | address = SCM_BOOL_F; | |
694 | ||
1146b6cd | 695 | return scm_cons (SCM_MAKINUM (rv), address); |
0f2d19dd JB |
696 | } |
697 | ||
370312ae | 698 | SCM_PROC (s_sendto, "sendto", 4, 0, 1, scm_sendto); |
1cc91f1b | 699 | |
370312ae GH |
700 | SCM |
701 | scm_sendto (sock, message, fam, address, args_and_flags) | |
702 | SCM sock; | |
703 | SCM message; | |
704 | SCM fam; | |
705 | SCM address; | |
706 | SCM args_and_flags; | |
707 | { | |
708 | int rv; | |
709 | int fd; | |
710 | int flg; | |
711 | struct sockaddr *soka; | |
712 | scm_sizet size; | |
713 | ||
714 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_sendto); | |
ae2fa5bc GH |
715 | SCM_ASSERT (SCM_NIMP (message) && SCM_ROSTRINGP (message), message, |
716 | SCM_ARG2, s_sendto); | |
370312ae GH |
717 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG3, s_sendto); |
718 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
719 | SCM_DEFER_INTS; | |
720 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, | |
721 | s_sendto, &size); | |
722 | if (SCM_NULLP (args_and_flags)) | |
723 | flg = 0; | |
724 | else | |
725 | { | |
726 | SCM_ASSERT (SCM_NIMP (args_and_flags) && SCM_CONSP (args_and_flags), | |
727 | args_and_flags, SCM_ARG5, s_sendto); | |
728 | flg = scm_num2ulong (SCM_CAR (args_and_flags), (char *) SCM_ARG5, s_sendto); | |
729 | } | |
ae2fa5bc GH |
730 | SCM_SYSCALL (rv = sendto (fd, SCM_ROCHARS (message), SCM_ROLENGTH (message), |
731 | flg, soka, size)); | |
370312ae GH |
732 | if (rv == -1) |
733 | scm_syserror (s_sendto); | |
734 | scm_must_free ((char *) soka); | |
735 | SCM_ALLOW_INTS; | |
736 | return SCM_MAKINUM (rv); | |
737 | } | |
738 | \f | |
739 | ||
740 | ||
741 | void | |
0f2d19dd | 742 | scm_init_socket () |
0f2d19dd | 743 | { |
370312ae GH |
744 | /* protocol families. */ |
745 | #ifdef AF_UNSPEC | |
746 | scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC)); | |
747 | #endif | |
748 | #ifdef AF_UNIX | |
749 | scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX)); | |
750 | #endif | |
751 | #ifdef AF_INET | |
752 | scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET)); | |
753 | #endif | |
754 | ||
755 | #ifdef PF_UNSPEC | |
756 | scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC)); | |
757 | #endif | |
758 | #ifdef PF_UNIX | |
759 | scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX)); | |
760 | #endif | |
761 | #ifdef PF_INET | |
762 | scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET)); | |
763 | #endif | |
764 | ||
765 | /* socket types. */ | |
766 | #ifdef SOCK_STREAM | |
767 | scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM)); | |
768 | #endif | |
769 | #ifdef SOCK_DGRAM | |
770 | scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM)); | |
771 | #endif | |
772 | #ifdef SOCK_RAW | |
773 | scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW)); | |
774 | #endif | |
775 | ||
776 | /* setsockopt level. */ | |
777 | #ifdef SOL_SOCKET | |
778 | scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET)); | |
779 | #endif | |
780 | #ifdef SOL_IP | |
781 | scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP)); | |
782 | #endif | |
783 | #ifdef SOL_TCP | |
784 | scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP)); | |
785 | #endif | |
786 | #ifdef SOL_UDP | |
787 | scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP)); | |
788 | #endif | |
789 | ||
790 | /* setsockopt names. */ | |
791 | #ifdef SO_DEBUG | |
792 | scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG)); | |
793 | #endif | |
794 | #ifdef SO_REUSEADDR | |
795 | scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR)); | |
796 | #endif | |
797 | #ifdef SO_STYLE | |
798 | scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE)); | |
799 | #endif | |
800 | #ifdef SO_TYPE | |
801 | scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE)); | |
802 | #endif | |
803 | #ifdef SO_ERROR | |
804 | scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR)); | |
805 | #endif | |
806 | #ifdef SO_DONTROUTE | |
807 | scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE)); | |
808 | #endif | |
809 | #ifdef SO_BROADCAST | |
810 | scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST)); | |
811 | #endif | |
812 | #ifdef SO_SNDBUF | |
813 | scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF)); | |
814 | #endif | |
815 | #ifdef SO_RCVBUF | |
816 | scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF)); | |
817 | #endif | |
818 | #ifdef SO_KEEPALIVE | |
819 | scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE)); | |
820 | #endif | |
821 | #ifdef SO_OOBINLINE | |
822 | scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE)); | |
823 | #endif | |
824 | #ifdef SO_NO_CHECK | |
825 | scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK)); | |
826 | #endif | |
827 | #ifdef SO_PRIORITY | |
828 | scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY)); | |
829 | #endif | |
830 | #ifdef SO_LINGER | |
831 | scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER)); | |
832 | #endif | |
833 | ||
834 | /* recv/send options. */ | |
835 | #ifdef MSG_OOB | |
836 | scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB)); | |
837 | #endif | |
838 | #ifdef MSG_PEEK | |
839 | scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK)); | |
840 | #endif | |
841 | #ifdef MSG_DONTROUTE | |
842 | scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE)); | |
843 | #endif | |
844 | ||
0f2d19dd | 845 | scm_add_feature ("socket"); |
370312ae GH |
846 | scm_init_addr_buffer (); |
847 | ||
0f2d19dd JB |
848 | #include "socket.x" |
849 | } | |
850 |