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