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