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