l4/pkg/ocaml/contrib/otherlibs/win32unix/sockopt.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*  Xavier Leroy and Pascal Cuoq, 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: sockopt.c 8968 2008-08-01 13:46:08Z xleroy $ */
  15
  16 #include <errno.h>
  17 #include <mlvalues.h>
  18 #include <memory.h>
  19 #include <alloc.h>
  20 #include <fail.h>
  21 #include "unixsupport.h"
  22 #include "socketaddr.h"
  23
  24 #ifndef IPPROTO_IPV6
  25 #define IPPROTO_IPV6 (-1)
  26 #endif
  27 #ifndef IPV6_V6ONLY
  28 #define IPV6_V6ONLY (-1)
  29 #endif
  30
  31 enum option_type {
  32   TYPE_BOOL = 0,
  33   TYPE_INT = 1,
  34   TYPE_LINGER = 2,
  35   TYPE_TIMEVAL = 3,
  36   TYPE_UNIX_ERROR = 4
  37 };
  38
  39 struct socket_option {
  40   int level;
  41   int option;
  42 };
  43
  44 /* Table of options, indexed by type */
  45
  46 static struct socket_option sockopt_bool[] = {
  47   { SOL_SOCKET, SO_DEBUG },
  48   { SOL_SOCKET, SO_BROADCAST },
  49   { SOL_SOCKET, SO_REUSEADDR },
  50   { SOL_SOCKET, SO_KEEPALIVE },
  51   { SOL_SOCKET, SO_DONTROUTE },
  52   { SOL_SOCKET, SO_OOBINLINE },
  53   { SOL_SOCKET, SO_ACCEPTCONN },
  54   { IPPROTO_TCP, TCP_NODELAY },
  55   { IPPROTO_IPV6, IPV6_V6ONLY}
  56 };
  57
  58 static struct socket_option sockopt_int[] = {
  59   { SOL_SOCKET, SO_SNDBUF },
  60   { SOL_SOCKET, SO_RCVBUF },
  61   { SOL_SOCKET, SO_ERROR },
  62   { SOL_SOCKET, SO_TYPE },
  63   { SOL_SOCKET, SO_RCVLOWAT },
  64   { SOL_SOCKET, SO_SNDLOWAT } };
  65
  66 static struct socket_option sockopt_linger[] = {
  67   { SOL_SOCKET, SO_LINGER }
  68 };
  69
  70 static struct socket_option sockopt_timeval[] = {
  71   { SOL_SOCKET, SO_RCVTIMEO },
  72   { SOL_SOCKET, SO_SNDTIMEO }
  73 };
  74
  75 static struct socket_option sockopt_unix_error[] = {
  76   { SOL_SOCKET, SO_ERROR }
  77 };
  78
  79 static struct socket_option * sockopt_table[] = {
  80   sockopt_bool,
  81   sockopt_int,
  82   sockopt_linger,
  83   sockopt_timeval,
  84   sockopt_unix_error
  85 };
  86
  87 static char * getsockopt_fun_name[] = {
  88   "getsockopt",
  89   "getsockopt_int",
  90   "getsockopt_optint",
  91   "getsockopt_float",
  92   "getsockopt_error"
  93 };
  94
  95 static char * setsockopt_fun_name[] = {
  96   "setsockopt",
  97   "setsockopt_int",
  98   "setsockopt_optint",
  99   "setsockopt_float",
 100   "setsockopt_error"
 101 };
 102
 103 union option_value {
 104   int i;
 105   struct linger lg;
 106   struct timeval tv;
 107 };
 108
 109 CAMLexport value
 110 unix_getsockopt_aux(char * name,
 111                     enum option_type ty, int level, int option,
 112                     value socket)
 113 {
 114   union option_value optval;
 115   socklen_param_type optsize;
 116
 117
 118   switch (ty) {
 119   case TYPE_BOOL:
 120   case TYPE_INT:
 121   case TYPE_UNIX_ERROR:
 122     optsize = sizeof(optval.i); break;
 123   case TYPE_LINGER:
 124     optsize = sizeof(optval.lg); break;
 125   case TYPE_TIMEVAL:
 126     optsize = sizeof(optval.tv); break;
 127   default:
 128     unix_error(EINVAL, name, Nothing);
 129   }
 130
 131   if (getsockopt(Socket_val(socket), level, option,
 132                  (void *) &optval, &optsize) == -1)
 133     uerror(name, Nothing);
 134
 135   switch (ty) {
 136   case TYPE_BOOL:
 137   case TYPE_INT:
 138     return Val_int(optval.i);
 139   case TYPE_LINGER:
 140     if (optval.lg.l_onoff == 0) {
 141       return Val_int(0);        /* None */
 142     } else {
 143       value res = alloc_small(1, 0); /* Some */
 144       Field(res, 0) = Val_int(optval.lg.l_linger);
 145       return res;
 146     }
 147   case TYPE_TIMEVAL:
 148     return copy_double((double) optval.tv.tv_sec
 149                        + (double) optval.tv.tv_usec / 1e6);
 150   case TYPE_UNIX_ERROR:
 151     if (optval.i == 0) {
 152       return Val_int(0);        /* None */
 153     } else {
 154       value err, res;
 155       err = unix_error_of_code(optval.i);
 156       Begin_root(err);
 157         res = alloc_small(1, 0); /* Some */
 158         Field(res, 0) = err;
 159       End_roots();
 160       return res;
 161     }
 162   default:
 163     unix_error(EINVAL, name, Nothing);
 164     return Val_unit; /* Avoid warning */
 165   }
 166 }
 167
 168 CAMLexport value
 169 unix_setsockopt_aux(char * name,
 170                     enum option_type ty, int level, int option,
 171                     value socket, value val)
 172 {
 173   union option_value optval;
 174   socklen_param_type optsize;
 175   double f;
 176
 177   switch (ty) {
 178   case TYPE_BOOL:
 179   case TYPE_INT:
 180     optsize = sizeof(optval.i);
 181     optval.i = Int_val(val);
 182     break;
 183   case TYPE_LINGER:
 184     optsize = sizeof(optval.lg);
 185     optval.lg.l_onoff = Is_block (val);
 186     if (optval.lg.l_onoff)
 187       optval.lg.l_linger = Int_val (Field (val, 0));
 188     break;
 189   case TYPE_TIMEVAL:
 190     f = Double_val(val);
 191     optsize = sizeof(optval.tv);
 192     optval.tv.tv_sec = (int) f;
 193     optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec));
 194     break;
 195   case TYPE_UNIX_ERROR:
 196   default:
 197     unix_error(EINVAL, name, Nothing);
 198   }
 199
 200   if (setsockopt(Socket_val(socket), level, option,
 201                  (void *) &optval, optsize) == -1)
 202     uerror(name, Nothing);
 203
 204   return Val_unit;
 205 }
 206
 207 CAMLprim value unix_getsockopt(value vty, value vsocket, value voption)
 208 {
 209   enum option_type ty = Int_val(vty);
 210   struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
 211   return unix_getsockopt_aux(getsockopt_fun_name[ty],
 212                              ty,
 213                              opt->level,
 214                              opt->option,
 215                              vsocket);
 216 }
 217
 218 CAMLprim value unix_setsockopt(value vty, value vsocket, value voption,
 219                                value val)
 220 {
 221   enum option_type ty = Int_val(vty);
 222   struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
 223   return unix_setsockopt_aux(setsockopt_fun_name[ty],
 224                              ty,
 225                              opt->level,
 226                              opt->option,
 227                              vsocket,
 228                              val);
 229 }