libguile/net_db.c

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