(Writing): Add write, revise display.
[bpt/guile.git] / libguile / socket.c
index bf1dc01..6a0bc56 100644 (file)
@@ -1,48 +1,29 @@
-/* Copyright (C) 1996,1997,1998,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc.
  * 
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- * 
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
  *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
 
 
 \f
 
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
 #include <errno.h>
+#include <gmp.h>
 
 #include "libguile/_scm.h"
 #include "libguile/unif.h"
                      + strlen ((ptr)->sun_path))
 #endif
 
-#if !defined (HAVE_UINT32_T)
-#if SIZEOF_INT == 4
-typedef unsigned int uint32_t;
-#elif SIZEOF_LONG == 4
-typedef unsigned long uint32_t;
-#else
-#error can not define uint32_t
-#endif
-#endif
-
 /* we are not currently using socklen_t.  it's not defined on all systems,
    so would need to be checked by configure.  in the meantime, plain
    int is the best alternative.  */
@@ -142,7 +113,7 @@ SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
            "and returned as a new integer.")
 #define FUNC_NAME s_scm_htonl
 {
-  uint32_t c_in = SCM_NUM2ULONG (1, value);
+  scm_t_uint32 c_in = SCM_NUM2ULONG (1, value);
 
   return scm_ulong2num (htonl (c_in));
 }
@@ -155,7 +126,7 @@ SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
            "and returned as a new integer.")
 #define FUNC_NAME s_scm_ntohl
 {
-  uint32_t c_in = SCM_NUM2ULONG (1, value);
+  scm_t_uint32 c_in = SCM_NUM2ULONG (1, value);
 
   return scm_ulong2num (ntohl (c_in));
 }
@@ -274,7 +245,7 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
   \
   for (i = 0; i < 8; i++)\
     {\
-      char c = (addr)[i];\
+      scm_t_uint8 c = (addr)[i];\
       \
       (addr)[i] = (addr)[15 - i];\
       (addr)[15 - i] = c;\
@@ -282,65 +253,154 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
 }
 #endif
 
+#ifdef WORDS_BIGENDIAN
+#define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
+#else
+#define FLIPCPY_NET_HOST_128(dest, src) \
+{ \
+  const scm_t_uint8 *tmp_srcp = (src) + 15; \
+  scm_t_uint8 *tmp_destp = (dest); \
+  \
+  do { \
+    *tmp_destp++ = *tmp_srcp--; \
+  } while (tmp_srcp != (src)); \
+}
+#endif
+
+
+#if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
+#error "Assumption that scm_t_bits <= 128 bits has been violated."
+#endif
+
+#if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
+#error "Assumption that unsigned long <= 128 bits has been violated."
+#endif
+
+#if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
+#error "Assumption that unsigned long long <= 128 bits has been violated."
+#endif
+
 /* convert a 128 bit IPv6 address in network order to a host ordered
    SCM integer.  */
-static SCM ipv6_net_to_num (const char *src)
+static SCM ipv6_net_to_num (const scm_t_uint8 *src)
 {
-  int big_digits = 128 / SCM_BITSPERDIG;
-  const int bytes_per_dig = SCM_BITSPERDIG / 8;
-  char addr[16];
-  char *ptr = addr;
-  SCM result;
-
-  memcpy (addr, src, 16);
-  /* get rid of leading zeros.  */ 
-  while (big_digits > 0)
-    {
-      long test = 0;
+  int i = 0;
+  const scm_t_uint8 *ptr = src;
+  int num_zero_bytes = 0;
+  scm_t_uint8 addr[16];
 
-      memcpy (&test, ptr, bytes_per_dig);
-      if (test != 0)
-       break;
-      ptr += bytes_per_dig;
-      big_digits--;
-    }
-  FLIP_NET_HOST_128 (addr);
-  if (big_digits * bytes_per_dig <= sizeof (unsigned long))
+  /* count leading zeros (since we know it's bigendian, they'll be first) */ 
+  while (i < 16)
     {
-      /* this is just so that we use INUM where possible.  */
-      unsigned long l_addr;
+      if (*ptr) break;
+      num_zero_bytes++;
+      i++;
+    }
 
-      memcpy (&l_addr, addr, sizeof (unsigned long));
-      result = scm_ulong2num (l_addr);
+  if (SCM_SIZEOF_UNSIGNED_LONG_LONG != 0) /* compiler should optimize this */
+    {
+      if ((16 - num_zero_bytes) <= sizeof (unsigned long long))
+        {
+          /* it fits */
+          unsigned long long x;
+          
+          FLIPCPY_NET_HOST_128(addr, src);
+#ifdef WORDS_BIGENDIAN
+          memcpy (&x, addr + (16 - sizeof (x)), sizeof (x));
+#else
+          memcpy (&x, addr, sizeof (x));
+#endif
+          return scm_ulong_long2num (x);
+        }
     }
   else
     {
-      result = scm_i_mkbig (big_digits, 0);
-      memcpy (SCM_BDIGITS (result), addr, big_digits * bytes_per_dig);
+      if ((16 - num_zero_bytes) <= sizeof (unsigned long))
+        {
+          /* this is just so that we use INUM where possible.  */
+          unsigned long x;
+
+          FLIPCPY_NET_HOST_128(addr, src);          
+#ifdef WORDS_BIGENDIAN
+          memcpy (&x, addr + (16 - sizeof (x)), sizeof (x));
+#else
+          memcpy (&x, addr, sizeof (x));
+#endif
+          return scm_ulong2num (x);
+        }
     }
-  return result;
+  /* otherwise get the big hammer */
+  {
+    SCM result = scm_i_mkbig ();
+    
+    mpz_import (SCM_I_BIG_MPZ (result),
+                1, /* chunk */
+                1, /* big-endian chunk ordering */
+                16, /* chunks are 16 bytes long */
+                1, /* big-endian byte ordering */
+                0, /* "nails" -- leading unused bits per chunk */
+                src);
+    return scm_i_normbig (result);
+  }
 }  
 
 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
    network order.  */
