1
/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
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.
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.
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
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"
36
#include "libguile/validate.h"
37
#include "libguile/socket.h"
40
#include "win32-socket.h"
52
#include <sys/types.h>
53
#ifdef HAVE_WINSOCK2_H
56
#include <sys/socket.h>
57
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
60
#include <netinet/in.h>
62
#include <arpa/inet.h>
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))
72
SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
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
79
return scm_from_ushort (htons (scm_to_ushort (value)));
83
SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
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
90
return scm_from_ushort (ntohs (scm_to_ushort (value)));
94
SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
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
101
return scm_from_ulong (htonl (scm_to_uint32 (value)));
105
SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
107
"Convert a 32 bit quantity from network to host byte ordering.\n"
108
"@var{value} is packed into 4 bytes, which are then converted\n"
109
"and returned as a new integer.")
110
#define FUNC_NAME s_scm_ntohl
112
return scm_from_ulong (ntohl (scm_to_uint32 (value)));
116
#ifndef HAVE_INET_ATON
117
/* for our definition in inet_aton.c, not usually needed. */
118
extern int inet_aton ();
121
SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0,
123
"Convert an IPv4 Internet address from printable string\n"
124
"(dotted decimal notation) to an integer. E.g.,\n\n"
126
"(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
128
#define FUNC_NAME s_scm_inet_aton
134
c_address = scm_to_locale_string (address);
135
rv = inet_aton (c_address, &soka);
138
SCM_MISC_ERROR ("bad address", SCM_EOL);
139
return scm_from_ulong (ntohl (soka.s_addr));
144
SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0,
146
"Convert an IPv4 Internet address to a printable\n"
147
"(dotted decimal notation) string. E.g.,\n\n"
149
"(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
151
#define FUNC_NAME s_scm_inet_ntoa
156
addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid));
157
s = inet_ntoa (addr);
158
answer = scm_from_locale_string (s);
163
#ifdef HAVE_INET_NETOF
164
SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
166
"Return the network number part of the given IPv4\n"
167
"Internet address. E.g.,\n\n"
169
"(inet-netof 2130706433) @result{} 127\n"
171
#define FUNC_NAME s_scm_inet_netof
174
addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
175
return scm_from_ulong (inet_netof (addr));
180
#ifdef HAVE_INET_LNAOF
181
SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0,
183
"Return the local-address-with-network part of the given\n"
184
"IPv4 Internet address, using the obsolete class A/B/C system.\n"
187
"(inet-lnaof 2130706433) @result{} 1\n"
189
#define FUNC_NAME s_scm_lnaof
192
addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
193
return scm_from_ulong (inet_lnaof (addr));
198
#ifdef HAVE_INET_MAKEADDR
199
SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
201
"Make an IPv4 Internet address by combining the network number\n"
202
"@var{net} with the local-address-within-network number\n"
203
"@var{lna}. E.g.,\n\n"
205
"(inet-makeaddr 127 1) @result{} 2130706433\n"
207
#define FUNC_NAME s_scm_inet_makeaddr
210
unsigned long netnum;
211
unsigned long lnanum;
213
netnum = SCM_NUM2ULONG (1, net);
214
lnanum = SCM_NUM2ULONG (2, lna);
215
addr = inet_makeaddr (netnum, lnanum);
216
return scm_from_ulong (ntohl (addr.s_addr));
223
/* flip a 128 bit IPv6 address between host and network order. */
224
#ifdef WORDS_BIGENDIAN
225
#define FLIP_NET_HOST_128(addr)
227
#define FLIP_NET_HOST_128(addr)\
231
for (i = 0; i < 8; i++)\
233
scm_t_uint8 c = (addr)[i];\
235
(addr)[i] = (addr)[15 - i];\
241
#ifdef WORDS_BIGENDIAN
242
#define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
244
#define FLIPCPY_NET_HOST_128(dest, src) \
246
const scm_t_uint8 *tmp_srcp = (src) + 15; \
247
scm_t_uint8 *tmp_destp = (dest); \
250
*tmp_destp++ = *tmp_srcp--; \
251
} while (tmp_srcp != (src)); \
256
#if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
257
#error "Assumption that scm_t_bits <= 128 bits has been violated."
260
#if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
261
#error "Assumption that unsigned long <= 128 bits has been violated."
264
#if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
265
#error "Assumption that unsigned long long <= 128 bits has been violated."
268
/* convert a 128 bit IPv6 address in network order to a host ordered
271
scm_from_ipv6 (const scm_t_uint8 *src)
273
SCM result = scm_i_mkbig ();
274
mpz_import (SCM_I_BIG_MPZ (result),
276
1, /* big-endian chunk ordering */
277
16, /* chunks are 16 bytes long */
278
1, /* big-endian byte ordering */
279
0, /* "nails" -- leading unused bits per chunk */
281
return scm_i_normbig (result);
284
/* convert a host ordered SCM integer to a 128 bit IPv6 address in
287
scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
289
if (SCM_I_INUMP (src))
291
scm_t_signed_bits n = SCM_I_INUM (src);
293
scm_out_of_range (NULL, src);
294
#ifdef WORDS_BIGENDIAN
295
memset (dst, 0, 16 - sizeof (scm_t_signed_bits));
296
memcpy (dst + (16 - sizeof (scm_t_signed_bits)),
298
sizeof (scm_t_signed_bits));
300
memset (dst + sizeof (scm_t_signed_bits),
302
16 - sizeof (scm_t_signed_bits));
303
/* FIXME: this pair of ops is kinda wasteful -- should rewrite as
304
a single loop perhaps, similar to the handling of bignums. */
305
memcpy (dst, &n, sizeof (scm_t_signed_bits));
306
FLIP_NET_HOST_128 (dst);
309
else if (SCM_BIGP (src))
313
if ((mpz_sgn (SCM_I_BIG_MPZ (src)) < 0)
314
|| mpz_sizeinbase (SCM_I_BIG_MPZ (src), 2) > 128)
315
scm_out_of_range (NULL, src);
320
1, /* big-endian chunk ordering */
321
16, /* chunks are 16 bytes long */
322
1, /* big-endian byte ordering */
323
0, /* "nails" -- leading unused bits per chunk */
324
SCM_I_BIG_MPZ (src));
325
scm_remember_upto_here_1 (src);
328
scm_wrong_type_arg (NULL, 0, src);
331
#ifdef HAVE_INET_PTON
332
SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
333
(SCM family, SCM address),
334
"Convert a string containing a printable network address to\n"
335
"an integer address. Note that unlike the C version of this\n"
337
"the result is an integer with normal host byte ordering.\n"
338
"@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
340
"(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
341
"(inet-pton AF_INET6 \"::1\") @result{} 1\n"
343
#define FUNC_NAME s_scm_inet_pton
350
af = scm_to_int (family);
351
SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
352
src = scm_to_locale_string (address);
353
rv = inet_pton (af, src, dst);
360
SCM_MISC_ERROR ("Bad address", SCM_EOL);
362
return scm_from_ulong (ntohl (*(scm_t_uint32 *) dst));
364
return scm_from_ipv6 ((scm_t_uint8 *) dst);
369
#ifdef HAVE_INET_NTOP
370
SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
371
(SCM family, SCM address),
372
"Convert a network address into a printable string.\n"
373
"Note that unlike the C version of this function,\n"
374
"the input is an integer with normal host byte ordering.\n"
375
"@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
377
"(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
378
"(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
379
"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
381
#define FUNC_NAME s_scm_inet_ntop
384
#ifdef INET6_ADDRSTRLEN
385
char dst[INET6_ADDRSTRLEN];
391
af = scm_to_int (family);
392
SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
394
*(scm_t_uint32 *) addr6 = htonl (SCM_NUM2ULONG (2, address));
396
scm_to_ipv6 ((scm_t_uint8 *) addr6, address);
397
if (inet_ntop (af, &addr6, dst, sizeof dst) == NULL)
399
return scm_from_locale_string (dst);
404
#endif /* HAVE_IPV6 */
406
SCM_SYMBOL (sym_socket, "socket");
408
#define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
410
SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
411
(SCM family, SCM style, SCM proto),
412
"Return a new socket port of the type specified by @var{family},\n"
413
"@var{style} and @var{proto}. All three parameters are\n"
414
"integers. Supported values for @var{family} are\n"
415
"@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
416
"Typical values for @var{style} are @code{SOCK_STREAM},\n"
417
"@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
418
"@var{proto} can be obtained from a protocol name using\n"
419
"@code{getprotobyname}. A value of zero specifies the default\n"
420
"protocol, which is usually right.\n\n"
421
"A single socket port cannot by used for communication until it\n"
422
"has been connected to another socket.")
423
#define FUNC_NAME s_scm_socket
427
fd = socket (scm_to_int (family),
432
return SCM_SOCK_FD_TO_PORT (fd);
436
#ifdef HAVE_SOCKETPAIR
437
SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
438
(SCM family, SCM style, SCM proto),
439
"Return a pair of connected (but unnamed) socket ports of the\n"
440
"type specified by @var{family}, @var{style} and @var{proto}.\n"
441
"Many systems support only socket pairs of the @code{AF_UNIX}\n"
442
"family. Zero is likely to be the only meaningful value for\n"
444
#define FUNC_NAME s_scm_socketpair
449
fam = scm_to_int (family);
451
if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
454
return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
459
SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
460
(SCM sock, SCM level, SCM optname),
461
"Return an option value from socket port @var{sock}.\n"
463
"@var{level} is an integer specifying a protocol layer, either\n"
464
"@code{SOL_SOCKET} for socket level options, or a protocol\n"
465
"number from the @code{IPPROTO} constants or @code{getprotoent}\n"
466
"(@pxref{Network Databases}).\n"
468
"@defvar SOL_SOCKET\n"
469
"@defvarx IPPROTO_IP\n"
470
"@defvarx IPPROTO_TCP\n"
471
"@defvarx IPPROTO_UDP\n"
474
"@var{optname} is an integer specifying an option within the\n"
477
"For @code{SOL_SOCKET} level the following @var{optname}s are\n"
478
"defined (when provided by the system). For their meaning see\n"
479
"@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
480
"Manual}, or @command{man 7 socket}.\n"
483
"@defvarx SO_REUSEADDR\n"
484
"@defvarx SO_STYLE\n"
486
"@defvarx SO_ERROR\n"
487
"@defvarx SO_DONTROUTE\n"
488
"@defvarx SO_BROADCAST\n"
489
"@defvarx SO_SNDBUF\n"
490
"@defvarx SO_RCVBUF\n"
491
"@defvarx SO_KEEPALIVE\n"
492
"@defvarx SO_OOBINLINE\n"
493
"@defvarx SO_NO_CHECK\n"
494
"@defvarx SO_PRIORITY\n"
495
"The value returned is an integer.\n"
498
"@defvar SO_LINGER\n"
499
"The @var{value} returned is a pair of integers\n"
500
"@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
501
"timeout support (ie.@: without @code{struct linger}), only\n"
502
"@var{ENABLE} has an effect but the value in Guile is always a\n"
505
#define FUNC_NAME s_scm_getsockopt
508
/* size of optval is the largest supported option. */
509
#ifdef HAVE_STRUCT_LINGER
510
char optval[sizeof (struct linger)];
511
socklen_t optlen = sizeof (struct linger);
513
char optval[sizeof (size_t)];
514
socklen_t optlen = sizeof (size_t);
519
sock = SCM_COERCE_OUTPORT (sock);
520
SCM_VALIDATE_OPFPORT (1, sock);
521
ilevel = scm_to_int (level);
522
ioptname = scm_to_int (optname);
524
fd = SCM_FPORT_FDES (sock);
525
if (getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen) == -1)
528
if (ilevel == SOL_SOCKET)
531
if (ioptname == SO_LINGER)
533
#ifdef HAVE_STRUCT_LINGER
534
struct linger *ling = (struct linger *) optval;
536
return scm_cons (scm_from_long (ling->l_onoff),
537
scm_from_long (ling->l_linger));
539
return scm_cons (scm_from_long (*(int *) optval),
547
|| ioptname == SO_SNDBUF
550
|| ioptname == SO_RCVBUF
554
return scm_from_size_t (*(size_t *) optval);
557
return scm_from_int (*(int *) optval);
561
SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
562
(SCM sock, SCM level, SCM optname, SCM value),
563
"Set an option on socket port @var{sock}. The return value is\n"
566
"@var{level} is an integer specifying a protocol layer, either\n"
567
"@code{SOL_SOCKET} for socket level options, or a protocol\n"
568
"number from the @code{IPPROTO} constants or @code{getprotoent}\n"
569
"(@pxref{Network Databases}).\n"
571
"@defvar SOL_SOCKET\n"
572
"@defvarx IPPROTO_IP\n"
573
"@defvarx IPPROTO_TCP\n"
574
"@defvarx IPPROTO_UDP\n"
577
"@var{optname} is an integer specifying an option within the\n"
580
"For @code{SOL_SOCKET} level the following @var{optname}s are\n"
581
"defined (when provided by the system). For their meaning see\n"
582
"@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
583
"Manual}, or @command{man 7 socket}.\n"
586
"@defvarx SO_REUSEADDR\n"
587
"@defvarx SO_STYLE\n"
589
"@defvarx SO_ERROR\n"
590
"@defvarx SO_DONTROUTE\n"
591
"@defvarx SO_BROADCAST\n"
592
"@defvarx SO_SNDBUF\n"
593
"@defvarx SO_RCVBUF\n"
594
"@defvarx SO_KEEPALIVE\n"
595
"@defvarx SO_OOBINLINE\n"
596
"@defvarx SO_NO_CHECK\n"
597
"@defvarx SO_PRIORITY\n"
598
"@var{value} is an integer.\n"
601
"@defvar SO_LINGER\n"
602
"@var{value} is a pair of integers @code{(@var{ENABLE}\n"
603
". @var{TIMEOUT})}. On old systems without timeout support\n"
604
"(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
605
"effect but the value in Guile is always a pair.\n"
608
"@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
609
"@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
611
"For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
612
"are defined (when provided by the system). See @command{man\n"
613
"ip} for what they mean.\n"
615
"@defvar IP_ADD_MEMBERSHIP\n"
616
"@defvarx IP_DROP_MEMBERSHIP\n"
617
"These can be used only with @code{setsockopt}, not\n"
618
"@code{getsockopt}. @var{value} is a pair\n"
619
"@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
620
"addresses (@pxref{Network Address Conversion}).\n"
621
"@var{MULTIADDR} is a multicast address to be added to or\n"
622
"dropped from the interface @var{INTERFACEADDR}.\n"
623
"@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
624
"select the interface. @var{INTERFACEADDR} can also be an\n"
625
"interface index number, on systems supporting that.\n"
627
#define FUNC_NAME s_scm_setsockopt
632
#ifdef HAVE_STRUCT_LINGER
633
struct linger opt_linger;
636
#if HAVE_STRUCT_IP_MREQ
637
struct ip_mreq opt_mreq;
640
const void *optval = NULL;
641
socklen_t optlen = 0;
643
int ilevel, ioptname;
645
sock = SCM_COERCE_OUTPORT (sock);
647
SCM_VALIDATE_OPFPORT (1, sock);
648
ilevel = scm_to_int (level);
649
ioptname = scm_to_int (optname);
651
fd = SCM_FPORT_FDES (sock);
653
if (ilevel == SOL_SOCKET)
656
if (ioptname == SO_LINGER)
658
#ifdef HAVE_STRUCT_LINGER
659
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
660
opt_linger.l_onoff = scm_to_int (SCM_CAR (value));
661
opt_linger.l_linger = scm_to_int (SCM_CDR (value));
662
optlen = sizeof (struct linger);
663
optval = &opt_linger;
665
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
666
opt_int = scm_to_int (SCM_CAR (value));
667
/* timeout is ignored, but may as well validate it. */
668
scm_to_int (SCM_CDR (value));
669
optlen = sizeof (int);
677
|| ioptname == SO_SNDBUF
680
|| ioptname == SO_RCVBUF
684
opt_int = scm_to_int (value);
685
optlen = sizeof (size_t);
690
#if HAVE_STRUCT_IP_MREQ
691
if (ilevel == IPPROTO_IP &&
692
(ioptname == IP_ADD_MEMBERSHIP || ioptname == IP_DROP_MEMBERSHIP))
694
/* Fourth argument must be a pair of addresses. */
695
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
696
opt_mreq.imr_multiaddr.s_addr = htonl (scm_to_ulong (SCM_CAR (value)));
697
opt_mreq.imr_interface.s_addr = htonl (scm_to_ulong (SCM_CDR (value)));
698
optlen = sizeof (opt_mreq);
705
/* Most options take an int. */
706
opt_int = scm_to_int (value);
707
optlen = sizeof (int);
711
if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
713
return SCM_UNSPECIFIED;
717
SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
719
"Sockets can be closed simply by using @code{close-port}. The\n"
720
"@code{shutdown} procedure allows reception or transmission on a\n"
721
"connection to be shut down individually, according to the parameter\n"
725
"Stop receiving data for this socket. If further data arrives, reject it.\n"
727
"Stop trying to transmit data from this socket. Discard any\n"
728
"data waiting to be sent. Stop looking for acknowledgement of\n"
729
"data already sent; don't retransmit it if it is lost.\n"
731
"Stop both reception and transmission.\n"
733
"The return value is unspecified.")
734
#define FUNC_NAME s_scm_shutdown
737
sock = SCM_COERCE_OUTPORT (sock);
738
SCM_VALIDATE_OPFPORT (1, sock);
739
fd = SCM_FPORT_FDES (sock);
740
if (shutdown (fd, scm_to_signed_integer (how, 0, 2)) == -1)
742
return SCM_UNSPECIFIED;
746
/* convert fam/address/args into a sockaddr of the appropriate type.
747
args is modified by removing the arguments actually used.
748
which_arg and proc are used when reporting errors:
749
which_arg is the position of address in the original argument list.
750
proc is the name of the original procedure.
751
size returns the size of the structure allocated. */
753
static struct sockaddr *
754
scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
755
const char *proc, size_t *size)
756
#define FUNC_NAME proc
762
struct sockaddr_in *soka;
766
SCM_VALIDATE_ULONG_COPY (which_arg, address, addr);
767
SCM_VALIDATE_CONS (which_arg + 1, *args);
768
port = scm_to_int (SCM_CAR (*args));
769
*args = SCM_CDR (*args);
770
soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
772
#if HAVE_STRUCT_SOCKADDR_SIN_LEN
773
soka->sin_len = sizeof (struct sockaddr_in);
775
soka->sin_family = AF_INET;
776
soka->sin_addr.s_addr = htonl (addr);
777
soka->sin_port = htons (port);
778
*size = sizeof (struct sockaddr_in);
779
return (struct sockaddr *) soka;
786
struct sockaddr_in6 *soka;
787
unsigned long flowinfo = 0;
788
unsigned long scope_id = 0;
790
SCM_VALIDATE_CONS (which_arg + 1, *args);
791
port = scm_to_int (SCM_CAR (*args));
792
*args = SCM_CDR (*args);
793
if (scm_is_pair (*args))
795
SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
796
*args = SCM_CDR (*args);
797
if (scm_is_pair (*args))
799
SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
801
*args = SCM_CDR (*args);
804
soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
806
#if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
807
soka->sin6_len = sizeof (struct sockaddr_in6);
809
soka->sin6_family = AF_INET6;
810
scm_to_ipv6 (soka->sin6_addr.s6_addr, address);
811
soka->sin6_port = htons (port);
812
soka->sin6_flowinfo = flowinfo;
813
#ifdef HAVE_SIN6_SCOPE_ID
814
soka->sin6_scope_id = scope_id;
816
*size = sizeof (struct sockaddr_in6);
817
return (struct sockaddr *) soka;
820
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
823
struct sockaddr_un *soka;
827
scm_dynwind_begin (0);
829
c_address = scm_to_locale_string (address);
830
scm_dynwind_free (c_address);
832
/* the static buffer size in sockaddr_un seems to be arbitrary
833
and not necessarily a hard limit. e.g., the glibc manual
834
suggests it may be possible to declare it size 0. let's
835
ignore it. if the O/S doesn't like the size it will cause
836
connect/bind etc., to fail. sun_path is always the last
837
member of the structure. */
838
addr_size = sizeof (struct sockaddr_un)
839
+ max (0, strlen (c_address) + 1 - (sizeof soka->sun_path));
840
soka = (struct sockaddr_un *) scm_malloc (addr_size);
841
memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */
842
soka->sun_family = AF_UNIX;
843
strcpy (soka->sun_path, c_address);
844
*size = SUN_LEN (soka);
847
return (struct sockaddr *) soka;
851
scm_out_of_range (proc, scm_from_int (fam));
856
SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
857
(SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
858
"Initiate a connection from a socket using a specified address\n"
859
"family to the address\n"
860
"specified by @var{address} and possibly @var{args}.\n"
861
"The format required for @var{address}\n"
862
"and @var{args} depends on the family of the socket.\n\n"
863
"For a socket of family @code{AF_UNIX},\n"
864
"only @var{address} is specified and must be a string with the\n"
865
"filename where the socket is to be created.\n\n"
866
"For a socket of family @code{AF_INET},\n"
867
"@var{address} must be an integer IPv4 host address and\n"
868
"@var{args} must be a single integer port number.\n\n"
869
"For a socket of family @code{AF_INET6},\n"
870
"@var{address} must be an integer IPv6 host address and\n"
871
"@var{args} may be up to three integers:\n"
872
"port [flowinfo] [scope_id],\n"
873
"where flowinfo and scope_id default to zero.\n\n"
874
"Alternatively, the second argument can be a socket address object "
875
"as returned by @code{make-socket-address}, in which case the "
876
"no additional arguments should be passed.\n\n"
877
"The return value is unspecified.")
878
#define FUNC_NAME s_scm_connect
881
struct sockaddr *soka;
884
sock = SCM_COERCE_OUTPORT (sock);
885
SCM_VALIDATE_OPFPORT (1, sock);
886
fd = SCM_FPORT_FDES (sock);
888
if (address == SCM_UNDEFINED)
889
/* No third argument was passed to FAM_OR_SOCKADDR must actually be a
890
`socket address' object. */
891
soka = scm_to_sockaddr (fam_or_sockaddr, &size);
893
soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
894
&args, 3, FUNC_NAME, &size);
896
if (connect (fd, soka, size) == -1)
898
int save_errno = errno;
905
return SCM_UNSPECIFIED;
909
SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
910
(SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
911
"Assign an address to the socket port @var{sock}.\n"
912
"Generally this only needs to be done for server sockets,\n"
913
"so they know where to look for incoming connections. A socket\n"
914
"without an address will be assigned one automatically when it\n"
915
"starts communicating.\n\n"
916
"The format of @var{address} and @var{args} depends\n"
917
"on the family of the socket.\n\n"
918
"For a socket of family @code{AF_UNIX}, only @var{address}\n"
919
"is specified and must be a string with the filename where\n"
920
"the socket is to be created.\n\n"
921
"For a socket of family @code{AF_INET}, @var{address}\n"
922
"must be an integer IPv4 address and @var{args}\n"
923
"must be a single integer port number.\n\n"
924
"The values of the following variables can also be used for\n"
926
"@defvar INADDR_ANY\n"
927
"Allow connections from any address.\n"
929
"@defvar INADDR_LOOPBACK\n"
930
"The address of the local host using the loopback device.\n"
932
"@defvar INADDR_BROADCAST\n"
933
"The broadcast address on the local network.\n"
935
"@defvar INADDR_NONE\n"
938
"For a socket of family @code{AF_INET6}, @var{address}\n"
939
"must be an integer IPv6 address and @var{args}\n"
940
"may be up to three integers:\n"
941
"port [flowinfo] [scope_id],\n"
942
"where flowinfo and scope_id default to zero.\n\n"
943
"Alternatively, the second argument can be a socket address object "
944
"as returned by @code{make-socket-address}, in which case the "
945
"no additional arguments should be passed.\n\n"
946
"The return value is unspecified.")
947
#define FUNC_NAME s_scm_bind
949
struct sockaddr *soka;
953
sock = SCM_COERCE_OUTPORT (sock);
954
SCM_VALIDATE_OPFPORT (1, sock);
955
fd = SCM_FPORT_FDES (sock);
957
if (address == SCM_UNDEFINED)
958
/* No third argument was passed to FAM_OR_SOCKADDR must actually be a
959
`socket address' object. */
960
soka = scm_to_sockaddr (fam_or_sockaddr, &size);
962
soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
963
&args, 3, FUNC_NAME, &size);
966
if (bind (fd, soka, size) == -1)
968
int save_errno = errno;
975
return SCM_UNSPECIFIED;
979
SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
980
(SCM sock, SCM backlog),
981
"Enable @var{sock} to accept connection\n"
982
"requests. @var{backlog} is an integer specifying\n"
983
"the maximum length of the queue for pending connections.\n"
984
"If the queue fills, new clients will fail to connect until\n"
985
"the server calls @code{accept} to accept a connection from\n"
987
"The return value is unspecified.")
988
#define FUNC_NAME s_scm_listen
991
sock = SCM_COERCE_OUTPORT (sock);
992
SCM_VALIDATE_OPFPORT (1, sock);
993
fd = SCM_FPORT_FDES (sock);
994
if (listen (fd, scm_to_int (backlog)) == -1)
996
return SCM_UNSPECIFIED;
1000
/* Put the components of a sockaddr into a new SCM vector. */
1001
static SCM_C_INLINE_KEYWORD SCM
1002
_scm_from_sockaddr (const struct sockaddr *address, unsigned addr_size,
1005
short int fam = address->sa_family;
1006
SCM result =SCM_EOL;
1013
const struct sockaddr_in *nad = (struct sockaddr_in *) address;
1015
result = scm_c_make_vector (3, SCM_UNSPECIFIED);
1017
SCM_SIMPLE_VECTOR_SET(result, 0,
1018
scm_from_short (fam));
1019
SCM_SIMPLE_VECTOR_SET(result, 1,
1020
scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
1021
SCM_SIMPLE_VECTOR_SET(result, 2,
1022
scm_from_ushort (ntohs (nad->sin_port)));
1028
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
1030
result = scm_c_make_vector (5, SCM_UNSPECIFIED);
1031
SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
1032
SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
1033
SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
1034
SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
1035
#ifdef HAVE_SIN6_SCOPE_ID
1036
SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
1038
SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
1043
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
1046
const struct sockaddr_un *nad = (struct sockaddr_un *) address;
1048
result = scm_c_make_vector (2, SCM_UNSPECIFIED);
1050
SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
1051
/* When addr_size is not enough to cover sun_path, do not try
1053
if (addr_size <= offsetof (struct sockaddr_un, sun_path))
1054
SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
1056
SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
1061
result = SCM_UNSPECIFIED;
1062
scm_misc_error (proc, "unrecognised address family: ~A",
1063
scm_list_1 (scm_from_int (fam)));
1069
/* The publicly-visible function. Return a Scheme object representing
1070
ADDRESS, an address of ADDR_SIZE bytes. */
1072
scm_from_sockaddr (const struct sockaddr *address, unsigned addr_size)
1074
return (_scm_from_sockaddr (address, addr_size, "scm_from_sockaddr"));
1077
/* Convert ADDRESS, an address object returned by either
1078
`scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1079
representation. On success, a non-NULL pointer is returned and
1080
ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1081
address. The result must eventually be freed using `free ()'. */
1083
scm_to_sockaddr (SCM address, size_t *address_size)
1084
#define FUNC_NAME "scm_to_sockaddr"
1087
struct sockaddr *c_address = NULL;
1089
SCM_VALIDATE_VECTOR (1, address);
1092
family = scm_to_short (SCM_SIMPLE_VECTOR_REF (address, 0));
1098
if (SCM_SIMPLE_VECTOR_LENGTH (address) != 3)
1099
scm_misc_error (FUNC_NAME,
1100
"invalid inet address representation: ~A",
1101
scm_list_1 (address));
1104
struct sockaddr_in c_inet;
1106
c_inet.sin_addr.s_addr =
1107
htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 1)));
1109
htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
1110
c_inet.sin_family = AF_INET;
1112
*address_size = sizeof (c_inet);
1113
c_address = scm_malloc (sizeof (c_inet));
1114
memcpy (c_address, &c_inet, sizeof (c_inet));
1123
if (SCM_SIMPLE_VECTOR_LENGTH (address) != 5)
1124
scm_misc_error (FUNC_NAME, "invalid inet6 address representation: ~A",
1125
scm_list_1 (address));
1128
struct sockaddr_in6 c_inet6;
1130
scm_to_ipv6 (c_inet6.sin6_addr.s6_addr, address);
1132
htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
1133
c_inet6.sin6_flowinfo =
1134
scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address, 3));
1135
#ifdef HAVE_SIN6_SCOPE_ID
1136
c_inet6.sin6_scope_id =
1137
scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 4));
1140
c_inet6.sin6_family = AF_INET6;
1142
*address_size = sizeof (c_inet6);
1143
c_address = scm_malloc (sizeof (c_inet6));
1144
memcpy (c_address, &c_inet6, sizeof (c_inet6));
1151
#ifdef HAVE_UNIX_DOMAIN_SOCKETS
1154
if (SCM_SIMPLE_VECTOR_LENGTH (address) != 2)
1155
scm_misc_error (FUNC_NAME, "invalid unix address representation: ~A",
1156
scm_list_1 (address));
1160
size_t path_len = 0;
1162
path = SCM_SIMPLE_VECTOR_REF (address, 1);
1163
if ((!scm_is_string (path)) && (path != SCM_BOOL_F))
1164
scm_misc_error (FUNC_NAME, "invalid unix address "
1165
"path: ~A", scm_list_1 (path));
1168
struct sockaddr_un c_unix;
1170
if (path == SCM_BOOL_F)
1173
path_len = scm_c_string_length (path);
1175
#ifdef UNIX_PATH_MAX
1176
if (path_len >= UNIX_PATH_MAX)
1178
/* We can hope that this limit will eventually vanish, at least on GNU.
1179
However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1180
documents it has being limited to 108 bytes. */
1181
if (path_len >= sizeof (c_unix.sun_path))
1183
scm_misc_error (FUNC_NAME, "unix address path "
1184
"too long: ~A", scm_list_1 (path));
1189
scm_to_locale_stringbuf (path, c_unix.sun_path,
1190
#ifdef UNIX_PATH_MAX
1193
sizeof (c_unix.sun_path));
1195
c_unix.sun_path[path_len] = '\0';
1198
if (strlen (c_unix.sun_path) != path_len)
1199
scm_misc_error (FUNC_NAME, "unix address path "
1200
"contains nul characters: ~A",
1204
c_unix.sun_path[0] = '\0';
1206
c_unix.sun_family = AF_UNIX;
1208
*address_size = SUN_LEN (&c_unix);
1209
c_address = scm_malloc (sizeof (c_unix));
1210
memcpy (c_address, &c_unix, sizeof (c_unix));
1220
scm_misc_error (FUNC_NAME, "unrecognised address family: ~A",
1221
scm_list_1 (scm_from_ushort (family)));
1229
/* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1230
an address of family FAMILY, with the family-specific parameters ARGS (see
1231
the description of `connect' for details). The returned structure may be
1232
freed using `free ()'. */
1234
scm_c_make_socket_address (SCM family, SCM address, SCM args,
1235
size_t *address_size)
1237
struct sockaddr *soka;
1239
soka = scm_fill_sockaddr (scm_to_ushort (family), address, &args, 1,
1240
"scm_c_make_socket_address", address_size);
1245
SCM_DEFINE (scm_make_socket_address, "make-socket-address", 2, 0, 1,
1246
(SCM family, SCM address, SCM args),
1247
"Return a Scheme address object that reflects @var{address}, "
1248
"being an address of family @var{family}, with the "
1249
"family-specific parameters @var{args} (see the description of "
1250
"@code{connect} for details).")
1251
#define FUNC_NAME s_scm_make_socket_address
1253
struct sockaddr *c_address;
1254
size_t c_address_size;
1256
c_address = scm_c_make_socket_address (family, address, args,
1261
return (scm_from_sockaddr (c_address, c_address_size));
1266
/* calculate the size of a buffer large enough to hold any supported
1267
sockaddr type. if the buffer isn't large enough, certain system
1268
calls will return a truncated address. */
1270
#if defined (HAVE_UNIX_DOMAIN_SOCKETS)
1271
#define MAX_SIZE_UN sizeof (struct sockaddr_un)
1273
#define MAX_SIZE_UN 0
1276
#if defined (HAVE_IPV6)
1277
#define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
1279
#define MAX_SIZE_IN6 0
1282
#define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
1285
SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
1287
"Accept a connection on a bound, listening socket.\n"
1289
"are no pending connections in the queue, wait until\n"
1290
"one is available unless the non-blocking option has been\n"
1291
"set on the socket.\n\n"
1292
"The return value is a\n"
1293
"pair in which the @emph{car} is a new socket port for the\n"
1295
"the @emph{cdr} is an object with address information about the\n"
1296
"client which initiated the connection.\n\n"
1297
"@var{sock} does not become part of the\n"
1298
"connection and will continue to accept new requests.")
1299
#define FUNC_NAME s_scm_accept
1305
socklen_t addr_size = MAX_ADDR_SIZE;
1306
char max_addr[MAX_ADDR_SIZE];
1307
struct sockaddr *addr = (struct sockaddr *) max_addr;
1309
sock = SCM_COERCE_OUTPORT (sock);
1310
SCM_VALIDATE_OPFPORT (1, sock);
1311
fd = SCM_FPORT_FDES (sock);
1312
newfd = accept (fd, addr, &addr_size);
1315
newsock = SCM_SOCK_FD_TO_PORT (newfd);
1316
address = _scm_from_sockaddr (addr, addr_size, FUNC_NAME);
1317
return scm_cons (newsock, address);
1321
SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
1323
"Return the address of @var{sock}, in the same form as the\n"
1324
"object returned by @code{accept}. On many systems the address\n"
1325
"of a socket in the @code{AF_FILE} namespace cannot be read.")
1326
#define FUNC_NAME s_scm_getsockname
1329
socklen_t addr_size = MAX_ADDR_SIZE;
1330
char max_addr[MAX_ADDR_SIZE];
1331
struct sockaddr *addr = (struct sockaddr *) max_addr;
1333
sock = SCM_COERCE_OUTPORT (sock);
1334
SCM_VALIDATE_OPFPORT (1, sock);
1335
fd = SCM_FPORT_FDES (sock);
1336
if (getsockname (fd, addr, &addr_size) == -1)
1338
return _scm_from_sockaddr (addr, addr_size, FUNC_NAME);
1342
SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
1344
"Return the address that @var{sock}\n"
1345
"is connected to, in the same form as the object returned by\n"
1346
"@code{accept}. On many systems the address of a socket in the\n"
1347
"@code{AF_FILE} namespace cannot be read.")
1348
#define FUNC_NAME s_scm_getpeername
1351
socklen_t addr_size = MAX_ADDR_SIZE;
1352
char max_addr[MAX_ADDR_SIZE];
1353
struct sockaddr *addr = (struct sockaddr *) max_addr;
1355
sock = SCM_COERCE_OUTPORT (sock);
1356
SCM_VALIDATE_OPFPORT (1, sock);
1357
fd = SCM_FPORT_FDES (sock);
1358
if (getpeername (fd, addr, &addr_size) == -1)
1360
return _scm_from_sockaddr (addr, addr_size, FUNC_NAME);
1364
SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
1365
(SCM sock, SCM buf, SCM flags),
1366
"Receive data from a socket port.\n"
1367
"@var{sock} must already\n"
1368
"be bound to the address from which data is to be received.\n"
1369
"@var{buf} is a string into which\n"
1370
"the data will be written. The size of @var{buf} limits\n"
1372
"data which can be received: in the case of packet\n"
1373
"protocols, if a packet larger than this limit is encountered\n"
1375
"will be irrevocably lost.\n\n"
1376
"The optional @var{flags} argument is a value or\n"
1377
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1378
"The value returned is the number of bytes read from the\n"
1380
"Note that the data is read directly from the socket file\n"
1382
"any unread buffered port data is ignored.")
1383
#define FUNC_NAME s_scm_recv
1391
SCM_VALIDATE_OPFPORT (1, sock);
1392
SCM_VALIDATE_STRING (2, buf);
1393
if (SCM_UNBNDP (flags))
1396
flg = scm_to_int (flags);
1397
fd = SCM_FPORT_FDES (sock);
1399
len = scm_i_string_length (buf);
1400
dest = scm_i_string_writable_chars (buf);
1401
SCM_SYSCALL (rv = recv (fd, dest, len, flg));
1402
scm_i_string_stop_writing ();
1407
scm_remember_upto_here_1 (buf);
1408
return scm_from_int (rv);
1412
SCM_DEFINE (scm_send, "send", 2, 1, 0,
1413
(SCM sock, SCM message, SCM flags),
1414
"Transmit the string @var{message} on a socket port @var{sock}.\n"
1415
"@var{sock} must already be bound to a destination address. The\n"
1416
"value returned is the number of bytes transmitted --\n"
1417
"it's possible for\n"
1418
"this to be less than the length of @var{message}\n"
1419
"if the socket is\n"
1420
"set to be non-blocking. The optional @var{flags} argument\n"
1422
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1423
"Note that the data is written directly to the socket\n"
1424
"file descriptor:\n"
1425
"any unflushed buffered port data is ignored.")
1426
#define FUNC_NAME s_scm_send
1434
sock = SCM_COERCE_OUTPORT (sock);
1435
SCM_VALIDATE_OPFPORT (1, sock);
1436
SCM_VALIDATE_STRING (2, message);
1437
if (SCM_UNBNDP (flags))
1440
flg = scm_to_int (flags);
1441
fd = SCM_FPORT_FDES (sock);
1443
len = scm_i_string_length (message);
1444
src = scm_i_string_writable_chars (message);
1445
SCM_SYSCALL (rv = send (fd, src, len, flg));
1446
scm_i_string_stop_writing ();
1451
scm_remember_upto_here_1 (message);
1452
return scm_from_int (rv);
1456
SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
1457
(SCM sock, SCM str, SCM flags, SCM start, SCM end),
1458
"Receive data from socket port @var{sock} (which must be already\n"
1459
"bound), returning the originating address as well as the data.\n"
1460
"This is usually for use on datagram sockets, but can be used on\n"
1461
"stream-oriented sockets too.\n"
1463
"The data received is stored in the given @var{str}, using\n"
1464
"either the whole string or just the region between the optional\n"
1465
"@var{start} and @var{end} positions. The size of @var{str}\n"
1466
"limits the amount of data which can be received. For datagram\n"
1467
"protocols, if a packet larger than this is received then excess\n"
1468
"bytes are irrevocably lost.\n"
1470
"The return value is a pair. The @code{car} is the number of\n"
1471
"bytes read. The @code{cdr} is a socket address object which is\n"
1472
"where the data come from, or @code{#f} if the origin is\n"
1475
"The optional @var{flags} argument is a or bitwise OR\n"
1476
"(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1477
"@code{MSG_DONTROUTE} etc.\n"
1479
"Data is read directly from the socket file descriptor, any\n"
1480
"buffered port data is ignored.\n"
1482
"On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1483
"all threads stop while a @code{recvfrom!} call is in progress.\n"
1484
"An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1485
"or @code{MSG_DONTWAIT} to avoid this.")
1486
#define FUNC_NAME s_scm_recvfrom
1495
socklen_t addr_size = MAX_ADDR_SIZE;
1496
char max_addr[MAX_ADDR_SIZE];
1497
struct sockaddr *addr = (struct sockaddr *) max_addr;
1499
SCM_VALIDATE_OPFPORT (1, sock);
1500
fd = SCM_FPORT_FDES (sock);
1502
SCM_VALIDATE_STRING (2, str);
1503
scm_i_get_substring_spec (scm_i_string_length (str),
1504
start, &offset, end, &cend);
1506
if (SCM_UNBNDP (flags))
1509
SCM_VALIDATE_ULONG_COPY (3, flags, flg);
1511
/* recvfrom will not necessarily return an address. usually nothing
1512
is returned for stream sockets. */
1513
buf = scm_i_string_writable_chars (str);
1514
addr->sa_family = AF_UNSPEC;
1515
SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
1518
scm_i_string_stop_writing ();
1522
if (addr->sa_family != AF_UNSPEC)
1523
address = _scm_from_sockaddr (addr, addr_size, FUNC_NAME);
1525
address = SCM_BOOL_F;
1527
scm_remember_upto_here_1 (str);
1528
return scm_cons (scm_from_int (rv), address);
1532
SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
1533
(SCM sock, SCM message, SCM fam_or_sockaddr, SCM address, SCM args_and_flags),
1534
"Transmit the string @var{message} on the socket port\n"
1536
"destination address is specified using the @var{fam},\n"
1537
"@var{address} and\n"
1538
"@var{args_and_flags} arguments, or just a socket address object "
1539
"returned by @code{make-socket-address}, in a similar way to the\n"
1540
"@code{connect} procedure. @var{args_and_flags} contains\n"
1541
"the usual connection arguments optionally followed by\n"
1542
"a flags argument, which is a value or\n"
1543
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1544
"The value returned is the number of bytes transmitted --\n"
1545
"it's possible for\n"
1546
"this to be less than the length of @var{message} if the\n"
1548
"set to be non-blocking.\n"
1549
"Note that the data is written directly to the socket\n"
1550
"file descriptor:\n"
1551
"any unflushed buffered port data is ignored.")
1552
#define FUNC_NAME s_scm_sendto
1557
struct sockaddr *soka;
1560
sock = SCM_COERCE_OUTPORT (sock);
1561
SCM_VALIDATE_FPORT (1, sock);
1562
SCM_VALIDATE_STRING (2, message);
1563
fd = SCM_FPORT_FDES (sock);
1565
if (!scm_is_number (fam_or_sockaddr))
1567
/* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1568
means that the following arguments, i.e. ADDRESS and those listed in
1569
ARGS_AND_FLAGS, are the `MSG_' flags. */
1570
soka = scm_to_sockaddr (fam_or_sockaddr, &size);
1571
if (address != SCM_UNDEFINED)
1572
args_and_flags = scm_cons (address, args_and_flags);
1575
soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
1576
&args_and_flags, 3, FUNC_NAME, &size);
1578
if (scm_is_null (args_and_flags))
1582
SCM_VALIDATE_CONS (5, args_and_flags);
1583
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
1585
SCM_SYSCALL (rv = sendto (fd,
1586
scm_i_string_chars (message),
1587
scm_i_string_length (message),
1591
int save_errno = errno;
1598
scm_remember_upto_here_1 (message);
1599
return scm_from_int (rv);
1608
/* protocol families. */
1610
scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC));
1613
scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX));
1616
scm_c_define ("AF_INET", scm_from_int (AF_INET));
1619
scm_c_define ("AF_INET6", scm_from_int (AF_INET6));
1623
scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC));
1626
scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX));
1629
scm_c_define ("PF_INET", scm_from_int (PF_INET));
1632
scm_c_define ("PF_INET6", scm_from_int (PF_INET6));
1635
/* standard addresses. */
1637
scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY));
1639
#ifdef INADDR_BROADCAST
1640
scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST));
1643
scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE));
1645
#ifdef INADDR_LOOPBACK
1646
scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK));
1651
SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1652
packet(7) advise that it's obsolete and strongly deprecated. */
1655
scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM));
1658
scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM));
1660
#ifdef SOCK_SEQPACKET
1661
scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET));
1664
scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW));
1667
scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM));
1670
/* setsockopt level.
1672
SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1673
instance NetBSD. We define IPPROTOs because that's what the posix spec
1674
shows in its example at
1676
http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1679
scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET));
1682
scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP));
1685
scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP));
1688
scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP));
1691
/* setsockopt names. */
1693
scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG));
1696
scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR));
1699
scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE));
1702
scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE));
1705
scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR));
1708
scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE));
1711
scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST));
1714
scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF));
1717
scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF));
1720
scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE));
1723
scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE));
1726
scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK));
1729
scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY));
1732
scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER));
1735
/* recv/send options. */
1737
scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT));
1740
scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB));
1743
scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK));
1745
#ifdef MSG_DONTROUTE
1746
scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE));
1750
scm_i_init_socket_Win32 ();
1753
#ifdef IP_ADD_MEMBERSHIP
1754
scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
1755
scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
1758
scm_add_feature ("socket");
1760
#include "libguile/socket.x"
added
removed
libguile/socket.c
