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