-static void ipv6_num_to_net (SCM src, char *dst)
+static void ipv6_num_to_net (SCM src, scm_t_uint8 *dst)
 {
+  /* This code presumes that src has already been checked for range. */
   if (SCM_INUMP (src))
     {
-      uint32_t addr = htonl (SCM_INUM (src));
-
-      memset (dst, 0, 12);
-      memcpy (dst + 12, &addr, 4);
+      scm_t_signed_bits n = SCM_INUM (src);
+#ifdef WORDS_BIGENDIAN
+      memset (dst, 0, 16 - sizeof (scm_t_signed_bits));
+      memcpy (dst + (16 - sizeof (scm_t_signed_bits)),
+              &n,
+              sizeof (scm_t_signed_bits));
+#else
+      memset (dst + sizeof (scm_t_signed_bits),
+              0,
+              16 - sizeof (scm_t_signed_bits));
+      /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
+         a single loop perhaps, similar to the handling of bignums. */
+      memcpy (dst, &n, sizeof (scm_t_signed_bits));
+      FLIP_NET_HOST_128 (dst);
+#endif
     }
   else
     {
+      /* Presumes src has already been checked for fit -- see above. */
+      size_t count;
       memset (dst, 0, 16);
-      memcpy (dst, SCM_BDIGITS (src),
-             SCM_NUMDIGS (src) * (SCM_BITSPERDIG / 8));
-      FLIP_NET_HOST_128 (dst);
+      mpz_export (dst,
+                  &count,
+                  1, /* big-endian chunk ordering */
+                  16, /* chunks are 16 bytes long */
+                  1, /* big-endian byte ordering */
+                  0, /* "nails" -- leading unused bits per chunk */
+                  SCM_I_BIG_MPZ (src));
+      scm_remember_upto_here_1 (src);
     }
 }
 
+static int
+bignum_in_ipv6_range_p (SCM address)
+{
+  int result;
+  int sgn = mpz_sgn (SCM_I_BIG_MPZ (address));
+  
+  if (sgn < 0)
+    result = 0;
+  else
+    {
+      int size = mpz_sizeinbase (SCM_I_BIG_MPZ (address), 2);
+      if (size > 128) result = 0;
+      else result = 1;
+    }
+  scm_remember_upto_here_1 (address);
+  return result;
+}
+
 /* check that an SCM variable contains an IPv6 integer address.  */
 #define VALIDATE_INET6(which_arg, address)\
    if (SCM_INUMP (address))\
@@ -348,10 +408,7 @@ static void ipv6_num_to_net (SCM src, char *dst)
    else\
    {\
       SCM_VALIDATE_BIGINT (which_arg, address);\
-      SCM_ASSERT_RANGE (which_arg, address,\
-                       !SCM_BIGSIGN (address)\
-                       && (SCM_BITSPERDIG\
-                           * SCM_NUMDIGS (address) <= 128));\
+      SCM_ASSERT_RANGE (which_arg, address, bignum_in_ipv6_range_p);\
    }
 
 #ifdef HAVE_INET_PTON
