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> | |
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 | 147 | } |
f244dee1 | 148 | |
0f2d19dd | 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; | |
ae2fa5bc GH |
359 | SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, |
360 | which_arg, proc); | |
361 | memcpy (soka->sun_path, SCM_ROCHARS (address), | |
362 | 1 + SCM_ROLENGTH (address)); | |
370312ae GH |
363 | *size = sizeof (struct sockaddr_un); |
364 | return (struct sockaddr *) soka; | |
365 | } | |
366 | default: | |
367 | scm_out_of_range (proc, SCM_MAKINUM (fam)); | |
0f2d19dd | 368 | } |
0f2d19dd | 369 | } |
370312ae GH |
370 | |
371 | SCM_PROC (s_connect, "connect", 3, 0, 1, scm_connect); | |
0f2d19dd | 372 | |
370312ae GH |
373 | SCM |
374 | scm_connect (sock, fam, address, args) | |
1cc91f1b | 375 | |
370312ae GH |
376 | SCM sock; |
377 | SCM fam; | |
378 | SCM address; | |
379 | SCM args; | |
0f2d19dd | 380 | { |
370312ae GH |
381 | int fd; |
382 | struct sockaddr *soka; | |
383 | scm_sizet size; | |
0f2d19dd | 384 | |
370312ae GH |
385 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_connect); |
386 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_connect); | |
387 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
388 | SCM_DEFER_INTS; | |
389 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_connect, &size); | |
390 | if (connect (fd, soka, size) == -1) | |
391 | scm_syserror (s_connect); | |
392 | scm_must_free ((char *) soka); | |
0f2d19dd | 393 | SCM_ALLOW_INTS; |
370312ae | 394 | return SCM_UNSPECIFIED; |
0f2d19dd JB |
395 | } |
396 | ||
370312ae | 397 | SCM_PROC (s_bind, "bind", 3, 0, 1, scm_bind); |
1cc91f1b | 398 | |
0f2d19dd | 399 | SCM |
370312ae GH |
400 | scm_bind (sock, fam, address, args) |
401 | SCM sock; | |
402 | SCM fam; | |
403 | SCM address; | |
404 | SCM args; | |
405 | { | |
406 | int rv; | |
407 | struct sockaddr *soka; | |
408 | scm_sizet size; | |
409 | int fd; | |
410 | ||
411 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_bind); | |
412 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_bind); | |
413 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_bind, &size); | |
414 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
415 | rv = bind (fd, soka, size); | |
416 | if (rv == -1) | |
417 | scm_syserror (s_bind); | |
418 | return SCM_UNSPECIFIED; | |
419 | } | |
420 | ||
421 | SCM_PROC (s_listen, "listen", 2, 0, 0, scm_listen); | |
422 | ||
423 | SCM | |
424 | scm_listen (sock, backlog) | |
425 | SCM sock; | |
426 | SCM backlog; | |
427 | { | |
428 | int fd; | |
429 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_listen); | |
430 | SCM_ASSERT (SCM_INUMP (backlog), backlog, SCM_ARG2, s_listen); | |
431 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
432 | if (listen (fd, SCM_INUM (backlog)) == -1) | |
433 | scm_syserror (s_listen); | |
434 | return SCM_UNSPECIFIED; | |
435 | } | |
436 | ||
437 | /* Put the components of a sockaddr into a new SCM vector. */ | |
438 | ||
439 | static SCM scm_addr_vector SCM_P ((struct sockaddr *address, char *proc)); | |
440 | ||
441 | static SCM | |
442 | scm_addr_vector (address, proc) | |
443 | struct sockaddr *address; | |
444 | char *proc; | |
0f2d19dd | 445 | { |
370312ae GH |
446 | short int fam = address->sa_family; |
447 | SCM result; | |
448 | SCM *ve; | |
449 | if (fam == AF_UNIX) | |
0f2d19dd | 450 | { |
370312ae GH |
451 | struct sockaddr_un *nad = (struct sockaddr_un *) address; |
452 | result = scm_make_vector (SCM_MAKINUM (2), SCM_UNSPECIFIED, SCM_BOOL_F); | |
453 | ve = SCM_VELTS (result); | |
454 | ve[0] = scm_ulong2num ((unsigned long) fam); | |
455 | ve[1] = scm_makfromstr (nad->sun_path, | |
456 | (scm_sizet) strlen (nad->sun_path), 0); | |
0f2d19dd | 457 | } |
f244dee1 | 458 | else if (fam == AF_INET) |
0f2d19dd | 459 | { |
370312ae GH |
460 | struct sockaddr_in *nad = (struct sockaddr_in *) address; |
461 | result = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED, SCM_BOOL_F); | |
462 | ve = SCM_VELTS (result); | |
463 | ve[0] = scm_ulong2num ((unsigned long) fam); | |
464 | ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); | |
465 | ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); | |
0f2d19dd JB |
466 | } |
467 | else | |
65b376c7 | 468 | scm_misc_error (proc, "Unrecognised address family: %s", |
d636d18c | 469 | scm_listify (SCM_MAKINUM (fam), SCM_UNDEFINED)); |
370312ae GH |
470 | |
471 | return result; | |
472 | } | |
473 | ||
474 | /* Allocate a buffer large enough to hold any sockaddr type. */ | |
475 | static char *scm_addr_buffer; | |
476 | static int scm_addr_buffer_size; | |
477 | ||
478 | static void scm_init_addr_buffer SCM_P ((void)); | |
479 | ||
480 | static void | |
481 | scm_init_addr_buffer () | |
482 | { | |
f244dee1 | 483 | scm_addr_buffer_size = (int) sizeof (struct sockaddr_un); |
370312ae GH |
484 | if (sizeof (struct sockaddr_in) > scm_addr_buffer_size) |
485 | scm_addr_buffer_size = (int) sizeof (struct sockaddr_in); | |
486 | scm_addr_buffer = scm_must_malloc (scm_addr_buffer_size, "address buffer"); | |
0f2d19dd JB |
487 | } |
488 | ||
370312ae | 489 | SCM_PROC (s_accept, "accept", 1, 0, 0, scm_accept); |
1cc91f1b | 490 | |
0f2d19dd | 491 | SCM |
370312ae GH |
492 | scm_accept (sock) |
493 | SCM sock; | |
0f2d19dd | 494 | { |
370312ae GH |
495 | int fd; |
496 | int newfd; | |
497 | SCM address; | |
498 | SCM newsock; | |
499 | ||
500 | int tmp_size; | |
501 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_accept); | |
502 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
503 | SCM_DEFER_INTS; | |
504 | tmp_size = scm_addr_buffer_size; | |
505 | newfd = accept (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size); | |
506 | newsock = scm_sock_fd_to_port (newfd, s_accept); | |
507 | if (tmp_size > 0) | |
508 | address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_accept); | |
0f2d19dd | 509 | else |
370312ae GH |
510 | address = SCM_BOOL_F; |
511 | ||
512 | SCM_ALLOW_INTS; | |
513 | return scm_cons (newsock, address); | |
0f2d19dd JB |
514 | } |
515 | ||
370312ae | 516 | SCM_PROC (s_getsockname, "getsockname", 1, 0, 0, scm_getsockname); |
1cc91f1b | 517 | |
0f2d19dd | 518 | SCM |
370312ae GH |
519 | scm_getsockname (sock) |
520 | SCM sock; | |
0f2d19dd | 521 | { |
370312ae GH |
522 | int tmp_size; |
523 | int fd; | |
524 | SCM result; | |
525 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getsockname); | |
526 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
527 | SCM_DEFER_INTS; | |
528 | tmp_size = scm_addr_buffer_size; | |
529 | if (getsockname (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) | |
530 | scm_syserror (s_getsockname); | |
531 | if (tmp_size > 0) | |
532 | result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getsockname); | |
0f2d19dd | 533 | else |
370312ae GH |
534 | result = SCM_BOOL_F; |
535 | SCM_ALLOW_INTS; | |
536 | return result; | |
0f2d19dd JB |
537 | } |
538 | ||
370312ae | 539 | SCM_PROC (s_getpeername, "getpeername", 1, 0, 0, scm_getpeername); |
1cc91f1b | 540 | |
0f2d19dd | 541 | SCM |
370312ae GH |
542 | scm_getpeername (sock) |
543 | SCM sock; | |
0f2d19dd | 544 | { |
370312ae GH |
545 | int tmp_size; |
546 | int fd; | |
547 | SCM result; | |
548 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getpeername); | |
549 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
550 | SCM_DEFER_INTS; | |
551 | tmp_size = scm_addr_buffer_size; | |
552 | if (getpeername (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) | |
553 | scm_syserror (s_getpeername); | |
554 | if (tmp_size > 0) | |
555 | result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getpeername); | |
0f2d19dd | 556 | else |
370312ae GH |
557 | result = SCM_BOOL_F; |
558 | SCM_ALLOW_INTS; | |
559 | return result; | |
0f2d19dd JB |
560 | } |
561 | ||
1146b6cd | 562 | SCM_PROC (s_recv, "recv!", 2, 1, 0, scm_recv); |
1cc91f1b | 563 | |
370312ae | 564 | SCM |
1146b6cd | 565 | scm_recv (sock, buf, flags) |
370312ae | 566 | SCM sock; |
1146b6cd | 567 | SCM buf; |
370312ae | 568 | SCM flags; |
0f2d19dd | 569 | { |
370312ae GH |
570 | int rv; |
571 | int fd; | |
572 | int flg; | |
370312ae GH |
573 | |
574 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_recv); | |
1146b6cd | 575 | SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recv); |
370312ae GH |
576 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
577 | ||
578 | if (SCM_UNBNDP (flags)) | |
579 | flg = 0; | |
580 | else | |
581 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recv); | |
582 | ||
1146b6cd | 583 | SCM_SYSCALL (rv = recv (fd, SCM_CHARS (buf), SCM_LENGTH (buf), flg)); |
370312ae GH |
584 | if (rv == -1) |
585 | scm_syserror (s_recv); | |
586 | ||
1146b6cd | 587 | return SCM_MAKINUM (rv); |
370312ae GH |
588 | } |
589 | ||
590 | SCM_PROC (s_send, "send", 2, 1, 0, scm_send); | |
591 | ||
592 | SCM | |
593 | scm_send (sock, message, flags) | |
594 | SCM sock; | |
595 | SCM message; | |
596 | SCM flags; | |
597 | { | |
598 | int rv; | |
599 | int fd; | |
600 | int flg; | |
601 | ||
602 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_send); | |
ae2fa5bc | 603 | SCM_ASSERT (SCM_NIMP (message) && SCM_ROSTRINGP (message), message, SCM_ARG2, s_send); |
370312ae GH |
604 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
605 | ||
606 | if (SCM_UNBNDP (flags)) | |
607 | flg = 0; | |
608 | else | |
609 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_send); | |
610 | ||
ae2fa5bc | 611 | SCM_SYSCALL (rv = send (fd, SCM_ROCHARS (message), SCM_ROLENGTH (message), flg)); |
370312ae GH |
612 | if (rv == -1) |
613 | scm_syserror (s_send); | |
614 | return SCM_MAKINUM (rv); | |
615 | } | |
616 | ||
1146b6cd | 617 | SCM_PROC (s_recvfrom, "recvfrom!", 2, 3, 0, scm_recvfrom); |
370312ae GH |
618 | |
619 | SCM | |
1146b6cd | 620 | scm_recvfrom (sock, buf, flags, start, end) |
370312ae | 621 | SCM sock; |
1146b6cd | 622 | SCM buf; |
370312ae | 623 | SCM flags; |
1146b6cd GH |
624 | SCM start; |
625 | SCM end; | |
370312ae GH |
626 | { |
627 | int rv; | |
628 | int fd; | |
629 | int flg; | |
1146b6cd GH |
630 | int offset = 0; |
631 | int cend; | |
370312ae GH |
632 | int tmp_size; |
633 | SCM address; | |
634 | ||
1146b6cd GH |
635 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, |
636 | s_recvfrom); | |
637 | SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recvfrom); | |
638 | cend = SCM_LENGTH (buf); | |
639 | ||
640 | if (SCM_UNBNDP (flags)) | |
641 | flg = 0; | |
370312ae GH |
642 | else |
643 | { | |
1146b6cd GH |
644 | flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom); |
645 | ||
646 | if (!SCM_UNBNDP (start)) | |
678b8532 | 647 | { |
1146b6cd GH |
648 | offset = (int) scm_num2long (start, |
649 | (char *) SCM_ARG4, s_recvfrom); | |
650 | ||
651 | if (offset < 0 || offset >= cend) | |
652 | scm_out_of_range (s_recvfrom, start); | |
653 | ||
654 | if (!SCM_UNBNDP (end)) | |
655 | { | |
656 | int tend = (int) scm_num2long (end, | |
657 | (char *) SCM_ARG5, s_recvfrom); | |
658 | ||
659 | if (tend <= offset || tend > cend) | |
660 | scm_out_of_range (s_recvfrom, end); | |
661 | ||
662 | cend = tend; | |
663 | } | |
678b8532 | 664 | } |
370312ae | 665 | } |
370312ae | 666 | |
1146b6cd | 667 | fd = fileno ((FILE *)SCM_STREAM (sock)); |
370312ae GH |
668 | |
669 | tmp_size = scm_addr_buffer_size; | |
1146b6cd GH |
670 | SCM_SYSCALL (rv = recvfrom (fd, SCM_CHARS (buf) + offset, |
671 | cend - offset, flg, | |
672 | (struct sockaddr *) scm_addr_buffer, | |
673 | &tmp_size)); | |
370312ae GH |
674 | if (rv == -1) |
675 | scm_syserror (s_recvfrom); | |
676 | if (tmp_size > 0) | |
677 | address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_recvfrom); | |
678 | else | |
679 | address = SCM_BOOL_F; | |
680 | ||
1146b6cd | 681 | return scm_cons (SCM_MAKINUM (rv), address); |
0f2d19dd JB |
682 | } |
683 | ||
370312ae | 684 | SCM_PROC (s_sendto, "sendto", 4, 0, 1, scm_sendto); |
1cc91f1b | 685 | |
370312ae GH |
686 | SCM |
687 | scm_sendto (sock, message, fam, address, args_and_flags) | |
688 | SCM sock; | |
689 | SCM message; | |
690 | SCM fam; | |
691 | SCM address; | |
692 | SCM args_and_flags; | |
693 | { | |
694 | int rv; | |
695 | int fd; | |
696 | int flg; | |
697 | struct sockaddr *soka; | |
698 | scm_sizet size; | |
699 | ||
700 | SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_sendto); | |
ae2fa5bc GH |
701 | SCM_ASSERT (SCM_NIMP (message) && SCM_ROSTRINGP (message), message, |
702 | SCM_ARG2, s_sendto); | |
370312ae GH |
703 | SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG3, s_sendto); |
704 | fd = fileno ((FILE *)SCM_STREAM (sock)); | |
705 | SCM_DEFER_INTS; | |
706 | soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, | |
707 | s_sendto, &size); | |
708 | if (SCM_NULLP (args_and_flags)) | |
709 | flg = 0; | |
710 | else | |
711 | { | |
712 | SCM_ASSERT (SCM_NIMP (args_and_flags) && SCM_CONSP (args_and_flags), | |
713 | args_and_flags, SCM_ARG5, s_sendto); | |
714 | flg = scm_num2ulong (SCM_CAR (args_and_flags), (char *) SCM_ARG5, s_sendto); | |
715 | } | |
ae2fa5bc GH |
716 | SCM_SYSCALL (rv = sendto (fd, SCM_ROCHARS (message), SCM_ROLENGTH (message), |
717 | flg, soka, size)); | |
370312ae GH |
718 | if (rv == -1) |
719 | scm_syserror (s_sendto); | |
720 | scm_must_free ((char *) soka); | |
721 | SCM_ALLOW_INTS; | |
722 | return SCM_MAKINUM (rv); | |
723 | } | |
724 | \f | |
725 | ||
726 | ||
727 | void | |
0f2d19dd | 728 | scm_init_socket () |
0f2d19dd | 729 | { |
370312ae GH |
730 | /* protocol families. */ |
731 | #ifdef AF_UNSPEC | |
732 | scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC)); | |
733 | #endif | |
734 | #ifdef AF_UNIX | |
735 | scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX)); | |
736 | #endif | |
737 | #ifdef AF_INET | |
738 | scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET)); | |
739 | #endif | |
740 | ||
741 | #ifdef PF_UNSPEC | |
742 | scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC)); | |
743 | #endif | |
744 | #ifdef PF_UNIX | |
745 | scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX)); | |
746 | #endif | |
747 | #ifdef PF_INET | |
748 | scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET)); | |
749 | #endif | |
750 | ||
751 | /* socket types. */ | |
752 | #ifdef SOCK_STREAM | |
753 | scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM)); | |
754 | #endif | |
755 | #ifdef SOCK_DGRAM | |
756 | scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM)); | |
757 | #endif | |
758 | #ifdef SOCK_RAW | |
759 | scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW)); | |
760 | #endif | |
761 | ||
762 | /* setsockopt level. */ | |
763 | #ifdef SOL_SOCKET | |
764 | scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET)); | |
765 | #endif | |
766 | #ifdef SOL_IP | |
767 | scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP)); | |
768 | #endif | |
769 | #ifdef SOL_TCP | |
770 | scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP)); | |
771 | #endif | |
772 | #ifdef SOL_UDP | |
773 | scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP)); | |
774 | #endif | |
775 | ||
776 | /* setsockopt names. */ | |
777 | #ifdef SO_DEBUG | |
778 | scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG)); | |
779 | #endif | |
780 | #ifdef SO_REUSEADDR | |
781 | scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR)); | |
782 | #endif | |
783 | #ifdef SO_STYLE | |
784 | scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE)); | |
785 | #endif | |
786 | #ifdef SO_TYPE | |
787 | scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE)); | |
788 | #endif | |
789 | #ifdef SO_ERROR | |
790 | scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR)); | |
791 | #endif | |
792 | #ifdef SO_DONTROUTE | |
793 | scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE)); | |
794 | #endif | |
795 | #ifdef SO_BROADCAST | |
796 | scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST)); | |
797 | #endif | |
798 | #ifdef SO_SNDBUF | |
799 | scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF)); | |
800 | #endif | |
801 | #ifdef SO_RCVBUF | |
802 | scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF)); | |
803 | #endif | |
804 | #ifdef SO_KEEPALIVE | |
805 | scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE)); | |
806 | #endif | |
807 | #ifdef SO_OOBINLINE | |
808 | scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE)); | |
809 | #endif | |
810 | #ifdef SO_NO_CHECK | |
811 | scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK)); | |
812 | #endif | |
813 | #ifdef SO_PRIORITY | |
814 | scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY)); | |
815 | #endif | |
816 | #ifdef SO_LINGER | |
817 | scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER)); | |
818 | #endif | |
819 | ||
820 | /* recv/send options. */ | |
821 | #ifdef MSG_OOB | |
822 | scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB)); | |
823 | #endif | |
824 | #ifdef MSG_PEEK | |
825 | scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK)); | |
826 | #endif | |
827 | #ifdef MSG_DONTROUTE | |
828 | scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE)); | |
829 | #endif | |
830 | ||
0f2d19dd | 831 | scm_add_feature ("socket"); |
370312ae GH |
832 | scm_init_addr_buffer (); |
833 | ||
0f2d19dd JB |
834 | #include "socket.x" |
835 | } | |
836 |