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