@@ -382,7 +439,7 @@ SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
   else if (rv == 0)
     SCM_MISC_ERROR ("Bad address", SCM_EOL);
   if (af == AF_INET)
-    return scm_ulong2num (ntohl (*(uint32_t *) dst));
+    return scm_ulong2num (ntohl (*(scm_t_uint32 *) dst));
   else
     return ipv6_net_to_num ((char *) dst);
 }
@@ -414,7 +471,7 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
   SCM_VALIDATE_INUM_COPY (1, family, af);
   SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
   if (af == AF_INET)
-    *(uint32_t *) addr6 = htonl (SCM_NUM2ULONG (2, address));
+    *(scm_t_uint32 *) addr6 = htonl (SCM_NUM2ULONG (2, address));
   else
     {
       VALIDATE_INET6 (2, address);
@@ -707,7 +764,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
        SCM_VALIDATE_CONS (which_arg + 1, *args);
        SCM_VALIDATE_INUM_COPY (which_arg + 1, SCM_CAR (*args), port);
        *args = SCM_CDR (*args);
-       soka = (struct sockaddr_in *) malloc (sizeof (struct sockaddr_in));
+       soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
        if (!soka)
          scm_memory_error (proc);
        /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
@@ -745,7 +802,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
                *args = SCM_CDR (*args);
              }
          }
-       soka = (struct sockaddr_in6 *) malloc (sizeof (struct sockaddr_in6));
+       soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
        if (!soka)
          scm_memory_error (proc);
 #ifdef SIN_LEN6
@@ -777,7 +834,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
           member of the structure.  */
        addr_size = sizeof (struct sockaddr_un)
          + max (0, SCM_STRING_LENGTH (address) + 1 - (sizeof soka->sun_path));
-       soka = (struct sockaddr_un *) malloc (addr_size);
+       soka = (struct sockaddr_un *) scm_malloc (addr_size);
        if (!soka)
          scm_memory_error (proc);
        memset (soka, 0, addr_size);  /* for sun_len: see sin_len above. */
@@ -922,7 +979,8 @@ SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
 
 /* Put the components of a sockaddr into a new SCM vector.  */
 static SCM
-scm_addr_vector (const struct sockaddr *address, const char *proc)
+scm_addr_vector (const struct sockaddr *address, int addr_size, 
+                const char *proc)
 {
   short int fam = address->sa_family;
   SCM result =SCM_EOL;
@@ -967,7 +1025,13 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
        result = scm_c_make_vector (2, SCM_UNSPECIFIED);
 
        SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam));
-       SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path)));
+       /* When addr_size is not enough to cover sun_path, do not try
+          to access it. */
+       if (addr_size <= offsetof (struct sockaddr_un, sun_path))
+         SCM_VECTOR_SET(result, 1, SCM_BOOL_F);
+       else
+         SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path,
+                                                   strlen (nad->sun_path)));
       }
       break;
 #endif
@@ -1028,7 +1092,7 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
   if (newfd == -1)
     SCM_SYSERROR;
   newsock = SCM_SOCK_FD_TO_PORT (newfd);
-  address = scm_addr_vector (addr, FUNC_NAME);
+  address = scm_addr_vector (addr, addr_size, FUNC_NAME);
   return scm_cons (newsock, address);
 }
 #undef FUNC_NAME
@@ -1050,7 +1114,7 @@ SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
   fd = SCM_FPORT_FDES (sock);
   if (getsockname (fd, addr, &addr_size) == -1)
     SCM_SYSERROR;
-  return scm_addr_vector (addr, FUNC_NAME);
+  return scm_addr_vector (addr, addr_size, FUNC_NAME);
 }
 #undef FUNC_NAME
 
@@ -1072,7 +1136,7 @@ SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
   fd = SCM_FPORT_FDES (sock);
   if (getpeername (fd, addr, &addr_size) == -1)
     SCM_SYSERROR;
-  return scm_addr_vector (addr, FUNC_NAME);
+  return scm_addr_vector (addr, addr_size, FUNC_NAME);
 }
 #undef FUNC_NAME
 
@@ -1199,7 +1263,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
   if (rv == -1)
     SCM_SYSERROR;
   if (addr->sa_family != AF_UNSPEC)
-    address = scm_addr_vector (addr, FUNC_NAME);
+    address = scm_addr_vector (addr, addr_size, FUNC_NAME);
   else
     address = SCM_BOOL_F;