1 /* "net_db.c" network database support
2 * Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009,
3 * 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
4 *
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Lesser General Public License
7 * as published by the Free Software Foundation; either version 3 of
8 * the License, or (at your option) any later version.
9 *
10 * This library is distributed in the hope that it will be useful, but
11 * WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Lesser General Public License for more details.
14 *
15 * You should have received a copy of the GNU Lesser General Public
16 * License along with this library; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
18 * 02110-1301 USA
19 */
20
21
22
23 /* Written in 1994 by Aubrey Jaffer.
24 * Thanks to Hallvard.Tretteberg@si.sintef.no for inspiration and discussion.
25 * Rewritten by Gary Houston to be a closer interface to the C socket library.
26 * Split into net_db.c and socket.c.
27 */
28
29
30 #ifdef HAVE_CONFIG_H
31 # include <config.h>
32 #endif
33
34 #include <verify.h>
35 #include <errno.h>
36
37 #ifdef HAVE_STRING_H
38 #include <string.h>
39 #endif
40
41 #include <sys/types.h>
42
43 #include <sys/socket.h>
44 #include <netdb.h>
45 #include <netinet/in.h>
46 #include <arpa/inet.h>
47
48 #include "libguile/_scm.h"
49 #include "libguile/feature.h"
50 #include "libguile/strings.h"
51 #include "libguile/vectors.h"
52 #include "libguile/dynwind.h"
53
54 #include "libguile/validate.h"
55 #include "libguile/net_db.h"
56 #include "libguile/socket.h"
57
58
59 #if defined (HAVE_H_ERRNO)
60 /* Only wrap gethostbyname / gethostbyaddr if h_errno is available. */
61
62 #if defined HAVE_HSTRERROR && !HAVE_DECL_HSTRERROR
63 /* Some OSes, such as Tru64 5.1b, lack a declaration for hstrerror(3). */
64 extern const char *hstrerror (int);
65 #endif
66
67 SCM_SYMBOL (scm_host_not_found_key, "host-not-found");
68 SCM_SYMBOL (scm_try_again_key, "try-again");
69 SCM_SYMBOL (scm_no_recovery_key, "no-recovery");
70 SCM_SYMBOL (scm_no_data_key, "no-data");
71
scm_resolv_error(const char * subr,SCM bad_value)72 static void scm_resolv_error (const char *subr, SCM bad_value)
73 {
74 #ifdef NETDB_INTERNAL
75 if (h_errno == NETDB_INTERNAL)
76 {
77 /* errno supposedly contains a useful value. */
78 scm_syserror (subr);
79 }
80 else
81 #endif
82 {
83 SCM key;
84 const char *errmsg;
85
86 switch (h_errno)
87 {
88 case HOST_NOT_FOUND:
89 key = scm_host_not_found_key;
90 errmsg = "Unknown host";
91 break;
92 case TRY_AGAIN:
93 key = scm_try_again_key;
94 errmsg = "Host name lookup failure";
95 break;
96 case NO_RECOVERY:
97 key = scm_no_recovery_key;
98 errmsg = "Unknown server error";
99 break;
100 case NO_DATA:
101 key = scm_no_data_key;
102 errmsg = "No address associated with name";
103 break;
104 default:
105 scm_misc_error (subr, "Unknown resolver error", SCM_EOL);
106 errmsg = NULL;
107 }
108
109 #ifdef HAVE_HSTRERROR
110 errmsg = (const char *) hstrerror (h_errno);
111 #endif
112 scm_error (key, subr, errmsg, SCM_BOOL_F, SCM_EOL);
113 }
114 }
115
116 /* Should take an extra arg for address format (will be needed for IPv6).
117 Should use reentrant facilities if available.
118 */
119
120 SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
121 (SCM host),
122 "@deffnx {Scheme Procedure} gethostbyname hostname\n"
123 "@deffnx {Scheme Procedure} gethostbyaddr address\n"
124 "Look up a host by name or address, returning a host object. The\n"
125 "@code{gethost} procedure will accept either a string name or an integer\n"
126 "address; if given no arguments, it behaves like @code{gethostent} (see\n"
127 "below). If a name or address is supplied but the address can not be\n"
128 "found, an error will be thrown to one of the keys:\n"
129 "@code{host-not-found}, @code{try-again}, @code{no-recovery} or\n"
130 "@code{no-data}, corresponding to the equivalent @code{h_error} values.\n"
131 "Unusual conditions may result in errors thrown to the\n"
132 "@code{system-error} or @code{misc_error} keys.")
133 #define FUNC_NAME s_scm_gethost
134 {
135 SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
136 SCM lst = SCM_EOL;
137 struct hostent *entry;
138 struct in_addr inad;
139 char **argv;
140 int i = 0;
141
142 if (SCM_UNBNDP (host))
143 {
144 #ifdef HAVE_GETHOSTENT
145 entry = gethostent ();
146 #else
147 entry = NULL;
148 #endif
149 if (! entry)
150 {
151 /* As far as I can tell, there's no good way to tell whether
152 zero means an error or end-of-file. The trick of
153 clearing errno before calling gethostent and checking it
154 afterwards doesn't cut it, because, on Linux, it seems to
155 try to contact some other server (YP?) and fails, which
156 is a benign failure. */
157 return SCM_BOOL_F;
158 }
159 }
160 else if (scm_is_string (host))
161 {
162 char *str = scm_to_locale_string (host);
163 entry = gethostbyname (str);
164 free (str);
165 }
166 else
167 {
168 inad.s_addr = htonl (scm_to_ulong (host));
169 entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET);
170 }
171
172 if (!entry)
173 scm_resolv_error (FUNC_NAME, host);
174
175 SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
176 SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
177 SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
178 SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_int (entry->h_length));
179 if (sizeof (struct in_addr) != entry->h_length)
180 {
181 SCM_SIMPLE_VECTOR_SET(result, 4, SCM_BOOL_F);
182 return result;
183 }
184 for (argv = entry->h_addr_list; argv[i]; i++);
185 while (i--)
186 {
187 inad = *(struct in_addr *) argv[i];
188 lst = scm_cons (scm_from_ulong (ntohl (inad.s_addr)), lst);
189 }
190 SCM_SIMPLE_VECTOR_SET(result, 4, lst);
191 return result;
192 }
193 #undef FUNC_NAME
194
195 #endif /* HAVE_H_ERRNO */
196
197
198 /* In all subsequent getMUMBLE functions, when we're called with no
199 arguments, we're supposed to traverse the tables entry by entry.
200 However, there doesn't seem to be any documented way to distinguish
201 between end-of-table and an error; in both cases the functions
202 return zero. Gotta love Unix. For the time being, we clear errno,
203 and if we get a zero and errno is set, we signal an error. This
204 doesn't seem quite right (what if errno gets set as part of healthy
205 operation?), but it seems to work okay. We'll see. */
206
207 #if defined(HAVE_GETNETENT) && defined(HAVE_GETNETBYNAME) && defined(HAVE_GETNETBYADDR)
208 SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
209 (SCM net),
210 "@deffnx {Scheme Procedure} getnetbyname net-name\n"
211 "@deffnx {Scheme Procedure} getnetbyaddr net-number\n"
212 "Look up a network by name or net number in the network database. The\n"
213 "@var{net-name} argument must be a string, and the @var{net-number}\n"
214 "argument must be an integer. @code{getnet} will accept either type of\n"
215 "argument, behaving like @code{getnetent} (see below) if no arguments are\n"
216 "given.")
217 #define FUNC_NAME s_scm_getnet
218 {
219 SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
220 struct netent *entry;
221 int eno;
222
223 if (SCM_UNBNDP (net))
224 {
225 entry = getnetent ();
226 if (! entry)
227 {
228 /* There's no good way to tell whether zero means an error
229 or end-of-file, so we always return #f. See `gethost'
230 for details. */
231 return SCM_BOOL_F;
232 }
233 }
234 else if (scm_is_string (net))
235 {
236 char *str = scm_to_locale_string (net);
237 entry = getnetbyname (str);
238 eno = errno;
239 free (str);
240 }
241 else
242 {
243 unsigned long netnum = scm_to_ulong (net);
244 entry = getnetbyaddr (netnum, AF_INET);
245 eno = errno;
246 }
247
248 if (!entry)
249 SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno);
250
251 SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
252 SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
253 SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
254 SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net));
255 return result;
256 }
257 #undef FUNC_NAME
258 #endif
259
260 #if defined (HAVE_GETPROTOENT)
261 SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
262 (SCM protocol),
263 "@deffnx {Scheme Procedure} getprotobyname name\n"
264 "@deffnx {Scheme Procedure} getprotobynumber number\n"
265 "Look up a network protocol by name or by number. @code{getprotobyname}\n"
266 "takes a string argument, and @code{getprotobynumber} takes an integer\n"
267 "argument. @code{getproto} will accept either type, behaving like\n"
268 "@code{getprotoent} (see below) if no arguments are supplied.")
269 #define FUNC_NAME s_scm_getproto
270 {
271 SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED);
272 struct protoent *entry;
273 int eno;
274
275 if (SCM_UNBNDP (protocol))
276 {
277 entry = getprotoent ();
278 if (! entry)
279 {
280 /* There's no good way to tell whether zero means an error
281 or end-of-file, so we always return #f. See `gethost'
282 for details. */
283 return SCM_BOOL_F;
284 }
285 }
286 else if (scm_is_string (protocol))
287 {
288 char *str = scm_to_locale_string (protocol);
289 entry = getprotobyname (str);
290 eno = errno;
291 free (str);
292 }
293 else
294 {
295 unsigned long protonum = scm_to_ulong (protocol);
296 entry = getprotobynumber (protonum);
297 eno = errno;
298 }
299
300 if (!entry)
301 SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno);
302
303 SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
304 SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
305 SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
306 return result;
307 }
308 #undef FUNC_NAME
309 #endif
310
311 #if defined (HAVE_GETSERVENT)
312 static SCM
scm_return_entry(struct servent * entry)313 scm_return_entry (struct servent *entry)
314 {
315 SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
316
317 SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
318 SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
319 SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port)));
320 SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto));
321 return result;
322 }
323
324 SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
325 (SCM name, SCM protocol),
326 "@deffnx {Scheme Procedure} getservbyname name protocol\n"
327 "@deffnx {Scheme Procedure} getservbyport port protocol\n"
328 "Look up a network service by name or by service number, and return a\n"
329 "network service object. The @var{protocol} argument specifies the name\n"
330 "of the desired protocol; if the protocol found in the network service\n"
331 "database does not match this name, a system error is signalled.\n\n"
332 "The @code{getserv} procedure will take either a service name or number\n"
333 "as its first argument; if given no arguments, it behaves like\n"
334 "@code{getservent} (see below).")
335 #define FUNC_NAME s_scm_getserv
336 {
337 struct servent *entry;
338 char *protoname;
339 int eno;
340
341 if (SCM_UNBNDP (name))
342 {
343 entry = getservent ();
344 if (!entry)
345 {
346 /* There's no good way to tell whether zero means an error
347 or end-of-file, so we always return #f. See `gethost'
348 for details. */
349 return SCM_BOOL_F;
350 }
351 return scm_return_entry (entry);
352 }
353
354 scm_dynwind_begin (0);
355
356 protoname = scm_to_locale_string (protocol);
357 scm_dynwind_free (protoname);
358
359 if (scm_is_string (name))
360 {
361 char *str = scm_to_locale_string (name);
362 entry = getservbyname (str, protoname);
363 eno = errno;
364 free (str);
365 }
366 else
367 {
368 entry = getservbyport (htons (scm_to_int (name)), protoname);
369 eno = errno;
370 }
371
372 if (!entry)
373 SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), eno);
374
375 scm_dynwind_end ();
376 return scm_return_entry (entry);
377 }
378 #undef FUNC_NAME
379 #endif
380
381 #if defined(HAVE_SETHOSTENT) && defined(HAVE_ENDHOSTENT)
382 SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0,
383 (SCM stayopen),
384 "If @var{stayopen} is omitted, this is equivalent to @code{endhostent}.\n"
385 "Otherwise it is equivalent to @code{sethostent stayopen}.")
386 #define FUNC_NAME s_scm_sethost
387 {
388 if (SCM_UNBNDP (stayopen))
389 endhostent ();
390 else
391 sethostent (scm_is_true (stayopen));
392 return SCM_UNSPECIFIED;
393 }
394 #undef FUNC_NAME
395 #endif
396
397 #if defined(HAVE_SETNETENT) && defined(HAVE_ENDNETENT)
398 SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0,
399 (SCM stayopen),
400 "If @var{stayopen} is omitted, this is equivalent to @code{endnetent}.\n"
401 "Otherwise it is equivalent to @code{setnetent stayopen}.")
402 #define FUNC_NAME s_scm_setnet
403 {
404 if (SCM_UNBNDP (stayopen))
405 endnetent ();
406 else
407 setnetent (scm_is_true (stayopen));
408 return SCM_UNSPECIFIED;
409 }
410 #undef FUNC_NAME
411 #endif
412
413 #if defined (HAVE_SETPROTOENT) && defined (HAVE_ENDPROTOENT)
414 SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0,
415 (SCM stayopen),
416 "If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}.\n"
417 "Otherwise it is equivalent to @code{setprotoent stayopen}.")
418 #define FUNC_NAME s_scm_setproto
419 {
420 if (SCM_UNBNDP (stayopen))
421 endprotoent ();
422 else
423 setprotoent (scm_is_true (stayopen));
424 return SCM_UNSPECIFIED;
425 }
426 #undef FUNC_NAME
427 #endif
428
429 #if defined (HAVE_SETSERVENT) && defined (HAVE_ENDSERVENT)
430 SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0,
431 (SCM stayopen),
432 "If @var{stayopen} is omitted, this is equivalent to @code{endservent}.\n"
433 "Otherwise it is equivalent to @code{setservent stayopen}.")
434 #define FUNC_NAME s_scm_setserv
435 {
436 if (SCM_UNBNDP (stayopen))
437 endservent ();
438 else
439 setservent (scm_is_true (stayopen));
440 return SCM_UNSPECIFIED;
441 }
442 #undef FUNC_NAME
443 #endif
444
445
446 /* Protocol-independent name resolution with getaddrinfo(3) & co. */
447
448 SCM_SYMBOL (sym_getaddrinfo_error, "getaddrinfo-error");
449
450 #define SCM_DEFINE_CONSTANT(constant) \
451 SCM_SNARF_HERE(verify (constant < SCM_MOST_POSITIVE_FIXNUM)) \
452 SCM_SNARF_INIT(scm_c_define (#constant, SCM_I_MAKINUM (constant));)
453
454 /* Valid values for the `ai_flags' to `struct addrinfo'. */
455 SCM_DEFINE_CONSTANT (AI_PASSIVE);
456 SCM_DEFINE_CONSTANT (AI_CANONNAME);
457 SCM_DEFINE_CONSTANT (AI_NUMERICHOST);
458 SCM_DEFINE_CONSTANT (AI_NUMERICSERV);
459 SCM_DEFINE_CONSTANT (AI_V4MAPPED);
460 SCM_DEFINE_CONSTANT (AI_ALL);
461 SCM_DEFINE_CONSTANT (AI_ADDRCONFIG);
462
463 /* Return a Scheme vector whose elements correspond to the fields of C_AI,
464 ignoring the `ai_next' field. This function is not exported because the
465 definition of `struct addrinfo' is provided by Gnulib. */
466 static SCM
scm_from_addrinfo(const struct addrinfo * c_ai)467 scm_from_addrinfo (const struct addrinfo *c_ai)
468 {
469 SCM ai;
470
471 /* Note: The indices here must be kept synchronized with those used by the
472 `addrinfo:' procedures in `networking.scm'. */
473
474 ai = scm_c_make_vector (6, SCM_UNDEFINED);
475 SCM_SIMPLE_VECTOR_SET (ai, 0, scm_from_int (c_ai->ai_flags));
476 SCM_SIMPLE_VECTOR_SET (ai, 1, scm_from_int (c_ai->ai_family));
477 SCM_SIMPLE_VECTOR_SET (ai, 2, scm_from_int (c_ai->ai_socktype));
478 SCM_SIMPLE_VECTOR_SET (ai, 3, scm_from_int (c_ai->ai_protocol));
479 SCM_SIMPLE_VECTOR_SET (ai, 4,
480 scm_from_sockaddr (c_ai->ai_addr, c_ai->ai_addrlen));
481 SCM_SIMPLE_VECTOR_SET (ai, 5,
482 c_ai->ai_canonname != NULL
483 ? scm_from_locale_string (c_ai->ai_canonname)
484 : SCM_BOOL_F);
485
486 return ai;
487 }
488
489 SCM_DEFINE (scm_getaddrinfo, "getaddrinfo", 1, 5, 0,
490 (SCM name, SCM service, SCM hint_flags, SCM hint_family,
491 SCM hint_socktype, SCM hint_protocol),
492 "Return a list of @code{addrinfo} structures containing "
493 "a socket address and associated information for host @var{name} "
494 "and/or @var{service} to be used in creating a socket with "
495 "which to address the specified service.\n\n"
496 "@example\n"
497 "(let* ((ai (car (getaddrinfo \"www.gnu.org\" \"http\")))\n"
498 " (s (socket (addrinfo:fam ai) (addrinfo:socktype ai)\n"
499 " (addrinfo:protocol ai))))\n"
500 " (connect s (addrinfo:addr ai))\n"
501 " s)\n"
502 "@end example\n\n"
503 "When @var{service} is omitted or is @code{#f}, return "
504 "network-level addresses for @var{name}. When @var{name} "
505 "is @code{#f} @var{service} must be provided and service "
506 "locations local to the caller are returned.\n"
507 "\n"
508 "Additional hints can be provided. When specified, "
509 "@var{hint_flags} should be a bitwise-or of zero or more "
510 "constants among the following:\n\n"
511 "@table @code\n"
512 "@item AI_PASSIVE\n"
513 "Socket address is intended for @code{bind}.\n\n"
514 "@item AI_CANONNAME\n"
515 "Request for canonical host name, available via "
516 "@code{addrinfo:canonname}. This makes sense mainly when "
517 "DNS lookups are involved.\n\n"
518 "@item AI_NUMERICHOST\n"
519 "Specifies that @var{name} is a numeric host address string "
520 "(e.g., @code{\"127.0.0.1\"}), meaning that name resolution "
521 "will not be used.\n\n"
522 "@item AI_NUMERICSERV\n"
523 "Likewise, specifies that @var{service} is a numeric port "
524 "string (e.g., @code{\"80\"}).\n\n"
525 "@item AI_ADDRCONFIG\n"
526 "Return only addresses configured on the local system. It is "
527 "highly recommended to provide this flag when the returned "
528 "socket addresses are to be used to make connections; "
529 "otherwise, some of the returned addresses could be unreachable "
530 "or use a protocol that is not supported.\n\n"
531 "@item AI_V4MAPPED\n"
532 "When looking up IPv6 addresses, return mapped "
533 "IPv4 addresses if there is no IPv6 address available at all.\n\n"
534 "@item AI_ALL\n"
535 "If this flag is set along with @code{AI_V4MAPPED} when looking "
536 "up IPv6 addresses, return all IPv6 addresses "
537 "as well as all IPv4 addresses, the latter mapped to IPv6 "
538 "format.\n"
539 "@end table\n\n"
540 "When given, @var{hint_family} should specify the requested "
541 "address family, e.g., @code{AF_INET6}. Similarly, "
542 "@var{hint_socktype} should specify the requested socket type "
543 "(e.g., @code{SOCK_DGRAM}), and @var{hint_protocol} should "
544 "specify the requested protocol (its value is interpretered "
545 "as in calls to @code{socket}).\n"
546 "\n"
547 "On error, an exception with key @code{getaddrinfo-error} is "
548 "thrown, with an error code (an integer) as its argument:\n\n"
549 "@example\n"
550 "(catch 'getaddrinfo-error\n"
551 " (lambda ()\n"
552 " (getaddrinfo \"www.gnu.org\" \"gopher\"))\n"
553 " (lambda (key errcode)\n"
554 " (cond ((= errcode EAI_SERVICE)\n"
555 " (display \"doesn't know about Gopher!\\n\"))\n"
556 " ((= errcode EAI_NONAME)\n"
557 " (display \"www.gnu.org not found\\n\"))\n"
558 " (else\n"
559 " (format #t \"something wrong: ~a\\n\"\n"
560 " (gai-strerror errcode))))))\n"
561 "@end example\n"
562 "\n"
563 "Error codes are:\n\n"
564 "@table @code\n"
565 "@item EAI_AGAIN\n"
566 "The name or service could not be resolved at this time. Future "
567 "attempts may succeed.\n\n"
568 "@item EAI_BADFLAGS\n"
569 "@var{hint_flags} contains an invalid value.\n\n"
570 "@item EAI_FAIL\n"
571 "A non-recoverable error occurred when attempting to "
572 "resolve the name.\n\n"
573 "@item EAI_FAMILY\n"
574 "@var{hint_family} was not recognized.\n\n"
575 "@item EAI_NONAME\n"
576 "Either @var{name} does not resolve for the supplied parameters, "
577 "or neither @var{name} nor @var{service} were supplied.\n\n"
578
579 /* See `sysdeps/posix/getaddrinfo.c' in the GNU libc, and
580 <http://www.opensource.apple.com/source/Libinfo/Libinfo-324.1/lookup.subproj/netdb.h>,
581 for details on EAI_NODATA. */
582 "@item EAI_NODATA\n"
583 "This non-POSIX error code can be returned on some systems (GNU "
584 "and Darwin, at least), for example when @var{name} is known "
585 "but requests that were made turned out no data. Error handling\n"
586 "code should be prepared to handle it when it is defined.\n\n"
587 "@item EAI_SERVICE\n"
588 "@var{service} was not recognized for the specified socket type.\n\n"
589 "@item EAI_SOCKTYPE\n"
590 "@var{hint_socktype} was not recognized.\n\n"
591 "@item EAI_SYSTEM\n"
592 "A system error occurred. In C, the error code can be found in "
593 "@code{errno}; this value is not accessible from Scheme, but in\n"
594 "practice it provides little information about the actual error "
595 "cause.\n\n" /* see <http://bugs.gnu.org/13958>. */
596 "@end table\n"
597 "\n"
598 "Users are encouraged to read the "
599 "@url{http://www.opengroup.org/onlinepubs/9699919799/functions/getaddrinfo.html,"
600 "POSIX specification} for more details.\n")
601 #define FUNC_NAME s_scm_getaddrinfo
602 {
603 int err;
604 char *c_name, *c_service;
605 struct addrinfo c_hints, *c_result;
606 SCM result = SCM_EOL;
607
608 if (scm_is_true (name))
609 SCM_VALIDATE_STRING (SCM_ARG1, name);
610
611 if (!SCM_UNBNDP (service) && scm_is_true (service))
612 SCM_VALIDATE_STRING (SCM_ARG2, service);
613
614 scm_dynwind_begin (0);
615
616 if (scm_is_string (name))
617 {
618 c_name = scm_to_locale_string (name);
619 scm_dynwind_free (c_name);
620 }
621 else
622 c_name = NULL;
623
624 if (scm_is_string (service))
625 {
626 c_service = scm_to_locale_string (service);
627 scm_dynwind_free (c_service);
628 }
629 else
630 c_service = NULL;
631
632 memset (&c_hints, 0, sizeof (c_hints));
633 if (!SCM_UNBNDP (hint_flags))
634 {
635 c_hints.ai_flags = scm_to_int (hint_flags);
636 if (!SCM_UNBNDP (hint_family))
637 {
638 c_hints.ai_family = scm_to_int (hint_family);
639 if (!SCM_UNBNDP (hint_socktype))
640 {
641 c_hints.ai_socktype = scm_to_int (hint_socktype);
642 if (!SCM_UNBNDP (hint_family))
643 c_hints.ai_family = scm_to_int (hint_family);
644 }
645 }
646 }
647
648 err = getaddrinfo (c_name, c_service, &c_hints, &c_result);
649 if (err == 0)
650 {
651 SCM *prev_addr;
652 struct addrinfo *a;
653
654 for (prev_addr = &result, a = c_result;
655 a != NULL;
656 a = a->ai_next, prev_addr = SCM_CDRLOC (*prev_addr))
657 *prev_addr = scm_list_1 (scm_from_addrinfo (a));
658
659 freeaddrinfo (c_result);
660 }
661 else
662 scm_throw (sym_getaddrinfo_error, scm_list_1 (scm_from_int (err)));
663
664 scm_dynwind_end ();
665
666 return result;
667 }
668 #undef FUNC_NAME
669
670 /* Error codes returned by `getaddrinfo'. */
671 SCM_DEFINE_CONSTANT (EAI_BADFLAGS);
672 SCM_DEFINE_CONSTANT (EAI_NONAME);
673 SCM_DEFINE_CONSTANT (EAI_AGAIN);
674 SCM_DEFINE_CONSTANT (EAI_FAIL);
675 SCM_DEFINE_CONSTANT (EAI_FAMILY);
676 SCM_DEFINE_CONSTANT (EAI_SOCKTYPE);
677 SCM_DEFINE_CONSTANT (EAI_SERVICE);
678 SCM_DEFINE_CONSTANT (EAI_MEMORY);
679 SCM_DEFINE_CONSTANT (EAI_SYSTEM);
680 SCM_DEFINE_CONSTANT (EAI_OVERFLOW);
681
682 /* The following values are GNU extensions. */
683 #ifdef EAI_NODATA
684 SCM_DEFINE_CONSTANT (EAI_NODATA);
685 #endif
686 #ifdef EAI_ADDRFAMILY
687 SCM_DEFINE_CONSTANT (EAI_ADDRFAMILY);
688 #endif
689 #ifdef EAI_INPROGRESS
690 SCM_DEFINE_CONSTANT (EAI_INPROGRESS);
691 #endif
692 #ifdef EAI_CANCELED
693 SCM_DEFINE_CONSTANT (EAI_CANCELED);
694 #endif
695 #ifdef EAI_NOTCANCELED
696 SCM_DEFINE_CONSTANT (EAI_NOTCANCELED);
697 #endif
698 #ifdef EAI_ALLDONE
699 SCM_DEFINE_CONSTANT (EAI_ALLDONE);
700 #endif
701 #ifdef EAI_INTR
702 SCM_DEFINE_CONSTANT (EAI_INTR);
703 #endif
704 #ifdef EAI_IDN_ENCODE
705 SCM_DEFINE_CONSTANT (EAI_IDN_ENCODE);
706 #endif
707
708 SCM_DEFINE (scm_gai_strerror, "gai-strerror", 1, 0, 0,
709 (SCM error),
710 "Return a string describing @var{error}, an integer error code "
711 "returned by @code{getaddrinfo}.")
712 #define FUNC_NAME s_scm_gai_strerror
713 {
714 return scm_from_locale_string (gai_strerror (scm_to_int (error)));
715 }
716 #undef FUNC_NAME
717
718 /* TODO: Add a getnameinfo(3) wrapper. */
719
720
721 void
scm_init_net_db()722 scm_init_net_db ()
723 {
724 scm_add_feature ("net-db");
725 #include "libguile/net_db.x"
726 }
727
728 /*
729 Local Variables:
730 c-file-style: "gnu"
731 End:
732 */
733