* socket.c (scm_fill_sockaddr): don't allow buffer overflows when
[bpt/guile.git] / libguile / socket.c
1 /* Copyright (C) 1996,1997,1998, 2000 Free Software Foundation, Inc.
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
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
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.
40 * If you do not wish that, delete this exception notice. */
41
42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
43 gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
44
45 \f
46
47 #include <stdio.h>
48
49 #include "libguile/_scm.h"
50 #include "libguile/unif.h"
51 #include "libguile/feature.h"
52 #include "libguile/fports.h"
53 #include "libguile/strings.h"
54 #include "libguile/vectors.h"
55
56 #include "libguile/validate.h"
57 #include "libguile/socket.h"
58
59 #ifdef HAVE_STRING_H
60 #include <string.h>
61 #endif
62 #ifdef HAVE_UNISTD_H
63 #include <unistd.h>
64 #endif
65 #include <sys/types.h>
66 #include <sys/socket.h>
67 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
68 #include <sys/un.h>
69 #endif
70 #include <netinet/in.h>
71 #include <netdb.h>
72 #include <arpa/inet.h>
73
74 /* we are not currently using socklen_t. it's not defined on all systems,
75 so would need to be checked by configure. in the meantime, plain
76 int is the best alternative. */
77
78 \f
79
80 SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
81 (SCM in),
82 "Returns a new integer from @var{value} by converting from host to\n"
83 "network order. @var{value} must be within the range of a C unsigned\n"
84 "short integer.")
85 #define FUNC_NAME s_scm_htons
86 {
87 unsigned short c_in;
88
89 SCM_VALIDATE_INUM_COPY (1,in,c_in);
90 if (c_in != SCM_INUM (in))
91 SCM_OUT_OF_RANGE (1,in);
92
93 return SCM_MAKINUM (htons (c_in));
94 }
95 #undef FUNC_NAME
96
97 SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
98 (SCM in),
99 "Returns a new integer from @var{value} by converting from network to\n"
100 "host order. @var{value} must be within the range of a C unsigned short\n"
101 "integer.")
102 #define FUNC_NAME s_scm_ntohs
103 {
104 unsigned short c_in;
105
106 SCM_VALIDATE_INUM_COPY (1,in,c_in);
107 if (c_in != SCM_INUM (in))
108 SCM_OUT_OF_RANGE (1,in);
109
110 return SCM_MAKINUM (ntohs (c_in));
111 }
112 #undef FUNC_NAME
113
114 SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
115 (SCM in),
116 "Returns a new integer from @var{value} by converting from host to\n"
117 "network order. @var{value} must be within the range of a C unsigned\n"
118 "long integer.")
119 #define FUNC_NAME s_scm_htonl
120 {
121 unsigned long c_in = SCM_NUM2ULONG (1,in);
122 return scm_ulong2num (htonl (c_in));
123 }
124 #undef FUNC_NAME
125
126 SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
127 (SCM in),
128 "Returns a new integer from @var{value} by converting from network to\n"
129 "host order. @var{value} must be within the range of a C unsigned\n"
130 "long integer.")
131 #define FUNC_NAME s_scm_ntohl
132 {
133 unsigned long c_in = SCM_NUM2ULONG (1,in);
134 return scm_ulong2num (ntohl (c_in));
135 }
136 #undef FUNC_NAME
137
138 SCM_SYMBOL (sym_socket, "socket");
139
140 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
141
142 SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
143 (SCM family, SCM style, SCM proto),
144 "Returns a new socket port of the type specified by @var{family}, @var{style}\n"
145 "and @var{protocol}. All three parameters are integers. Typical values\n"
146 "for @var{family} are the values of @code{AF_UNIX}\n"
147 "and @code{AF_INET}. Typical values for @var{style} are\n"
148 "the values of @code{SOCK_STREAM}, @code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
149 "@var{protocol} can be obtained from a protocol name using\n"
150 "@code{getprotobyname}. A value of\n"
151 "zero specifies the default protocol, which is usually right.\n\n"
152 "A single socket port cannot by used for communication until\n"
153 "it has been connected to another socket.")
154 #define FUNC_NAME s_scm_socket
155 {
156 int fd;
157
158 SCM_VALIDATE_INUM (1, family);
159 SCM_VALIDATE_INUM (2, style);
160 SCM_VALIDATE_INUM (3, proto);
161 fd = socket (SCM_INUM (family), SCM_INUM (style), SCM_INUM (proto));
162 if (fd == -1)
163 SCM_SYSERROR;
164 return SCM_SOCK_FD_TO_PORT (fd);
165 }
166 #undef FUNC_NAME
167
168 #ifdef HAVE_SOCKETPAIR
169 SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
170 (SCM family, SCM style, SCM proto),
171 "Returns a pair of connected (but unnamed) socket ports of the type specified\n"
172 "by @var{family}, @var{style} and @var{protocol}.\n"
173 "Many systems support only\n"
174 "socket pairs of the @code{AF_UNIX} family. Zero is likely to be\n"
175 "the only meaningful value for @var{protocol}.")
176 #define FUNC_NAME s_scm_socketpair
177 {
178 int fam;
179 int fd[2];
180
181 SCM_VALIDATE_INUM (1,family);
182 SCM_VALIDATE_INUM (2,style);
183 SCM_VALIDATE_INUM (3,proto);
184
185 fam = SCM_INUM (family);
186
187 if (socketpair (fam, SCM_INUM (style), SCM_INUM (proto), fd) == -1)
188 SCM_SYSERROR;
189
190 return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
191 }
192 #undef FUNC_NAME
193 #endif
194
195 SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
196 (SCM sock, SCM level, SCM optname),
197 "Returns the value of a particular socket option for the socket\n"
198 "port @var{socket}. @var{level} is an integer code for type of option\n"
199 "being requested, e.g., @code{SOL_SOCKET} for socket-level options.\n"
200 "@var{optname} is an\n"
201 "integer code for the option required and should be specified using one of\n"
202 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
203 "The returned value is typically an integer but @code{SO_LINGER} returns a\n"
204 "pair of integers.")
205 #define FUNC_NAME s_scm_getsockopt
206 {
207 int fd;
208 /* size of optval is the largest supported option. */
209 #ifdef HAVE_STRUCT_LINGER
210 char optval[sizeof (struct linger)];
211 int optlen = sizeof (struct linger);
212 #else
213 char optval[sizeof (scm_sizet)];
214 int optlen = sizeof (scm_sizet);
215 #endif
216 int ilevel;
217 int ioptname;
218
219 sock = SCM_COERCE_OUTPORT (sock);
220 SCM_VALIDATE_OPFPORT (1, sock);
221 SCM_VALIDATE_INUM_COPY (2, level, ilevel);
222 SCM_VALIDATE_INUM_COPY (3, optname, ioptname);
223
224 fd = SCM_FPORT_FDES (sock);
225 if (getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen) == -1)
226 SCM_SYSERROR;
227
228 if (ilevel == SOL_SOCKET)
229 {
230 #ifdef SO_LINGER
231 if (ioptname == SO_LINGER)
232 {
233 #ifdef HAVE_STRUCT_LINGER
234 struct linger *ling = (struct linger *) optval;
235
236 return scm_cons (scm_long2num (ling->l_onoff),
237 scm_long2num (ling->l_linger));
238 #else
239 return scm_cons (scm_long2num (*(int *) optval)
240 SCM_MAKINUM (0));
241 #endif
242 }
243 else
244 #endif
245 if (0
246 #ifdef SO_SNDBUF
247 || ioptname == SO_SNDBUF
248 #endif
249 #ifdef SO_RCVBUF
250 || ioptname == SO_RCVBUF
251 #endif
252 )
253 {
254 return scm_long2num (*(scm_sizet *) optval);
255 }
256 }
257 return scm_long2num (*(int *) optval);
258 }
259 #undef FUNC_NAME
260
261 SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
262 (SCM sock, SCM level, SCM optname, SCM value),
263 "Sets the value of a particular socket option for the socket\n"
264 "port @var{socket}. @var{level} is an integer code for type of option\n"
265 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
266 "@var{optname} is an\n"
267 "integer code for the option to set and should be specified using one of\n"
268 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
269 "@var{value} is the value to which the option should be set. For\n"
270 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
271 "be a pair.\n\n"
272 "The return value is unspecified.")
273 #define FUNC_NAME s_scm_setsockopt
274 {
275 int fd;
276 int optlen = -1;
277 /* size of optval is the largest supported option. */
278 #ifdef HAVE_STRUCT_LINGER
279 char optval[sizeof (struct linger)];
280 #else
281 char optval[sizeof (scm_sizet)];
282 #endif
283 int ilevel, ioptname;
284
285 sock = SCM_COERCE_OUTPORT (sock);
286
287 SCM_VALIDATE_OPFPORT (1, sock);
288 SCM_VALIDATE_INUM_COPY (2, level, ilevel);
289 SCM_VALIDATE_INUM_COPY (3, optname, ioptname);
290
291 fd = SCM_FPORT_FDES (sock);
292
293 if (ilevel == SOL_SOCKET)
294 {
295 #ifdef SO_LINGER
296 if (ioptname == SO_LINGER)
297 {
298 #ifdef HAVE_STRUCT_LINGER
299 struct linger ling;
300 long lv;
301
302 SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME);
303 lv = SCM_NUM2LONG (4, SCM_CAR (value));
304 ling.l_onoff = (int) lv;
305 SCM_ASSERT_RANGE (SCM_ARG4, value, ling.l_onoff == lv);
306 lv = SCM_NUM2LONG (4, SCM_CDR (value));
307 ling.l_linger = (int) lv;
308 SCM_ASSERT_RANGE (SCM_ARG4, value, ling.l_linger == lv);
309 optlen = (int) sizeof (struct linger);
310 memcpy (optval, (void *) &ling, optlen);
311 #else
312 int ling;
313 long lv;
314
315 SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME);
316 /* timeout is ignored, but may as well validate it. */
317 lv = SCM_NUM2LONG (4, SCM_CDR (value));
318 ling = (int) lv;
319 SCM_ASSERT_RANGE (SCM_ARG4, value, ling == lv);
320 lv = SCM_NUM2LONG (4, SCM_CAR (value));
321 ling = (int) lv;
322 SCM_ASSERT_RANGE (SCM_ARG4, value, ling == lv);
323 optlen = (int) sizeof (int);
324 (*(int *) optval) = ling;
325 #endif
326 }
327 else
328 #endif
329 if (0
330 #ifdef SO_SNDBUF
331 || ioptname == SO_SNDBUF
332 #endif
333 #ifdef SO_RCVBUF
334 || ioptname == SO_RCVBUF
335 #endif
336 )
337 {
338 long lv = SCM_NUM2LONG (4, value);
339
340 optlen = (int) sizeof (scm_sizet);
341 (*(scm_sizet *) optval) = (scm_sizet) lv;
342 }
343 }
344 if (optlen == -1)
345 {
346 /* Most options take an int. */
347 long lv = SCM_NUM2LONG (4, value);
348 int val = (int) lv;
349
350 SCM_ASSERT_RANGE (SCM_ARG4, value, val == lv);
351 optlen = (int) sizeof (int);
352 (*(int *) optval) = val;
353 }
354 if (setsockopt (fd, ilevel, ioptname, (void *) optval, optlen) == -1)
355 SCM_SYSERROR;
356 return SCM_UNSPECIFIED;
357 }
358 #undef FUNC_NAME
359
360 SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
361 (SCM sock, SCM how),
362 "Sockets can be closed simply by using @code{close-port}. The\n"
363 "@code{shutdown} procedure allows reception or tranmission on a\n"
364 "connection to be shut down individually, according to the parameter\n"
365 "@var{how}:\n\n"
366 "@table @asis\n"
367 "@item 0\n"
368 "Stop receiving data for this socket. If further data arrives, reject it.\n"
369 "@item 1\n"
370 "Stop trying to transmit data from this socket. Discard any\n"
371 "data waiting to be sent. Stop looking for acknowledgement of\n"
372 "data already sent; don't retransmit it if it is lost.\n"
373 "@item 2\n"
374 "Stop both reception and transmission.\n"
375 "@end table\n\n"
376 "The return value is unspecified.")
377 #define FUNC_NAME s_scm_shutdown
378 {
379 int fd;
380 sock = SCM_COERCE_OUTPORT (sock);
381 SCM_VALIDATE_OPFPORT (1,sock);
382 SCM_VALIDATE_INUM (2,how);
383 SCM_ASSERT_RANGE(2,how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how));
384 fd = SCM_FPORT_FDES (sock);
385 if (shutdown (fd, SCM_INUM (how)) == -1)
386 SCM_SYSERROR;
387 return SCM_UNSPECIFIED;
388 }
389 #undef FUNC_NAME
390
391 /* convert fam/address/args into a sockaddr of the appropriate type.
392 args is modified by removing the arguments actually used.
393 which_arg and proc are used when reporting errors:
394 which_arg is the position of address in the original argument list.
395 proc is the name of the original procedure.
396 size returns the size of the structure allocated. */
397
398 static struct sockaddr *
399 scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
400 const char *proc, int *size)
401 {
402 switch (fam)
403 {
404 case AF_INET:
405 {
406 SCM isport;
407 struct sockaddr_in *soka;
408
409 SCM_ASSERT (SCM_CONSP (*args), *args,
410 which_arg + 1, proc);
411 isport = SCM_CAR (*args);
412 SCM_ASSERT (SCM_INUMP (isport), isport, which_arg + 1, proc);
413 soka = (struct sockaddr_in *) malloc (sizeof (struct sockaddr_in));
414 if (!soka)
415 scm_memory_error (proc);
416 /* e.g., for BSDs which don't like invalid sin_len. */
417 memset (soka, 0, sizeof (struct sockaddr_in));
418 soka->sin_family = AF_INET;
419 soka->sin_addr.s_addr =
420 htonl (scm_num2ulong (address, (char *) which_arg, proc));
421 *args = SCM_CDR (*args);
422 soka->sin_port = htons (SCM_INUM (isport));
423 *size = sizeof (struct sockaddr_in);
424 return (struct sockaddr *) soka;
425 }
426 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
427 case AF_UNIX:
428 {
429 struct sockaddr_un *soka;
430 int addr_size;
431
432 SCM_ASSERT (SCM_STRINGP (address), address, which_arg, proc);
433 /* the static buffer size in sockaddr_un seems to be arbitrary
434 and not necessarily a hard limit. e.g., the glibc manual
435 suggests it may be possible to declare it size 0. let's
436 ignore it. if the O/S doesn't like the size it will cause
437 connect/bind etc., to fail. sun_path is always the last
438 member of the structure. */
439 addr_size = sizeof (struct sockaddr_un)
440 + max (0, SCM_STRING_LENGTH (address) + 1 - (sizeof soka->sun_path));
441 soka = (struct sockaddr_un *) malloc (addr_size);
442 if (!soka)
443 scm_memory_error (proc);
444 memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */
445 soka->sun_family = AF_UNIX;
446 memcpy (soka->sun_path, SCM_STRING_CHARS (address),
447 SCM_STRING_LENGTH (address));
448 *size = SUN_LEN (soka);
449 return (struct sockaddr *) soka;
450 }
451 #endif
452 default:
453 scm_out_of_range (proc, SCM_MAKINUM (fam));
454 }
455 }
456
457 SCM_DEFINE (scm_connect, "connect", 3, 0, 1,
458 (SCM sock, SCM fam, SCM address, SCM args),
459 "Initiates a connection from @var{socket} to the address\n"
460 "specified by @var{address} and possibly @var{arg @dots{}}. The format\n"
461 "required for @var{address}\n"
462 "and @var{arg} @dots{} depends on the family of the socket.\n\n"
463 "For a socket of family @code{AF_UNIX},\n"
464 "only @code{address} is specified and must be a string with the\n"
465 "filename where the socket is to be created.\n\n"
466 "For a socket of family @code{AF_INET},\n"
467 "@code{address} must be an integer Internet host address and @var{arg} @dots{}\n"
468 "must be a single integer port number.\n\n"
469 "The return value is unspecified.")
470 #define FUNC_NAME s_scm_connect
471 {
472 int fd;
473 struct sockaddr *soka;
474 int size;
475
476 sock = SCM_COERCE_OUTPORT (sock);
477 SCM_VALIDATE_OPFPORT (1,sock);
478 SCM_VALIDATE_INUM (2,fam);
479 fd = SCM_FPORT_FDES (sock);
480 soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, FUNC_NAME,
481 &size);
482 if (connect (fd, soka, size) == -1)
483 {
484 int save_errno = errno;
485
486 free (soka);
487 errno = save_errno;
488 SCM_SYSERROR;
489 }
490 free (soka);
491 return SCM_UNSPECIFIED;
492 }
493 #undef FUNC_NAME
494
495 SCM_DEFINE (scm_bind, "bind", 3, 0, 1,
496 (SCM sock, SCM fam, SCM address, SCM args),
497 "Assigns an address to the socket port @var{socket}.\n"
498 "Generally this only needs to be done for server sockets,\n"
499 "so they know where to look for incoming connections. A socket\n"
500 "without an address will be assigned one automatically when it\n"
501 "starts communicating.\n\n"
502 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
503 "of the socket.\n\n"
504 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
505 "is specified and must \n"
506 "be a string with the filename where the socket is to be created.\n\n"
507 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
508 "Internet host address and @var{arg} @dots{} must be a single integer\n"
509 "port number.\n\n"
510 "The values of the following variables can also be used for @var{address}:\n\n"
511 "@defvar INADDR_ANY\n"
512 "Allow connections from any address.\n"
513 "@end defvar\n\n"
514 "@defvar INADDR_LOOPBACK\n"
515 "The address of the local host using the loopback device.\n"
516 "@end defvar\n\n"
517 "@defvar INADDR_BROADCAST\n"
518 "The broadcast address on the local network.\n"
519 "@end defvar\n\n"
520 "@defvar INADDR_NONE\n"
521 "No address.\n"
522 "@end defvar\n\n"
523 "The return value is unspecified.")
524 #define FUNC_NAME s_scm_bind
525 {
526 struct sockaddr *soka;
527 int size;
528 int fd;
529
530 sock = SCM_COERCE_OUTPORT (sock);
531 SCM_VALIDATE_OPFPORT (1, sock);
532 SCM_VALIDATE_INUM (2, fam);
533 soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, FUNC_NAME,
534 &size);
535 fd = SCM_FPORT_FDES (sock);
536 if (bind (fd, soka, size) == -1)
537 {
538 int save_errno = errno;
539
540 free (soka);
541 errno = save_errno;
542 SCM_SYSERROR;
543 }
544 free (soka);
545 return SCM_UNSPECIFIED;
546 }
547 #undef FUNC_NAME
548
549 SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
550 (SCM sock, SCM backlog),
551 "This procedure enables @var{socket} to accept connection\n"
552 "requests. @var{backlog} is an integer specifying\n"
553 "the maximum length of the queue for pending connections.\n"
554 "If the queue fills, new clients will fail to connect until the\n"
555 "server calls @code{accept} to accept a connection from the queue.\n\n"
556 "The return value is unspecified.")
557 #define FUNC_NAME s_scm_listen
558 {
559 int fd;
560 sock = SCM_COERCE_OUTPORT (sock);
561 SCM_VALIDATE_OPFPORT (1,sock);
562 SCM_VALIDATE_INUM (2,backlog);
563 fd = SCM_FPORT_FDES (sock);
564 if (listen (fd, SCM_INUM (backlog)) == -1)
565 SCM_SYSERROR;
566 return SCM_UNSPECIFIED;
567 }
568 #undef FUNC_NAME
569
570 /* Put the components of a sockaddr into a new SCM vector. */
571 static SCM
572 scm_addr_vector (struct sockaddr *address, const char *proc)
573 {
574 short int fam = address->sa_family;
575 SCM result;
576 SCM *ve;
577
578 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
579 if (fam == AF_UNIX)
580 {
581 struct sockaddr_un *nad = (struct sockaddr_un *) address;
582
583 result = scm_c_make_vector (2, SCM_UNSPECIFIED);
584 ve = SCM_VELTS (result);
585 ve[0] = scm_ulong2num ((unsigned long) fam);
586 ve[1] = scm_makfromstr (nad->sun_path,
587 (scm_sizet) strlen (nad->sun_path), 0);
588 }
589 else
590 #endif
591 if (fam == AF_INET)
592 {
593 struct sockaddr_in *nad = (struct sockaddr_in *) address;
594
595 result = scm_c_make_vector (3, SCM_UNSPECIFIED);
596 ve = SCM_VELTS (result);
597 ve[0] = scm_ulong2num ((unsigned long) fam);
598 ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr));
599 ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port));
600 }
601 else
602 scm_misc_error (proc, "Unrecognised address family: ~A",
603 scm_listify (SCM_MAKINUM (fam), SCM_UNDEFINED));
604
605 return result;
606 }
607
608 /* calculate the size of a buffer large enough to hold any supported
609 sockaddr type. if the buffer isn't large enough, certain system
610 calls will return a truncated address. */
611
612 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
613 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
614 #else
615 #define MAX_SIZE_UN 0
616 #endif
617
618 #define MAX_ADDR_SIZE max (sizeof (struct sockaddr_in), MAX_SIZE_UN)
619
620 SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
621 (SCM sock),
622 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
623 "are no pending connections in the queue, it waits until\n"
624 "one is available unless the non-blocking option has been set on the\n"
625 "socket.\n\n"
626 "The return value is a\n"
627 "pair in which the CAR is a new socket port for the connection and\n"
628 "the CDR is an object with address information about the client which\n"
629 "initiated the connection.\n\n"
630 "If the address is not available then the CDR will be an empty vector.\n\n"
631 "@var{socket} does not become part of the\n"
632 "connection and will continue to accept new requests.")
633 #define FUNC_NAME s_scm_accept
634 {
635 int fd;
636 int newfd;
637 SCM address;
638 SCM newsock;
639 int addr_size = MAX_ADDR_SIZE;
640 char max_addr[MAX_ADDR_SIZE];
641 struct sockaddr *addr = (struct sockaddr *) max_addr;
642
643 sock = SCM_COERCE_OUTPORT (sock);
644 SCM_VALIDATE_OPFPORT (1, sock);
645 fd = SCM_FPORT_FDES (sock);
646 newfd = accept (fd, addr, &addr_size);
647 if (newfd == -1)
648 SCM_SYSERROR;
649 newsock = SCM_SOCK_FD_TO_PORT (newfd);
650 if (addr_size > 0)
651 address = scm_addr_vector (addr, FUNC_NAME);
652 else
653 address = SCM_BOOL_F;
654
655 return scm_cons (newsock, address);
656 }
657 #undef FUNC_NAME
658
659 SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
660 (SCM sock),
661 "Returns the address of @var{socket}, in the same form as the object\n"
662 "returned by @code{accept}. On many systems the address of a socket\n"
663 "in the @code{AF_FILE} namespace cannot be read.")
664 #define FUNC_NAME s_scm_getsockname
665 {
666 int fd;
667 SCM result;
668 int addr_size = MAX_ADDR_SIZE;
669 char max_addr[MAX_ADDR_SIZE];
670 struct sockaddr *addr = (struct sockaddr *) max_addr;
671
672 sock = SCM_COERCE_OUTPORT (sock);
673 SCM_VALIDATE_OPFPORT (1,sock);
674 fd = SCM_FPORT_FDES (sock);
675 if (getsockname (fd, addr, &addr_size) == -1)
676 SCM_SYSERROR;
677 if (addr_size > 0)
678 result = scm_addr_vector (addr, FUNC_NAME);
679 else
680 result = SCM_BOOL_F;
681 return result;
682 }
683 #undef FUNC_NAME
684
685 SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
686 (SCM sock),
687 "Returns the address of the socket that the socket @var{socket} is connected to,\n"
688 "in the same form as the object\n"
689 "returned by @code{accept}. On many systems the address of a socket\n"
690 "in the @code{AF_FILE} namespace cannot be read.")
691 #define FUNC_NAME s_scm_getpeername
692 {
693 int fd;
694 SCM result;
695 int addr_size = MAX_ADDR_SIZE;
696 char max_addr[MAX_ADDR_SIZE];
697 struct sockaddr *addr = (struct sockaddr *) max_addr;
698
699 sock = SCM_COERCE_OUTPORT (sock);
700 SCM_VALIDATE_OPFPORT (1,sock);
701 fd = SCM_FPORT_FDES (sock);
702 if (getpeername (fd, addr, &addr_size) == -1)
703 SCM_SYSERROR;
704 if (addr_size > 0)
705 result = scm_addr_vector (addr, FUNC_NAME);
706 else
707 result = SCM_BOOL_F;
708 return result;
709 }
710 #undef FUNC_NAME
711
712 SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
713 (SCM sock, SCM buf, SCM flags),
714 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
715 "be bound to the address from which data is to be received.\n"
716 "@var{buf} is a string into which\n"
717 "the data will be written. The size of @var{buf} limits the amount of\n"
718 "data which can be received: in the case of packet\n"
719 "protocols, if a packet larger than this limit is encountered then some data\n"
720 "will be irrevocably lost.\n\n"
721 "The optional @var{flags} argument is a value or\n"
722 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
723 "The value returned is the number of bytes read from the socket.\n\n"
724 "Note that the data is read directly from the socket file descriptor:\n"
725 "any unread buffered port data is ignored.")
726 #define FUNC_NAME s_scm_recv
727 {
728 int rv;
729 int fd;
730 int flg;
731
732 SCM_VALIDATE_OPFPORT (1,sock);
733 SCM_VALIDATE_STRING (2,buf);
734 SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg);
735 fd = SCM_FPORT_FDES (sock);
736
737 SCM_SYSCALL (rv = recv (fd, SCM_STRING_CHARS (buf), SCM_STRING_LENGTH (buf), flg));
738 if (rv == -1)
739 SCM_SYSERROR;
740
741 return SCM_MAKINUM (rv);
742 }
743 #undef FUNC_NAME
744
745 SCM_DEFINE (scm_send, "send", 2, 1, 0,
746 (SCM sock, SCM message, SCM flags),
747 "Transmits the string @var{message} on the socket port @var{socket}. \n"
748 "@var{socket} must already be bound to a destination address. The\n"
749 "value returned is the number of bytes transmitted -- it's possible for\n"
750 "this to be less than the length of @var{message} if the socket is\n"
751 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
752 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
753 "Note that the data is written directly to the socket file descriptor:\n"
754 "any unflushed buffered port data is ignored.")
755 #define FUNC_NAME s_scm_send
756 {
757 int rv;
758 int fd;
759 int flg;
760
761 sock = SCM_COERCE_OUTPORT (sock);
762 SCM_VALIDATE_OPFPORT (1,sock);
763 SCM_VALIDATE_STRING (2, message);
764 SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg);
765 fd = SCM_FPORT_FDES (sock);
766
767 SCM_SYSCALL (rv = send (fd, SCM_STRING_CHARS (message), SCM_STRING_LENGTH (message), flg));
768 if (rv == -1)
769 SCM_SYSERROR;
770 return SCM_MAKINUM (rv);
771 }
772 #undef FUNC_NAME
773
774 SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
775 (SCM sock, SCM str, SCM flags, SCM start, SCM end),
776 "Returns data from the socket port @var{socket} and also information about\n"
777 "where the data was received from. @var{socket} must already\n"
778 "be bound to the address from which data is to be received.\n"
779 "@code{str}, is a string into which\n"
780 "the data will be written. The size of @var{str} limits the amount of\n"
781 "data which can be received: in the case of packet\n"
782 "protocols, if a packet larger than this limit is encountered then some data\n"
783 "will be irrevocably lost.\n\n"
784 "The optional @var{flags} argument is a value or\n"
785 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
786 "The value returned is a pair: the CAR is the number of bytes read from\n"
787 "the socket and the CDR an address object in the same form as returned by\n"
788 "@code{accept}.\n\n"
789 "The @var{start} and @var{end} arguments specify a substring of @var{str}\n"
790 "to which the data should be written.\n\n"
791 "Note that the data is read directly from the socket file descriptor:\n"
792 "any unread buffered port data is ignored.")
793 #define FUNC_NAME s_scm_recvfrom
794 {
795 int rv;
796 int fd;
797 int flg;
798 char *buf;
799 int offset;
800 int cend;
801 SCM address;
802 int addr_size = MAX_ADDR_SIZE;
803 char max_addr[MAX_ADDR_SIZE];
804 struct sockaddr *addr = (struct sockaddr *) max_addr;
805
806 SCM_VALIDATE_OPFPORT (1,sock);
807 fd = SCM_FPORT_FDES (sock);
808 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 4, start, offset,
809 5, end, cend);
810 if (SCM_UNBNDP (flags))
811 flg = 0;
812 else
813 SCM_VALIDATE_ULONG_COPY (3, flags, flg);
814
815 /* recvfrom will not necessarily return an address. e.g., linux
816 2.4.2 doesn't change addr or addr_size if socket is
817 AF_INET/SOCK_STREAM. */
818 addr->sa_family = AF_UNSPEC;
819 SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
820 cend - offset, flg,
821 addr, &addr_size));
822 if (rv == -1)
823 SCM_SYSERROR;
824 if (addr_size > 0 && addr->sa_family != AF_UNSPEC)
825 address = scm_addr_vector (addr, FUNC_NAME);
826 else
827 address = SCM_BOOL_F;
828
829 return scm_cons (SCM_MAKINUM (rv), address);
830 }
831 #undef FUNC_NAME
832
833 SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
834 (SCM sock, SCM message, SCM fam, SCM address, SCM args_and_flags),
835 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
836 "destination address is specified using the @var{family}, @var{address} and\n"
837 "@var{arg} arguments, in a similar way to the @code{connect}\n"
838 "procedure. The\n"
839 "value returned is the number of bytes transmitted -- it's possible for\n"
840 "this to be less than the length of @var{message} if the socket is\n"
841 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
842 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
843 "Note that the data is written directly to the socket file descriptor:\n"
844 "any unflushed buffered port data is ignored.")
845 #define FUNC_NAME s_scm_sendto
846 {
847 int rv;
848 int fd;
849 int flg;
850 struct sockaddr *soka;
851 int size;
852
853 sock = SCM_COERCE_OUTPORT (sock);
854 SCM_VALIDATE_FPORT (1,sock);
855 SCM_VALIDATE_STRING (2, message);
856 SCM_VALIDATE_INUM (3,fam);
857 fd = SCM_FPORT_FDES (sock);
858 soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4,
859 FUNC_NAME, &size);
860 if (SCM_NULLP (args_and_flags))
861 flg = 0;
862 else
863 {
864 SCM_VALIDATE_CONS (5,args_and_flags);
865 flg = SCM_NUM2ULONG (5,SCM_CAR (args_and_flags));
866 }
867 SCM_SYSCALL (rv = sendto (fd, SCM_STRING_CHARS (message),
868 SCM_STRING_LENGTH (message),
869 flg, soka, size));
870 if (rv == -1)
871 {
872 int save_errno = errno;
873 free (soka);
874 errno = save_errno;
875 SCM_SYSERROR;
876 }
877 free (soka);
878 return SCM_MAKINUM (rv);
879 }
880 #undef FUNC_NAME
881 \f
882
883
884 void
885 scm_init_socket ()
886 {
887 /* protocol families. */
888 #ifdef AF_UNSPEC
889 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC));
890 #endif
891 #ifdef AF_UNIX
892 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX));
893 #endif
894 #ifdef AF_INET
895 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET));
896 #endif
897
898 #ifdef PF_UNSPEC
899 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC));
900 #endif
901 #ifdef PF_UNIX
902 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX));
903 #endif
904 #ifdef PF_INET
905 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET));
906 #endif
907
908 /* socket types. */
909 #ifdef SOCK_STREAM
910 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM));
911 #endif
912 #ifdef SOCK_DGRAM
913 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM));
914 #endif
915 #ifdef SOCK_RAW
916 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW));
917 #endif
918
919 /* setsockopt level. */
920 #ifdef SOL_SOCKET
921 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET));
922 #endif
923 #ifdef SOL_IP
924 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP));
925 #endif
926 #ifdef SOL_TCP
927 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP));
928 #endif
929 #ifdef SOL_UDP
930 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP));
931 #endif
932
933 /* setsockopt names. */
934 #ifdef SO_DEBUG
935 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG));
936 #endif
937 #ifdef SO_REUSEADDR
938 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR));
939 #endif
940 #ifdef SO_STYLE
941 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE));
942 #endif
943 #ifdef SO_TYPE
944 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE));
945 #endif
946 #ifdef SO_ERROR
947 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR));
948 #endif
949 #ifdef SO_DONTROUTE
950 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE));
951 #endif
952 #ifdef SO_BROADCAST
953 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST));
954 #endif
955 #ifdef SO_SNDBUF
956 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF));
957 #endif
958 #ifdef SO_RCVBUF
959 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF));
960 #endif
961 #ifdef SO_KEEPALIVE
962 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE));
963 #endif
964 #ifdef SO_OOBINLINE
965 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE));
966 #endif
967 #ifdef SO_NO_CHECK
968 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK));
969 #endif
970 #ifdef SO_PRIORITY
971 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY));
972 #endif
973 #ifdef SO_LINGER
974 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER));
975 #endif
976
977 /* recv/send options. */
978 #ifdef MSG_OOB
979 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB));
980 #endif
981 #ifdef MSG_PEEK
982 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK));
983 #endif
984 #ifdef MSG_DONTROUTE
985 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE));
986 #endif
987
988 scm_add_feature ("socket");
989
990 #ifndef SCM_MAGIC_SNARFER
991 #include "libguile/socket.x"
992 #endif
993 }
994
995
996 /*
997 Local Variables:
998 c-file-style: "gnu"
999 End:
1000 */