* hashtab.h: Bugfix: use SCM_API (WAS: extern).
[bpt/guile.git] / libguile / socket.c
1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
7 *
8 * This library 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 GNU
11 * Lesser General Public License for more details.
12 *
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
16 */
17
18
19 \f
20
21 #if HAVE_CONFIG_H
22 # include <config.h>
23 #endif
24
25 #include <errno.h>
26 #include <gmp.h>
27
28 #include "libguile/_scm.h"
29 #include "libguile/unif.h"
30 #include "libguile/feature.h"
31 #include "libguile/fports.h"
32 #include "libguile/strings.h"
33 #include "libguile/vectors.h"
34 #include "libguile/dynwind.h"
35
36 #include "libguile/validate.h"
37 #include "libguile/socket.h"
38
39 #ifdef __MINGW32__
40 #include "win32-socket.h"
41 #endif
42
43 #ifdef HAVE_STDINT_H
44 #include <stdint.h>
45 #endif
46 #ifdef HAVE_STRING_H
47 #include <string.h>
48 #endif
49 #ifdef HAVE_UNISTD_H
50 #include <unistd.h>
51 #endif
52 #include <sys/types.h>
53 #ifdef HAVE_WINSOCK2_H
54 #include <winsock2.h>
55 #else
56 #include <sys/socket.h>
57 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
58 #include <sys/un.h>
59 #endif
60 #include <netinet/in.h>
61 #include <netdb.h>
62 #include <arpa/inet.h>
63 #endif
64
65 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
66 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
67 + strlen ((ptr)->sun_path))
68 #endif
69
70 \f
71
72 SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
73 (SCM value),
74 "Convert a 16 bit quantity from host to network byte ordering.\n"
75 "@var{value} is packed into 2 bytes, which are then converted\n"
76 "and returned as a new integer.")
77 #define FUNC_NAME s_scm_htons
78 {
79 return scm_from_ushort (htons (scm_to_ushort (value)));
80 }
81 #undef FUNC_NAME
82
83 SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
84 (SCM value),
85 "Convert a 16 bit quantity from network to host byte ordering.\n"
86 "@var{value} is packed into 2 bytes, which are then converted\n"
87 "and returned as a new integer.")
88 #define FUNC_NAME s_scm_ntohs
89 {
90 return scm_from_ushort (ntohs (scm_to_ushort (value)));
91 }
92 #undef FUNC_NAME
93
94 SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
95 (SCM value),
96 "Convert a 32 bit quantity from host to network byte ordering.\n"
97 "@var{value} is packed into 4 bytes, which are then converted\n"
98 "and returned as a new integer.")
99 #define FUNC_NAME s_scm_htonl
100 {
101 scm_t_uint32 c_in = SCM_NUM2ULONG (1, value);
102
103 return scm_from_ulong (htonl (c_in));
104 }
105 #undef FUNC_NAME
106
107 SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
108 (SCM value),
109 "Convert a 32 bit quantity from network to host byte ordering.\n"
110 "@var{value} is packed into 4 bytes, which are then converted\n"
111 "and returned as a new integer.")
112 #define FUNC_NAME s_scm_ntohl
113 {
114 scm_t_uint32 c_in = SCM_NUM2ULONG (1, value);
115
116 return scm_from_ulong (ntohl (c_in));
117 }
118 #undef FUNC_NAME
119
120 #ifndef HAVE_INET_ATON
121 /* for our definition in inet_aton.c, not usually needed. */
122 extern int inet_aton ();
123 #endif
124
125 SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0,
126 (SCM address),
127 "Convert an IPv4 Internet address from printable string\n"
128 "(dotted decimal notation) to an integer. E.g.,\n\n"
129 "@lisp\n"
130 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
131 "@end lisp")
132 #define FUNC_NAME s_scm_inet_aton
133 {
134 struct in_addr soka;
135 char *c_address;
136 int rv;
137
138 c_address = scm_to_locale_string (address);
139 rv = inet_aton (c_address, &soka);
140 free (c_address);
141 if (rv == 0)
142 SCM_MISC_ERROR ("bad address", SCM_EOL);
143 return scm_from_ulong (ntohl (soka.s_addr));
144 }
145 #undef FUNC_NAME
146
147
148 SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0,
149 (SCM inetid),
150 "Convert an IPv4 Internet address to a printable\n"
151 "(dotted decimal notation) string. E.g.,\n\n"
152 "@lisp\n"
153 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
154 "@end lisp")
155 #define FUNC_NAME s_scm_inet_ntoa
156 {
157 struct in_addr addr;
158 char *s;
159 SCM answer;
160 addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid));
161 s = inet_ntoa (addr);
162 answer = scm_from_locale_string (s);
163 return answer;
164 }
165 #undef FUNC_NAME
166
167 #ifdef HAVE_INET_NETOF
168 SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
169 (SCM address),
170 "Return the network number part of the given IPv4\n"
171 "Internet address. E.g.,\n\n"
172 "@lisp\n"
173 "(inet-netof 2130706433) @result{} 127\n"
174 "@end lisp")
175 #define FUNC_NAME s_scm_inet_netof
176 {
177 struct in_addr addr;
178 addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
179 return scm_from_ulong (inet_netof (addr));
180 }
181 #undef FUNC_NAME
182 #endif
183
184 #ifdef HAVE_INET_LNAOF
185 SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0,
186 (SCM address),
187 "Return the local-address-with-network part of the given\n"
188 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
189 "E.g.,\n\n"
190 "@lisp\n"
191 "(inet-lnaof 2130706433) @result{} 1\n"
192 "@end lisp")
193 #define FUNC_NAME s_scm_lnaof
194 {
195 struct in_addr addr;
196 addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
197 return scm_from_ulong (inet_lnaof (addr));
198 }
199 #undef FUNC_NAME
200 #endif
201
202 #ifdef HAVE_INET_MAKEADDR
203 SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
204 (SCM net, SCM lna),
205 "Make an IPv4 Internet address by combining the network number\n"
206 "@var{net} with the local-address-within-network number\n"
207 "@var{lna}. E.g.,\n\n"
208 "@lisp\n"
209 "(inet-makeaddr 127 1) @result{} 2130706433\n"
210 "@end lisp")
211 #define FUNC_NAME s_scm_inet_makeaddr
212 {
213 struct in_addr addr;
214 unsigned long netnum;
215 unsigned long lnanum;
216
217 netnum = SCM_NUM2ULONG (1, net);
218 lnanum = SCM_NUM2ULONG (2, lna);
219 addr = inet_makeaddr (netnum, lnanum);
220 return scm_from_ulong (ntohl (addr.s_addr));
221 }
222 #undef FUNC_NAME
223 #endif
224
225 #ifdef HAVE_IPV6
226
227 /* flip a 128 bit IPv6 address between host and network order. */
228 #ifdef WORDS_BIGENDIAN
229 #define FLIP_NET_HOST_128(addr)
230 #else
231 #define FLIP_NET_HOST_128(addr)\
232 {\
233 int i;\
234 \
235 for (i = 0; i < 8; i++)\
236 {\
237 scm_t_uint8 c = (addr)[i];\
238 \
239 (addr)[i] = (addr)[15 - i];\
240 (addr)[15 - i] = c;\
241 }\
242 }
243 #endif
244
245 #ifdef WORDS_BIGENDIAN
246 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
247 #else
248 #define FLIPCPY_NET_HOST_128(dest, src) \
249 { \
250 const scm_t_uint8 *tmp_srcp = (src) + 15; \
251 scm_t_uint8 *tmp_destp = (dest); \
252 \
253 do { \
254 *tmp_destp++ = *tmp_srcp--; \
255 } while (tmp_srcp != (src)); \
256 }
257 #endif
258
259
260 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
261 #error "Assumption that scm_t_bits <= 128 bits has been violated."
262 #endif
263
264 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
265 #error "Assumption that unsigned long <= 128 bits has been violated."
266 #endif
267
268 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
269 #error "Assumption that unsigned long long <= 128 bits has been violated."
270 #endif
271
272 /* convert a 128 bit IPv6 address in network order to a host ordered
273 SCM integer. */
274 static SCM
275 scm_from_ipv6 (const scm_t_uint8 *src)
276 {
277 SCM result = scm_i_mkbig ();
278 mpz_import (SCM_I_BIG_MPZ (result),
279 1, /* chunk */
280 1, /* big-endian chunk ordering */
281 16, /* chunks are 16 bytes long */
282 1, /* big-endian byte ordering */
283 0, /* "nails" -- leading unused bits per chunk */
284 src);
285 return scm_i_normbig (result);
286 }
287
288 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
289 network order. */
290 static void
291 scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
292 {
293 if (SCM_I_INUMP (src))
294 {
295 scm_t_signed_bits n = SCM_I_INUM (src);
296 if (n < 0)
297 scm_out_of_range (NULL, src);
298 #ifdef WORDS_BIGENDIAN
299 memset (dst, 0, 16 - sizeof (scm_t_signed_bits));
300 memcpy (dst + (16 - sizeof (scm_t_signed_bits)),
301 &n,
302 sizeof (scm_t_signed_bits));
303 #else
304 memset (dst + sizeof (scm_t_signed_bits),
305 0,
306 16 - sizeof (scm_t_signed_bits));
307 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
308 a single loop perhaps, similar to the handling of bignums. */
309 memcpy (dst, &n, sizeof (scm_t_signed_bits));
310 FLIP_NET_HOST_128 (dst);
311 #endif
312 }
313 else if (SCM_BIGP (src))
314 {
315 size_t count;
316
317 if ((mpz_sgn (SCM_I_BIG_MPZ (src)) < 0)
318 || mpz_sizeinbase (SCM_I_BIG_MPZ (src), 2) > 128)
319 scm_out_of_range (NULL, src);
320
321 memset (dst, 0, 16);
322 mpz_export (dst,
323 &count,
324 1, /* big-endian chunk ordering */
325 16, /* chunks are 16 bytes long */
326 1, /* big-endian byte ordering */
327 0, /* "nails" -- leading unused bits per chunk */
328 SCM_I_BIG_MPZ (src));
329 scm_remember_upto_here_1 (src);
330 }
331 else
332 scm_wrong_type_arg (NULL, 0, src);
333 }
334
335 #ifdef HAVE_INET_PTON
336 SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
337 (SCM family, SCM address),
338 "Convert a string containing a printable network address to\n"
339 "an integer address. Note that unlike the C version of this\n"
340 "function,\n"
341 "the result is an integer with normal host byte ordering.\n"
342 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
343 "@lisp\n"
344 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
345 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
346 "@end lisp")
347 #define FUNC_NAME s_scm_inet_pton
348 {
349 int af;
350 char *src;
351 char dst[16];
352 int rv, eno;
353
354 af = scm_to_int (family);
355 SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
356 src = scm_to_locale_string (address);
357 rv = inet_pton (af, src, dst);
358 eno = errno;
359 free (src);
360 errno = eno;
361 if (rv == -1)
362 SCM_SYSERROR;
363 else if (rv == 0)
364 SCM_MISC_ERROR ("Bad address", SCM_EOL);
365 if (af == AF_INET)
366 return scm_from_ulong (ntohl (*(scm_t_uint32 *) dst));
367 else
368 return scm_from_ipv6 ((char *) dst);
369 }
370 #undef FUNC_NAME
371 #endif
372
373 #ifdef HAVE_INET_NTOP
374 SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
375 (SCM family, SCM address),
376 "Convert a network address into a printable string.\n"
377 "Note that unlike the C version of this function,\n"
378 "the input is an integer with normal host byte ordering.\n"
379 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
380 "@lisp\n"
381 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
382 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
383 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
384 "@end lisp")
385 #define FUNC_NAME s_scm_inet_ntop
386 {
387 int af;
388 #ifdef INET6_ADDRSTRLEN
389 char dst[INET6_ADDRSTRLEN];
390 #else
391 char dst[46];
392 #endif
393 char addr6[16];
394
395 af = scm_to_int (family);
396 SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
397 if (af == AF_INET)
398 *(scm_t_uint32 *) addr6 = htonl (SCM_NUM2ULONG (2, address));
399 else
400 scm_to_ipv6 (addr6, address);
401 if (inet_ntop (af, &addr6, dst, sizeof dst) == NULL)
402 SCM_SYSERROR;
403 return scm_from_locale_string (dst);
404 }
405 #undef FUNC_NAME
406 #endif
407
408 #endif /* HAVE_IPV6 */
409
410 SCM_SYMBOL (sym_socket, "socket");
411
412 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
413
414 SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
415 (SCM family, SCM style, SCM proto),
416 "Return a new socket port of the type specified by @var{family},\n"
417 "@var{style} and @var{proto}. All three parameters are\n"
418 "integers. Supported values for @var{family} are\n"
419 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
420 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
421 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
422 "@var{proto} can be obtained from a protocol name using\n"
423 "@code{getprotobyname}. A value of zero specifies the default\n"
424 "protocol, which is usually right.\n\n"
425 "A single socket port cannot by used for communication until it\n"
426 "has been connected to another socket.")
427 #define FUNC_NAME s_scm_socket
428 {
429 int fd;
430
431 fd = socket (scm_to_int (family),
432 scm_to_int (style),
433 scm_to_int (proto));
434 if (fd == -1)
435 SCM_SYSERROR;
436 return SCM_SOCK_FD_TO_PORT (fd);
437 }
438 #undef FUNC_NAME
439
440 #ifdef HAVE_SOCKETPAIR
441 SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
442 (SCM family, SCM style, SCM proto),
443 "Return a pair of connected (but unnamed) socket ports of the\n"
444 "type specified by @var{family}, @var{style} and @var{proto}.\n"
445 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
446 "family. Zero is likely to be the only meaningful value for\n"
447 "@var{proto}.")
448 #define FUNC_NAME s_scm_socketpair
449 {
450 int fam;
451 int fd[2];
452
453 fam = scm_to_int (family);
454
455 if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
456 SCM_SYSERROR;
457
458 return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
459 }
460 #undef FUNC_NAME
461 #endif
462
463 SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
464 (SCM sock, SCM level, SCM optname),
465 "Return the value of a particular socket option for the socket\n"
466 "port @var{sock}. @var{level} is an integer code for type of\n"
467 "option being requested, e.g., @code{SOL_SOCKET} for\n"
468 "socket-level options. @var{optname} is an integer code for the\n"
469 "option required and should be specified using one of the\n"
470 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
471 "The returned value is typically an integer but @code{SO_LINGER}\n"
472 "returns a pair of integers.")
473 #define FUNC_NAME s_scm_getsockopt
474 {
475 int fd;
476 /* size of optval is the largest supported option. */
477 #ifdef HAVE_STRUCT_LINGER
478 char optval[sizeof (struct linger)];
479 int optlen = sizeof (struct linger);
480 #else
481 char optval[sizeof (size_t)];
482 int optlen = sizeof (size_t);
483 #endif
484 int ilevel;
485 int ioptname;
486
487 sock = SCM_COERCE_OUTPORT (sock);
488 SCM_VALIDATE_OPFPORT (1, sock);
489 ilevel = scm_to_int (level);
490 ioptname = scm_to_int (optname);
491
492 fd = SCM_FPORT_FDES (sock);
493 if (getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen) == -1)
494 SCM_SYSERROR;
495
496 if (ilevel == SOL_SOCKET)
497 {
498 #ifdef SO_LINGER
499 if (ioptname == SO_LINGER)
500 {
501 #ifdef HAVE_STRUCT_LINGER
502 struct linger *ling = (struct linger *) optval;
503
504 return scm_cons (scm_from_long (ling->l_onoff),
505 scm_from_long (ling->l_linger));
506 #else
507 return scm_cons (scm_from_long (*(int *) optval),
508 scm_from_int (0));
509 #endif
510 }
511 else
512 #endif
513 if (0
514 #ifdef SO_SNDBUF
515 || ioptname == SO_SNDBUF
516 #endif
517 #ifdef SO_RCVBUF
518 || ioptname == SO_RCVBUF
519 #endif
520 )
521 {
522 return scm_from_size_t (*(size_t *) optval);
523 }
524 }
525 return scm_from_int (*(int *) optval);
526 }
527 #undef FUNC_NAME
528
529 SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
530 (SCM sock, SCM level, SCM optname, SCM value),
531 "Set the value of a particular socket option for the socket\n"
532 "port @var{sock}. @var{level} is an integer code for type of option\n"
533 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
534 "@var{optname} is an\n"
535 "integer code for the option to set and should be specified using one of\n"
536 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
537 "@var{value} is the value to which the option should be set. For\n"
538 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
539 "be a pair.\n\n"
540 "The return value is unspecified.")
541 #define FUNC_NAME s_scm_setsockopt
542 {
543 int fd;
544
545 int opt_int;
546 #ifdef HAVE_STRUCT_LINGER
547 struct linger opt_linger;
548 #endif
549
550 #if HAVE_STRUCT_IP_MREQ
551 struct ip_mreq opt_mreq;
552 #endif
553
554 const void *optval = NULL;
555 socklen_t optlen = 0;
556
557 int ilevel, ioptname;
558
559 sock = SCM_COERCE_OUTPORT (sock);
560
561 SCM_VALIDATE_OPFPORT (1, sock);
562 ilevel = scm_to_int (level);
563 ioptname = scm_to_int (optname);
564
565 fd = SCM_FPORT_FDES (sock);
566
567 if (ilevel == SOL_SOCKET)
568 {
569 #ifdef SO_LINGER
570 if (ioptname == SO_LINGER)
571 {
572 #ifdef HAVE_STRUCT_LINGER
573 SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
574 opt_linger.l_onoff = scm_to_int (SCM_CAR (value));
575 opt_linger.l_linger = scm_to_int (SCM_CDR (value));
576 optlen = sizeof (struct linger);
577 optval = &opt_linger;
578 #else
579 SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
580 opt_int = scm_to_int (SCM_CAR (value));
581 /* timeout is ignored, but may as well validate it. */
582 scm_to_int (SCM_CDR (value));
583 optlen = sizeof (int);
584 optval = &opt_int;
585 #endif
586 }
587 else
588 #endif
589 if (0
590 #ifdef SO_SNDBUF
591 || ioptname == SO_SNDBUF
592 #endif
593 #ifdef SO_RCVBUF
594 || ioptname == SO_RCVBUF
595 #endif
596 )
597 {
598 opt_int = scm_to_int (value);
599 optlen = sizeof (size_t);
600 optval = &opt_int;
601 }
602 }
603
604 #if HAVE_STRUCT_IP_MREQ
605 if (ilevel == IPPROTO_IP &&
606 (ioptname == IP_ADD_MEMBERSHIP || ioptname == IP_DROP_MEMBERSHIP))
607 {
608 /* Fourth argument must be a pair of addresses. */
609 SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
610 opt_mreq.imr_multiaddr.s_addr = htonl (scm_to_ulong (SCM_CAR (value)));
611 opt_mreq.imr_interface.s_addr = htonl (scm_to_ulong (SCM_CDR (value)));
612 optlen = sizeof (opt_mreq);
613 optval = &opt_mreq;
614 }
615 #endif
616
617 if (optval == NULL)
618 {
619 /* Most options take an int. */
620 opt_int = scm_to_int (value);
621 optlen = sizeof (int);
622 optval = &opt_int;
623 }
624
625 if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
626 SCM_SYSERROR;
627 return SCM_UNSPECIFIED;
628 }
629 #undef FUNC_NAME
630
631 SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
632 (SCM sock, SCM how),
633 "Sockets can be closed simply by using @code{close-port}. The\n"
634 "@code{shutdown} procedure allows reception or transmission on a\n"
635 "connection to be shut down individually, according to the parameter\n"
636 "@var{how}:\n\n"
637 "@table @asis\n"
638 "@item 0\n"
639 "Stop receiving data for this socket. If further data arrives, reject it.\n"
640 "@item 1\n"
641 "Stop trying to transmit data from this socket. Discard any\n"
642 "data waiting to be sent. Stop looking for acknowledgement of\n"
643 "data already sent; don't retransmit it if it is lost.\n"
644 "@item 2\n"
645 "Stop both reception and transmission.\n"
646 "@end table\n\n"
647 "The return value is unspecified.")
648 #define FUNC_NAME s_scm_shutdown
649 {
650 int fd;
651 sock = SCM_COERCE_OUTPORT (sock);
652 SCM_VALIDATE_OPFPORT (1, sock);
653 fd = SCM_FPORT_FDES (sock);
654 if (shutdown (fd, scm_to_signed_integer (how, 0, 2)) == -1)
655 SCM_SYSERROR;
656 return SCM_UNSPECIFIED;
657 }
658 #undef FUNC_NAME
659
660 /* convert fam/address/args into a sockaddr of the appropriate type.
661 args is modified by removing the arguments actually used.
662 which_arg and proc are used when reporting errors:
663 which_arg is the position of address in the original argument list.
664 proc is the name of the original procedure.
665 size returns the size of the structure allocated. */
666
667 static struct sockaddr *
668 scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
669 const char *proc, int *size)
670 #define FUNC_NAME proc
671 {
672 switch (fam)
673 {
674 case AF_INET:
675 {
676 struct sockaddr_in *soka;
677 unsigned long addr;
678 int port;
679
680 SCM_VALIDATE_ULONG_COPY (which_arg, address, addr);
681 SCM_VALIDATE_CONS (which_arg + 1, *args);
682 port = scm_to_int (SCM_CAR (*args));
683 *args = SCM_CDR (*args);
684 soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
685 if (!soka)
686 scm_memory_error (proc);
687 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
688 soka->sin_len = sizeof (struct sockaddr_in);
689 #endif
690 soka->sin_family = AF_INET;
691 soka->sin_addr.s_addr = htonl (addr);
692 soka->sin_port = htons (port);
693 *size = sizeof (struct sockaddr_in);
694 return (struct sockaddr *) soka;
695 }
696 #ifdef HAVE_IPV6
697 case AF_INET6:
698 {
699 /* see RFC2553. */
700 int port;
701 struct sockaddr_in6 *soka;
702 unsigned long flowinfo = 0;
703 unsigned long scope_id = 0;
704
705 SCM_VALIDATE_CONS (which_arg + 1, *args);
706 port = scm_to_int (SCM_CAR (*args));
707 *args = SCM_CDR (*args);
708 if (scm_is_pair (*args))
709 {
710 SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
711 *args = SCM_CDR (*args);
712 if (scm_is_pair (*args))
713 {
714 SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
715 scope_id);
716 *args = SCM_CDR (*args);
717 }
718 }
719 soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
720 if (!soka)
721 scm_memory_error (proc);
722 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
723 soka->sin6_len = sizeof (struct sockaddr_in6);
724 #endif
725 soka->sin6_family = AF_INET6;
726 scm_to_ipv6 (soka->sin6_addr.s6_addr, address);
727 soka->sin6_port = htons (port);
728 soka->sin6_flowinfo = flowinfo;
729 #ifdef HAVE_SIN6_SCOPE_ID
730 soka->sin6_scope_id = scope_id;
731 #endif
732 *size = sizeof (struct sockaddr_in6);
733 return (struct sockaddr *) soka;
734 }
735 #endif
736 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
737 case AF_UNIX:
738 {
739 struct sockaddr_un *soka;
740 int addr_size;
741 char *c_address;
742
743 scm_frame_begin (0);
744
745 c_address = scm_to_locale_string (address);
746 scm_frame_free (c_address);
747
748 /* the static buffer size in sockaddr_un seems to be arbitrary
749 and not necessarily a hard limit. e.g., the glibc manual
750 suggests it may be possible to declare it size 0. let's
751 ignore it. if the O/S doesn't like the size it will cause
752 connect/bind etc., to fail. sun_path is always the last
753 member of the structure. */
754 addr_size = sizeof (struct sockaddr_un)
755 + max (0, strlen (c_address) + 1 - (sizeof soka->sun_path));
756 soka = (struct sockaddr_un *) scm_malloc (addr_size);
757 memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */
758 soka->sun_family = AF_UNIX;
759 strcpy (soka->sun_path, c_address);
760 *size = SUN_LEN (soka);
761
762 scm_frame_end ();
763 return (struct sockaddr *) soka;
764 }
765 #endif
766 default:
767 scm_out_of_range (proc, scm_from_int (fam));
768 }
769 }
770 #undef FUNC_NAME
771
772 SCM_DEFINE (scm_connect, "connect", 3, 0, 1,
773 (SCM sock, SCM fam, SCM address, SCM args),
774 "Initiate a connection from a socket using a specified address\n"
775 "family to the address\n"
776 "specified by @var{address} and possibly @var{args}.\n"
777 "The format required for @var{address}\n"
778 "and @var{args} depends on the family of the socket.\n\n"
779 "For a socket of family @code{AF_UNIX},\n"
780 "only @var{address} is specified and must be a string with the\n"
781 "filename where the socket is to be created.\n\n"
782 "For a socket of family @code{AF_INET},\n"
783 "@var{address} must be an integer IPv4 host address and\n"
784 "@var{args} must be a single integer port number.\n\n"
785 "For a socket of family @code{AF_INET6},\n"
786 "@var{address} must be an integer IPv6 host address and\n"
787 "@var{args} may be up to three integers:\n"
788 "port [flowinfo] [scope_id],\n"
789 "where flowinfo and scope_id default to zero.\n\n"
790 "The return value is unspecified.")
791 #define FUNC_NAME s_scm_connect
792 {
793 int fd;
794 struct sockaddr *soka;
795 int size;
796
797 sock = SCM_COERCE_OUTPORT (sock);
798 SCM_VALIDATE_OPFPORT (1, sock);
799 fd = SCM_FPORT_FDES (sock);
800 soka = scm_fill_sockaddr (scm_to_int (fam), address, &args, 3, FUNC_NAME,
801 &size);
802 if (connect (fd, soka, size) == -1)
803 {
804 int save_errno = errno;
805
806 free (soka);
807 errno = save_errno;
808 SCM_SYSERROR;
809 }
810 free (soka);
811 return SCM_UNSPECIFIED;
812 }
813 #undef FUNC_NAME
814
815 SCM_DEFINE (scm_bind, "bind", 3, 0, 1,
816 (SCM sock, SCM fam, SCM address, SCM args),
817 "Assign an address to the socket port @var{sock}.\n"
818 "Generally this only needs to be done for server sockets,\n"
819 "so they know where to look for incoming connections. A socket\n"
820 "without an address will be assigned one automatically when it\n"
821 "starts communicating.\n\n"
822 "The format of @var{address} and @var{args} depends\n"
823 "on the family of the socket.\n\n"
824 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
825 "is specified and must be a string with the filename where\n"
826 "the socket is to be created.\n\n"
827 "For a socket of family @code{AF_INET}, @var{address}\n"
828 "must be an integer IPv4 address and @var{args}\n"
829 "must be a single integer port number.\n\n"
830 "The values of the following variables can also be used for\n"
831 "@var{address}:\n\n"
832 "@defvar INADDR_ANY\n"
833 "Allow connections from any address.\n"
834 "@end defvar\n\n"
835 "@defvar INADDR_LOOPBACK\n"
836 "The address of the local host using the loopback device.\n"
837 "@end defvar\n\n"
838 "@defvar INADDR_BROADCAST\n"
839 "The broadcast address on the local network.\n"
840 "@end defvar\n\n"
841 "@defvar INADDR_NONE\n"
842 "No address.\n"
843 "@end defvar\n\n"
844 "For a socket of family @code{AF_INET6}, @var{address}\n"
845 "must be an integer IPv6 address and @var{args}\n"
846 "may be up to three integers:\n"
847 "port [flowinfo] [scope_id],\n"
848 "where flowinfo and scope_id default to zero.\n\n"
849 "The return value is unspecified.")
850 #define FUNC_NAME s_scm_bind
851 {
852 struct sockaddr *soka;
853 int size;
854 int fd;
855
856 sock = SCM_COERCE_OUTPORT (sock);
857 SCM_VALIDATE_OPFPORT (1, sock);
858 soka = scm_fill_sockaddr (scm_to_int (fam), address, &args, 3, FUNC_NAME,
859 &size);
860 fd = SCM_FPORT_FDES (sock);
861 if (bind (fd, soka, size) == -1)
862 {
863 int save_errno = errno;
864
865 free (soka);
866 errno = save_errno;
867 SCM_SYSERROR;
868 }
869 free (soka);
870 return SCM_UNSPECIFIED;
871 }
872 #undef FUNC_NAME
873
874 SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
875 (SCM sock, SCM backlog),
876 "Enable @var{sock} to accept connection\n"
877 "requests. @var{backlog} is an integer specifying\n"
878 "the maximum length of the queue for pending connections.\n"
879 "If the queue fills, new clients will fail to connect until\n"
880 "the server calls @code{accept} to accept a connection from\n"
881 "the queue.\n\n"
882 "The return value is unspecified.")
883 #define FUNC_NAME s_scm_listen
884 {
885 int fd;
886 sock = SCM_COERCE_OUTPORT (sock);
887 SCM_VALIDATE_OPFPORT (1, sock);
888 fd = SCM_FPORT_FDES (sock);
889 if (listen (fd, scm_to_int (backlog)) == -1)
890 SCM_SYSERROR;
891 return SCM_UNSPECIFIED;
892 }
893 #undef FUNC_NAME
894
895 /* Put the components of a sockaddr into a new SCM vector. */
896 static SCM
897 scm_addr_vector (const struct sockaddr *address, int addr_size,
898 const char *proc)
899 {
900 short int fam = address->sa_family;
901 SCM result =SCM_EOL;
902
903
904 switch (fam)
905 {
906 case AF_INET:
907 {
908 const struct sockaddr_in *nad = (struct sockaddr_in *) address;
909
910 result = scm_c_make_vector (3, SCM_UNSPECIFIED);
911
912 SCM_SIMPLE_VECTOR_SET(result, 0,
913 scm_from_short (fam));
914 SCM_SIMPLE_VECTOR_SET(result, 1,
915 scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
916 SCM_SIMPLE_VECTOR_SET(result, 2,
917 scm_from_ushort (ntohs (nad->sin_port)));
918 }
919 break;
920 #ifdef HAVE_IPV6
921 case AF_INET6:
922 {
923 const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
924
925 result = scm_c_make_vector (5, SCM_UNSPECIFIED);
926 SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
927 SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
928 SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
929 SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
930 #ifdef HAVE_SIN6_SCOPE_ID
931 SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
932 #else
933 SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
934 #endif
935 }
936 break;
937 #endif
938 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
939 case AF_UNIX:
940 {
941 const struct sockaddr_un *nad = (struct sockaddr_un *) address;
942
943 result = scm_c_make_vector (2, SCM_UNSPECIFIED);
944
945 SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
946 /* When addr_size is not enough to cover sun_path, do not try
947 to access it. */
948 if (addr_size <= offsetof (struct sockaddr_un, sun_path))
949 SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
950 else
951 SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
952 }
953 break;
954 #endif
955 default:
956 scm_misc_error (proc, "Unrecognised address family: ~A",
957 scm_list_1 (scm_from_int (fam)));
958 }
959 return result;
960 }
961
962 /* calculate the size of a buffer large enough to hold any supported
963 sockaddr type. if the buffer isn't large enough, certain system
964 calls will return a truncated address. */
965
966 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
967 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
968 #else
969 #define MAX_SIZE_UN 0
970 #endif
971
972 #if defined (HAVE_IPV6)
973 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
974 #else
975 #define MAX_SIZE_IN6 0
976 #endif
977
978 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
979 MAX_SIZE_UN)
980
981 SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
982 (SCM sock),
983 "Accept a connection on a bound, listening socket.\n"
984 "If there\n"
985 "are no pending connections in the queue, wait until\n"
986 "one is available unless the non-blocking option has been\n"
987 "set on the socket.\n\n"
988 "The return value is a\n"
989 "pair in which the @emph{car} is a new socket port for the\n"
990 "connection and\n"
991 "the @emph{cdr} is an object with address information about the\n"
992 "client which initiated the connection.\n\n"
993 "@var{sock} does not become part of the\n"
994 "connection and will continue to accept new requests.")
995 #define FUNC_NAME s_scm_accept
996 {
997 int fd;
998 int newfd;
999 SCM address;
1000 SCM newsock;
1001 int addr_size = MAX_ADDR_SIZE;
1002 char max_addr[MAX_ADDR_SIZE];
1003 struct sockaddr *addr = (struct sockaddr *) max_addr;
1004
1005 sock = SCM_COERCE_OUTPORT (sock);
1006 SCM_VALIDATE_OPFPORT (1, sock);
1007 fd = SCM_FPORT_FDES (sock);
1008 newfd = accept (fd, addr, &addr_size);
1009 if (newfd == -1)
1010 SCM_SYSERROR;
1011 newsock = SCM_SOCK_FD_TO_PORT (newfd);
1012 address = scm_addr_vector (addr, addr_size, FUNC_NAME);
1013 return scm_cons (newsock, address);
1014 }
1015 #undef FUNC_NAME
1016
1017 SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
1018 (SCM sock),
1019 "Return the address of @var{sock}, in the same form as the\n"
1020 "object returned by @code{accept}. On many systems the address\n"
1021 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1022 #define FUNC_NAME s_scm_getsockname
1023 {
1024 int fd;
1025 int addr_size = MAX_ADDR_SIZE;
1026 char max_addr[MAX_ADDR_SIZE];
1027 struct sockaddr *addr = (struct sockaddr *) max_addr;
1028
1029 sock = SCM_COERCE_OUTPORT (sock);
1030 SCM_VALIDATE_OPFPORT (1, sock);
1031 fd = SCM_FPORT_FDES (sock);
1032 if (getsockname (fd, addr, &addr_size) == -1)
1033 SCM_SYSERROR;
1034 return scm_addr_vector (addr, addr_size, FUNC_NAME);
1035 }
1036 #undef FUNC_NAME
1037
1038 SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
1039 (SCM sock),
1040 "Return the address that @var{sock}\n"
1041 "is connected to, in the same form as the object returned by\n"
1042 "@code{accept}. On many systems the address of a socket in the\n"
1043 "@code{AF_FILE} namespace cannot be read.")
1044 #define FUNC_NAME s_scm_getpeername
1045 {
1046 int fd;
1047 int addr_size = MAX_ADDR_SIZE;
1048 char max_addr[MAX_ADDR_SIZE];
1049 struct sockaddr *addr = (struct sockaddr *) max_addr;
1050
1051 sock = SCM_COERCE_OUTPORT (sock);
1052 SCM_VALIDATE_OPFPORT (1, sock);
1053 fd = SCM_FPORT_FDES (sock);
1054 if (getpeername (fd, addr, &addr_size) == -1)
1055 SCM_SYSERROR;
1056 return scm_addr_vector (addr, addr_size, FUNC_NAME);
1057 }
1058 #undef FUNC_NAME
1059
1060 SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
1061 (SCM sock, SCM buf, SCM flags),
1062 "Receive data from a socket port.\n"
1063 "@var{sock} must already\n"
1064 "be bound to the address from which data is to be received.\n"
1065 "@var{buf} is a string into which\n"
1066 "the data will be written. The size of @var{buf} limits\n"
1067 "the amount of\n"
1068 "data which can be received: in the case of packet\n"
1069 "protocols, if a packet larger than this limit is encountered\n"
1070 "then some data\n"
1071 "will be irrevocably lost.\n\n"
1072 "The optional @var{flags} argument is a value or\n"
1073 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1074 "The value returned is the number of bytes read from the\n"
1075 "socket.\n\n"
1076 "Note that the data is read directly from the socket file\n"
1077 "descriptor:\n"
1078 "any unread buffered port data is ignored.")
1079 #define FUNC_NAME s_scm_recv
1080 {
1081 int rv;
1082 int fd;
1083 int flg;
1084 char *dest;
1085 size_t len;
1086
1087 SCM_VALIDATE_OPFPORT (1, sock);
1088 SCM_VALIDATE_STRING (2, buf);
1089 if (SCM_UNBNDP (flags))
1090 flg = 0;
1091 else
1092 flg = scm_to_int (flags);
1093 fd = SCM_FPORT_FDES (sock);
1094
1095 len = scm_i_string_length (buf);
1096 dest = scm_i_string_writable_chars (buf);
1097 SCM_SYSCALL (rv = recv (fd, dest, len, flg));
1098 scm_i_string_stop_writing ();
1099
1100 if (rv == -1)
1101 SCM_SYSERROR;
1102
1103 scm_remember_upto_here_1 (buf);
1104 return scm_from_int (rv);
1105 }
1106 #undef FUNC_NAME
1107
1108 SCM_DEFINE (scm_send, "send", 2, 1, 0,
1109 (SCM sock, SCM message, SCM flags),
1110 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1111 "@var{sock} must already be bound to a destination address. The\n"
1112 "value returned is the number of bytes transmitted --\n"
1113 "it's possible for\n"
1114 "this to be less than the length of @var{message}\n"
1115 "if the socket is\n"
1116 "set to be non-blocking. The optional @var{flags} argument\n"
1117 "is a value or\n"
1118 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1119 "Note that the data is written directly to the socket\n"
1120 "file descriptor:\n"
1121 "any unflushed buffered port data is ignored.")
1122 #define FUNC_NAME s_scm_send
1123 {
1124 int rv;
1125 int fd;
1126 int flg;
1127 const char *src;
1128 size_t len;
1129
1130 sock = SCM_COERCE_OUTPORT (sock);
1131 SCM_VALIDATE_OPFPORT (1, sock);
1132 SCM_VALIDATE_STRING (2, message);
1133 if (SCM_UNBNDP (flags))
1134 flg = 0;
1135 else
1136 flg = scm_to_int (flags);
1137 fd = SCM_FPORT_FDES (sock);
1138
1139 len = scm_i_string_length (message);
1140 src = scm_i_string_writable_chars (message);
1141 SCM_SYSCALL (rv = send (fd, src, len, flg));
1142 scm_i_string_stop_writing ();
1143
1144 if (rv == -1)
1145 SCM_SYSERROR;
1146
1147 scm_remember_upto_here_1 (message);
1148 return scm_from_int (rv);
1149 }
1150 #undef FUNC_NAME
1151
1152 SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
1153 (SCM sock, SCM str, SCM flags, SCM start, SCM end),
1154 "Return data from the socket port @var{sock} and also\n"
1155 "information about where the data was received from.\n"
1156 "@var{sock} must already be bound to the address from which\n"
1157 "data is to be received. @code{str}, is a string into which the\n"
1158 "data will be written. The size of @var{str} limits the amount\n"
1159 "of data which can be received: in the case of packet protocols,\n"
1160 "if a packet larger than this limit is encountered then some\n"
1161 "data will be irrevocably lost.\n\n"
1162 "The optional @var{flags} argument is a value or bitwise OR of\n"
1163 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1164 "The value returned is a pair: the @emph{car} is the number of\n"
1165 "bytes read from the socket and the @emph{cdr} an address object\n"
1166 "in the same form as returned by @code{accept}. The address\n"
1167 "will given as @code{#f} if not available, as is usually the\n"
1168 "case for stream sockets.\n\n"
1169 "The @var{start} and @var{end} arguments specify a substring of\n"
1170 "@var{str} to which the data should be written.\n\n"
1171 "Note that the data is read directly from the socket file\n"
1172 "descriptor: any unread buffered port data is ignored.")
1173 #define FUNC_NAME s_scm_recvfrom
1174 {
1175 int rv;
1176 int fd;
1177 int flg;
1178 char *buf;
1179 size_t offset;
1180 size_t cend;
1181 SCM address;
1182 int addr_size = MAX_ADDR_SIZE;
1183 char max_addr[MAX_ADDR_SIZE];
1184 struct sockaddr *addr = (struct sockaddr *) max_addr;
1185
1186 SCM_VALIDATE_OPFPORT (1, sock);
1187 fd = SCM_FPORT_FDES (sock);
1188
1189 SCM_VALIDATE_STRING (2, str);
1190 scm_i_get_substring_spec (scm_i_string_length (str),
1191 start, &offset, end, &cend);
1192
1193 if (SCM_UNBNDP (flags))
1194 flg = 0;
1195 else
1196 SCM_VALIDATE_ULONG_COPY (3, flags, flg);
1197
1198 /* recvfrom will not necessarily return an address. usually nothing
1199 is returned for stream sockets. */
1200 buf = scm_i_string_writable_chars (str);
1201 addr->sa_family = AF_UNSPEC;
1202 SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
1203 cend - offset, flg,
1204 addr, &addr_size));
1205 scm_i_string_stop_writing ();
1206
1207 if (rv == -1)
1208 SCM_SYSERROR;
1209 if (addr->sa_family != AF_UNSPEC)
1210 address = scm_addr_vector (addr, addr_size, FUNC_NAME);
1211 else
1212 address = SCM_BOOL_F;
1213
1214 scm_remember_upto_here_1 (str);
1215 return scm_cons (scm_from_int (rv), address);
1216 }
1217 #undef FUNC_NAME
1218
1219 SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
1220 (SCM sock, SCM message, SCM fam, SCM address, SCM args_and_flags),
1221 "Transmit the string @var{message} on the socket port\n"
1222 "@var{sock}. The\n"
1223 "destination address is specified using the @var{fam},\n"
1224 "@var{address} and\n"
1225 "@var{args_and_flags} arguments, in a similar way to the\n"
1226 "@code{connect} procedure. @var{args_and_flags} contains\n"
1227 "the usual connection arguments optionally followed by\n"
1228 "a flags argument, which is a value or\n"
1229 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1230 "The value returned is the number of bytes transmitted --\n"
1231 "it's possible for\n"
1232 "this to be less than the length of @var{message} if the\n"
1233 "socket is\n"
1234 "set to be non-blocking.\n"
1235 "Note that the data is written directly to the socket\n"
1236 "file descriptor:\n"
1237 "any unflushed buffered port data is ignored.")
1238 #define FUNC_NAME s_scm_sendto
1239 {
1240 int rv;
1241 int fd;
1242 int flg;
1243 struct sockaddr *soka;
1244 int size;
1245
1246 sock = SCM_COERCE_OUTPORT (sock);
1247 SCM_VALIDATE_FPORT (1, sock);
1248 SCM_VALIDATE_STRING (2, message);
1249 fd = SCM_FPORT_FDES (sock);
1250 soka = scm_fill_sockaddr (scm_to_int (fam), address, &args_and_flags, 4,
1251 FUNC_NAME, &size);
1252 if (scm_is_null (args_and_flags))
1253 flg = 0;
1254 else
1255 {
1256 SCM_VALIDATE_CONS (5, args_and_flags);
1257 flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
1258 }
1259 SCM_SYSCALL (rv = sendto (fd,
1260 scm_i_string_chars (message),
1261 scm_i_string_length (message),
1262 flg, soka, size));
1263 if (rv == -1)
1264 {
1265 int save_errno = errno;
1266 free (soka);
1267 errno = save_errno;
1268 SCM_SYSERROR;
1269 }
1270 free (soka);
1271
1272 scm_remember_upto_here_1 (message);
1273 return scm_from_int (rv);
1274 }
1275 #undef FUNC_NAME
1276 \f
1277
1278
1279 void
1280 scm_init_socket ()
1281 {
1282 /* protocol families. */
1283 #ifdef AF_UNSPEC
1284 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC));
1285 #endif
1286 #ifdef AF_UNIX
1287 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX));
1288 #endif
1289 #ifdef AF_INET
1290 scm_c_define ("AF_INET", scm_from_int (AF_INET));
1291 #endif
1292 #ifdef AF_INET6
1293 scm_c_define ("AF_INET6", scm_from_int (AF_INET6));
1294 #endif
1295
1296 #ifdef PF_UNSPEC
1297 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC));
1298 #endif
1299 #ifdef PF_UNIX
1300 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX));
1301 #endif
1302 #ifdef PF_INET
1303 scm_c_define ("PF_INET", scm_from_int (PF_INET));
1304 #endif
1305 #ifdef PF_INET6
1306 scm_c_define ("PF_INET6", scm_from_int (PF_INET6));
1307 #endif
1308
1309 /* standard addresses. */
1310 #ifdef INADDR_ANY
1311 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY));
1312 #endif
1313 #ifdef INADDR_BROADCAST
1314 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST));
1315 #endif
1316 #ifdef INADDR_NONE
1317 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE));
1318 #endif
1319 #ifdef INADDR_LOOPBACK
1320 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK));
1321 #endif
1322
1323 /* socket types.
1324
1325 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1326 packet(7) advise that it's obsolete and strongly deprecated. */
1327
1328 #ifdef SOCK_STREAM
1329 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM));
1330 #endif
1331 #ifdef SOCK_DGRAM
1332 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM));
1333 #endif
1334 #ifdef SOCK_SEQPACKET
1335 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET));
1336 #endif
1337 #ifdef SOCK_RAW
1338 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW));
1339 #endif
1340 #ifdef SOCK_RDM
1341 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM));
1342 #endif
1343
1344 /* setsockopt level. */
1345 #ifdef SOL_SOCKET
1346 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET));
1347 #endif
1348 #ifdef SOL_IP
1349 scm_c_define ("SOL_IP", scm_from_int (SOL_IP));
1350 #endif
1351 #ifdef SOL_TCP
1352 scm_c_define ("SOL_TCP", scm_from_int (SOL_TCP));
1353 #endif
1354 #ifdef SOL_UDP
1355 scm_c_define ("SOL_UDP", scm_from_int (SOL_UDP));
1356 #endif
1357
1358 /* setsockopt names. */
1359 #ifdef SO_DEBUG
1360 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG));
1361 #endif
1362 #ifdef SO_REUSEADDR
1363 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR));
1364 #endif
1365 #ifdef SO_STYLE
1366 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE));
1367 #endif
1368 #ifdef SO_TYPE
1369 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE));
1370 #endif
1371 #ifdef SO_ERROR
1372 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR));
1373 #endif
1374 #ifdef SO_DONTROUTE
1375 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE));
1376 #endif
1377 #ifdef SO_BROADCAST
1378 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST));
1379 #endif
1380 #ifdef SO_SNDBUF
1381 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF));
1382 #endif
1383 #ifdef SO_RCVBUF
1384 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF));
1385 #endif
1386 #ifdef SO_KEEPALIVE
1387 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE));
1388 #endif
1389 #ifdef SO_OOBINLINE
1390 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE));
1391 #endif
1392 #ifdef SO_NO_CHECK
1393 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK));
1394 #endif
1395 #ifdef SO_PRIORITY
1396 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY));
1397 #endif
1398 #ifdef SO_LINGER
1399 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER));
1400 #endif
1401
1402 /* recv/send options. */
1403 #ifdef MSG_OOB
1404 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB));
1405 #endif
1406 #ifdef MSG_PEEK
1407 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK));
1408 #endif
1409 #ifdef MSG_DONTROUTE
1410 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE));
1411 #endif
1412
1413 #ifdef __MINGW32__
1414 scm_i_init_socket_Win32 ();
1415 #endif
1416
1417 #ifdef IP_ADD_MEMBERSHIP
1418 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
1419 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
1420 #endif
1421
1422 scm_add_feature ("socket");
1423
1424 #include "libguile/socket.x"
1425 }
1426
1427
1428 /*
1429 Local Variables:
1430 c-file-style: "gnu"
1431 End:
1432 */