* hashtab.h: Bugfix: use SCM_API (WAS: extern).
[bpt/guile.git] / libguile / socket.c
index cab3b65..c268d5e 100644 (file)
@@ -12,7 +12,7 @@
  *
  * 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
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 
                      + strlen ((ptr)->sun_path))
 #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.  */
-
 \f
 
 SCM_DEFINE (scm_htons, "htons", 1, 0, 0, 
@@ -278,65 +274,16 @@ SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
 static SCM
 scm_from_ipv6 (const scm_t_uint8 *src)
 {
-  int i = 0;
-  const scm_t_uint8 *ptr = src;
-  int num_zero_bytes = 0;
-  scm_t_uint8 addr[16];
-
-  /* count leading zeros (since we know it's bigendian, they'll be first) */ 
-  while (i < 16)
-    {
-      if (*ptr) break;
-      num_zero_bytes++;
-      i++;
-    }
-
-  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_from_ulong_long (x);
-        }
-    }
-  else
-    {
-      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_from_ulong (x);
-        }
-    }
-  /* 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);
-  }
-}  
+  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.  */
@@ -594,13 +541,19 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
 #define FUNC_NAME s_scm_setsockopt
 {
   int fd;
-  int optlen = -1;
-  /* size of optval is the largest supported option.  */
+
+  int opt_int;
 #ifdef HAVE_STRUCT_LINGER
-  char optval[sizeof (struct linger)];
-#else
-  char optval[sizeof (size_t)];
+  struct linger opt_linger;
+#endif
+
+#if HAVE_STRUCT_IP_MREQ
+  struct ip_mreq opt_mreq;
 #endif
+
+  const void *optval = NULL;
+  socklen_t optlen = 0;
+
   int ilevel, ioptname;
 
   sock = SCM_COERCE_OUTPORT (sock);
@@ -610,39 +563,25 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
   ioptname = scm_to_int (optname);
 
   fd = SCM_FPORT_FDES (sock);
-
+  
   if (ilevel == SOL_SOCKET)
     {
 #ifdef SO_LINGER
       if (ioptname == SO_LINGER)
        {
 #ifdef HAVE_STRUCT_LINGER
-         struct linger ling;
-         long lv;
-
-         SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME);
-         lv = SCM_NUM2LONG (4, SCM_CAR (value));
-         ling.l_onoff = (int) lv;
-         SCM_ASSERT_RANGE (SCM_ARG4, value, ling.l_onoff == lv);
-         lv = SCM_NUM2LONG (4, SCM_CDR (value));
-         ling.l_linger = (int) lv;
-         SCM_ASSERT_RANGE (SCM_ARG4, value, ling.l_linger == lv);
-         optlen = (int) sizeof (struct linger);
-         memcpy (optval, (void *) &ling, optlen);
+         SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
+         opt_linger.l_onoff = scm_to_int (SCM_CAR (value));
+         opt_linger.l_linger = scm_to_int (SCM_CDR (value));
+         optlen = sizeof (struct linger);
+         optval = &opt_linger;
 #else
-         int ling;
-         long lv;
-
-         SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME);
+         SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
+         opt_int = scm_to_int (SCM_CAR (value));
          /* timeout is ignored, but may as well validate it.  */
-         lv = SCM_NUM2LONG (4, SCM_CDR (value));
-         ling = (int) lv;
-         SCM_ASSERT_RANGE (SCM_ARG4, value, ling == lv);
-         lv = SCM_NUM2LONG (4, SCM_CAR (value));
-         ling = (int) lv;
-         SCM_ASSERT_RANGE (SCM_ARG4, value, ling == lv);
-         optlen = (int) sizeof (int);
-         (*(int *) optval) = ling;
+         scm_to_int (SCM_CDR (value));
+         optlen = sizeof (int);
+         optval = &opt_int;
 #endif
        }
       else
@@ -656,23 +595,34 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
 #endif
            )
          {
-           long lv = SCM_NUM2LONG (4, value);
-
-           optlen = (int) sizeof (size_t);
-           (*(size_t *) optval) = (size_t) lv;
+           opt_int = scm_to_int (value);
+           optlen = sizeof (size_t);
+           optval = &opt_int;
          }
     }
