l4/pkg/ocaml/contrib/otherlibs/unix/gethost.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: gethost.c 7619 2006-09-20 11:14:37Z doligez $ */
  15
  16 #include <string.h>
  17 #include <mlvalues.h>
  18 #include <alloc.h>
  19 #include <fail.h>
  20 #include <memory.h>
  21 #include <signals.h>
  22 #include "unixsupport.h"
  23
  24 #ifdef HAS_SOCKETS
  25
  26 #include "socketaddr.h"
  27 #ifndef _WIN32
  28 #include <sys/types.h>
  29 #include <netdb.h>
  30 #endif
  31
  32 #define NETDB_BUFFER_SIZE 10000
  33
  34 #ifdef _WIN32
  35 #define GETHOSTBYADDR_IS_REENTRANT 1
  36 #define GETHOSTBYNAME_IS_REENTRANT 1
  37 #endif
  38
  39 static int entry_h_length;
  40
  41 extern int socket_domain_table[];
  42
  43 static value alloc_one_addr(char const *a)
  44 {
  45   struct in_addr addr;
  46 #ifdef HAS_IPV6
  47   struct in6_addr addr6;
  48   if (entry_h_length == 16) {
  49     memmove(&addr6, a, 16);
  50     return alloc_inet6_addr(&addr6);
  51   }
  52 #endif
  53   memmove (&addr, a, 4);
  54   return alloc_inet_addr(&addr);
  55 }
  56
  57 static value alloc_host_entry(struct hostent *entry)
  58 {
  59   value res;
  60   value name = Val_unit, aliases = Val_unit;
  61   value addr_list = Val_unit, adr = Val_unit;
  62
  63   Begin_roots4 (name, aliases, addr_list, adr);
  64     name = copy_string((char *)(entry->h_name));
  65     /* PR#4043: protect against buggy implementations of gethostbyname()
  66        that return a NULL pointer in h_aliases */
  67     if (entry->h_aliases)
  68       aliases = copy_string_array((const char**)entry->h_aliases);
  69     else
  70       aliases = Atom(0);
  71     entry_h_length = entry->h_length;
  72 #ifdef h_addr
  73     addr_list = alloc_array(alloc_one_addr, (const char**)entry->h_addr_list);
  74 #else
  75     adr = alloc_one_addr(entry->h_addr);
  76     addr_list = alloc_small(1, 0);
  77     Field(addr_list, 0) = adr;
  78 #endif
  79     res = alloc_small(4, 0);
  80     Field(res, 0) = name;
  81     Field(res, 1) = aliases;
  82     switch (entry->h_addrtype) {
  83     case PF_UNIX:          Field(res, 2) = Val_int(0); break;
  84     case PF_INET:          Field(res, 2) = Val_int(1); break;
  85     default: /*PF_INET6 */ Field(res, 2) = Val_int(2); break;
  86     }
  87     Field(res, 3) = addr_list;
  88   End_roots();
  89   return res;
  90 }
  91
  92 CAMLprim value unix_gethostbyaddr(value a)
  93 {
  94   struct in_addr adr = GET_INET_ADDR(a);
  95   struct hostent * hp;
  96 #if HAS_GETHOSTBYADDR_R == 7
  97   struct hostent h;
  98   char buffer[NETDB_BUFFER_SIZE];
  99   int h_errnop;
 100   enter_blocking_section();
 101   hp = gethostbyaddr_r((char *) &adr, 4, AF_INET,
 102                        &h, buffer, sizeof(buffer), &h_errnop);
 103   leave_blocking_section();
 104 #elif HAS_GETHOSTBYADDR_R == 8
 105   struct hostent h;
 106   char buffer[NETDB_BUFFER_SIZE];
 107   int h_errnop, rc;
 108   enter_blocking_section();
 109   rc = gethostbyaddr_r((char *) &adr, 4, AF_INET,
 110                        &h, buffer, sizeof(buffer), &hp, &h_errnop);
 111   leave_blocking_section();
 112   if (rc != 0) hp = NULL;
 113 #else
 114 #ifdef GETHOSTBYADDR_IS_REENTRANT
 115   enter_blocking_section();
 116 #endif
 117   hp = gethostbyaddr((char *) &adr, 4, AF_INET);
 118 #ifdef GETHOSTBYADDR_IS_REENTRANT
 119   leave_blocking_section();
 120 #endif
 121 #endif
 122   if (hp == (struct hostent *) NULL) raise_not_found();
 123   return alloc_host_entry(hp);
 124 }
 125
 126 CAMLprim value unix_gethostbyname(value name)
 127 {
 128   struct hostent * hp;
 129   char * hostname;
 130
 131 #if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
 132   hostname = stat_alloc(string_length(name) + 1);
 133   strcpy(hostname, String_val(name));
 134 #else
 135   hostname = String_val(name);
 136 #endif
 137
 138 #if HAS_GETHOSTBYNAME_R == 5
 139   {
 140     struct hostent h;
 141     char buffer[NETDB_BUFFER_SIZE];
 142     int h_errno;
 143     enter_blocking_section();
 144     hp = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &h_errno);
 145     leave_blocking_section();
 146   }
 147 #elif HAS_GETHOSTBYNAME_R == 6
 148   {
 149     struct hostent h;
 150     char buffer[NETDB_BUFFER_SIZE];
 151     int h_errno, rc;
 152     enter_blocking_section();
 153     rc = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &hp, &h_errno);
 154     leave_blocking_section();
 155     if (rc != 0) hp = NULL;
 156   }
 157 #else
 158 #ifdef GETHOSTBYNAME_IS_REENTRANT
 159   enter_blocking_section();
 160 #endif
 161   hp = gethostbyname(hostname);
 162 #ifdef GETHOSTBYNAME_IS_REENTRANT
 163   leave_blocking_section();
 164 #endif
 165 #endif
 166
 167 #if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
 168   stat_free(hostname);
 169 #endif
 170
 171   if (hp == (struct hostent *) NULL) raise_not_found();
 172   return alloc_host_entry(hp);
 173 }
 174
 175 #else
 176
 177 CAMLprim value unix_gethostbyaddr(value name)
 178 { invalid_argument("gethostbyaddr not implemented"); }
 179
 180 CAMLprim value unix_gethostbyname(value name)
 181 { invalid_argument("gethostbyname not implemented"); }
 182
 183 #endif