-  if (optlen == -1)
+
+#if HAVE_STRUCT_IP_MREQ
+  if (ilevel == IPPROTO_IP &&
+      (ioptname == IP_ADD_MEMBERSHIP || ioptname == IP_DROP_MEMBERSHIP))
     {
-      /* Most options take an int.  */
-      long lv = SCM_NUM2LONG (4, value);
-      int val = (int) lv;
+      /* Fourth argument must be a pair of addresses. */
+      SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
+      opt_mreq.imr_multiaddr.s_addr = htonl (scm_to_ulong (SCM_CAR (value)));
+      opt_mreq.imr_interface.s_addr = htonl (scm_to_ulong (SCM_CDR (value)));
+      optlen = sizeof (opt_mreq);
+      optval = &opt_mreq;
+    }
+#endif
 
-      SCM_ASSERT_RANGE (SCM_ARG4, value, val == lv);
-      optlen = (int) sizeof (int);
-      (*(int *) optval) = val;
+  if (optval == NULL)
+    {
+      /* Most options take an int.  */
+      opt_int = scm_to_int (value);
+      optlen = sizeof (int);
+      optval = &opt_int;
     }
-  if (setsockopt (fd, ilevel, ioptname, (void *) optval, optlen) == -1)
+
+  if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
 }
@@ -755,11 +705,11 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
        SCM_VALIDATE_CONS (which_arg + 1, *args);
        port = scm_to_int (SCM_CAR (*args));
        *args = SCM_CDR (*args);
-       if (SCM_CONSP (*args))
+       if (scm_is_pair (*args))
          {
            SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
            *args = SCM_CDR (*args);
-           if (SCM_CONSP (*args))
+           if (scm_is_pair (*args))
              {
                SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
                                         scope_id);
@@ -959,12 +909,12 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
 
        result = scm_c_make_vector (3, SCM_UNSPECIFIED);
 
-       SCM_VECTOR_SET(result, 0,
-                      scm_from_short (fam));
-       SCM_VECTOR_SET(result, 1,
-                      scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
-       SCM_VECTOR_SET(result, 2,
-                      scm_from_ushort (ntohs (nad->sin_port)));
+       SCM_SIMPLE_VECTOR_SET(result, 0,
+                             scm_from_short (fam));
+       SCM_SIMPLE_VECTOR_SET(result, 1,
+                             scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
+       SCM_SIMPLE_VECTOR_SET(result, 2,
+                             scm_from_ushort (ntohs (nad->sin_port)));
       }
       break;
 #ifdef HAVE_IPV6
@@ -973,14 +923,14 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
        const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
 
        result = scm_c_make_vector (5, SCM_UNSPECIFIED);
-       SCM_VECTOR_SET(result, 0, scm_from_short (fam));
-       SCM_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
-       SCM_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
-       SCM_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
+       SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
+       SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
+       SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
+       SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
 #ifdef HAVE_SIN6_SCOPE_ID
-       SCM_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
+       SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
 #else
-       SCM_VECTOR_SET(result, 4, SCM_INUM0);
+       SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
 #endif
       }
       break;
@@ -992,13 +942,13 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
 
        result = scm_c_make_vector (2, SCM_UNSPECIFIED);
 
-       SCM_VECTOR_SET(result, 0, scm_from_short (fam));
+       SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
        /* 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);
+         SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
        else
-         SCM_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
+         SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
       }
       break;
 #endif
@@ -1299,7 +1249,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
   fd = SCM_FPORT_FDES (sock);
   soka = scm_fill_sockaddr (scm_to_int (fam), address, &args_and_flags, 4,
                            FUNC_NAME, &size);
-  if (SCM_NULLP (args_and_flags))
+  if (scm_is_null (args_and_flags))
     flg = 0;
   else
     {
@@ -1464,6 +1414,11 @@ scm_init_socket ()
   scm_i_init_socket_Win32 ();
 #endif
 
+#ifdef IP_ADD_MEMBERSHIP
+  scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
+  scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
+#endif
+
   scm_add_feature ("socket");
 
 #include "libguile/socket.x"