Original bug ID: 452
Reporter: administrator
Status: closed
Resolution: fixed
Priority: normal
Severity: feature
Category: ~DO NOT USE (was: OCaml general)

Bug description

Voici une nouvelle version de sockopt.c, et un patch pour unix.ml{,i}
implémentant l'interface SUS V2 complète, à quelques détails près.

Quelques notes:

sockopt.c:

• toutes les fonctions sont décomposées en 2: unix_[gs]etsockopt_xx,
  et [gs]etsockopt_xx qui permet de fixer level: c'est que cash permet
  de spécifier autre chose que SOL_SOCKET, et que je préfère ne pas
  l'interdire de suite (tant que je ne considère pas l'existence de
  paramètres dépendants OS comme indémerdables).
• je n'ai pas testé le code sur un exemple, faute d'en avoir un sous
  le coude; s'il en existe déjà, je suis preneur. Ceci dit, le code
  est aussi identique entre les diverses versions que possible (ce qui
  le laisse sujet au bogues de type coupé-collé). Je l'ai relu
  soigneusement, mais une relecture indépendante ne peut pas faire de
  mal.
• j'ai déplacé SO_ERROR dans [gs]etsockopt_int, car il ne me semble
  pas être un bool (l'émetteur du SO_ERROR dans le module Unix #2590 a réussi à introduire un
  bogue :-). Par contre, j'ai ajouté SO_ACCEPTCONN à
  [gs]etsockopt_bool, malgré que SUS V2 ne précise pas explicitement
  `This is a boolean option'; je pense que c'est une erreur de SUS V2.
  À confirmer.
• la seule protection contre les OS pas tout à fait compatibles SUS V2
  est le #ifndef SO_ACCEPTCONN (car mon Linux ne le connaît pas).

unix.ml: le même patch est à appliquer à threads/unix.ml

unix.mli:

• j'ai nommé les différentes versions [gs]etsockopt_ (sauf pour
  le type bool, pour la compatibilité). Ces 2 décisions ne sont
  peut-être pas les meilleures (YMMV).
• je n'ai pas commenté les nouvelles options SO_*: la documentation me
  semble assez critique pour réserver ça à Xavier :-).

Voilà, j'espère n'avoir rien oublié,

Bruno.

//
/* /
/ Objective Caml /
/ /
/ Xavier Leroy, projet Cristal, INRIA Rocquencourt /
/ /
/ Copyright 1996 Institut National de Recherche en Informatique et /
/ en Automatique. All rights reserved. This file is distributed /
/ under the terms of the GNU Library General Public License. /
/ */
//

/* $Id: sockopt.c,v 1.11 2001/06/25 08:19:07 xleroy Exp $ */

#include <mlvalues.h>
#include <alloc.h>
#include "unixsupport.h"

#ifdef HAS_SOCKETS

#include <sys/time.h>
#include <sys/types.h>
#include <sys/socket.h>

#include "socketaddr.h"

#ifndef SO_BROADCAST
#define SO_BROADCAST (-1)
#endif
#ifndef SO_OOBINLINE
#define SO_OOBINLINE (-1)
#endif
#ifndef SO_ACCEPTCONN
#define SO_ACCEPTCONN (-1)
#endif
#ifndef SO_ERROR
#define SO_ERROR (-1)
#endif

static int sockopt_bool[] = {
SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE,
SO_DONTROUTE, SO_OOBINLINE, SO_ACCEPTCONN };

static int sockopt_int[] = {
SO_SNDBUF, SO_RCVBUF, SO_ERROR, SO_TYPE, SO_RCVLOWAT,
SO_SNDLOWAT };

value getsockopt_int(int *sockopt, value socket, value level, value option)
{
int optval;
socklen_param_type optsize;

optsize = sizeof(optval);
if (getsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
(void *) &optval, &optsize) == -1)
uerror("getsockopt", Nothing);
return Val_int(optval);
}

value setsockopt_int(int sockopt, value socket, value level, value option, value status) / ML */
{
int optval = Int_val(status);
if (setsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
(void *) &optval, sizeof(optval)) == -1)
uerror("setsockopt", Nothing);
return Val_unit;
}

value unix_getsockopt_bool(value socket, value option) { /* ML */
return getsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option);
}

value unix_setsockopt_bool(value socket, value option, value status) /* ML */
{
return setsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option, status);
}

value unix_getsockopt_int(value socket, value option) { /* ML */
return getsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option);
}

value unix_setsockopt_int(value socket, value option, value status) /* ML */
{
return setsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option, status);
}

static int sockopt_optint[] = { SO_LINGER };

value getsockopt_optint(int sockopt, value socket, value level, value option)
{
struct linger optval;
socklen_param_type optsize;
value res = Val_int(0); / None */

optsize = sizeof(optval);
if (getsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
(void *) &optval, &optsize) == -1)
uerror("getsockopt", Nothing);
if (optval.l_onoff != 0) {
res = alloc_small(1, 0);
Field(res, 0) = Val_int(optval.l_linger);
}
return res;
}

value setsockopt_optint(int *sockopt, value socket, value level, value option, value status)
{
struct linger optval;

optval.l_onoff = Is_block (status);
if (optval.l_onoff)
optval.l_linger = Int_val (Field (status, 0));
if (setsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
(void *) &optval, sizeof(optval)) == -1)
uerror("setsockopt", Nothing);
return Val_unit;
}

value unix_getsockopt_optint(value socket, value option) /* ML */
{
return getsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option);
}

value unix_setsockopt_optint(value socket, value option, value status) /* ML */
{
return setsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option, status);
}

static int sockopt_float[] = { SO_RCVTIMEO, SO_SNDTIMEO };

value getsockopt_float(int sockopt, value socket, value level, value option) / ML */
{
struct timeval tv;
socklen_param_type optsize;

optsize = sizeof(tv);
if (getsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
(void *) &tv, &optsize) == -1)
uerror("getsockopt", Nothing);
return copy_double((double) tv.tv_sec + (double) tv.tv_usec / 1e6);
}

value unix_getsockopt_float(value socket, value option) /* ML */
{
return getsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option);
}

value setsockopt_float(int sockopt, value socket, value level, value option, value status) / ML */
{
struct timeval tv;
double tv_f;

tv_f = Double_val(status);
tv.tv_sec = (int)tv_f;
tv.tv_usec = (int) (1e6 * (tv_f - tv.tv_sec));
if (setsockopt(Int_val(socket), Int_val(level), sockopt[Int_val(option)],
(void *) &tv, sizeof(tv)) == -1)
uerror("setsockopt", Nothing);
return Val_unit;
}

value unix_setsockopt_float(value socket, value option, value status) /* ML */
{
return setsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option, status);
}

#else

value unix_getsockopt(value socket, value option)
{ invalid_argument("getsockopt not implemented"); }

value unix_setsockopt(value socket, value option, value status)
{ invalid_argument("setsockopt not implemented"); }

#endif

Index: unix.ml

RCS file: /caml/ocaml/otherlibs/unix/unix.ml,v
retrieving revision 1.48
diff -c -a -r1.48 unix.ml
*** unix.ml 2001/07/16 19:40:17 1.48
--- unix.ml 2001/07/24 15:30:38

*** 376,389 ****
| MSG_DONTROUTE
| MSG_PEEK

! type socket_option =
SO_DEBUG
| SO_BROADCAST
| SO_REUSEADDR
| SO_KEEPALIVE
| SO_DONTROUTE
| SO_OOBINLINE
| SO_ERROR

external socket : socket_domain -> socket_type -> int -> file_descr
= "unix_socket"
--- 376,403 ----
| MSG_DONTROUTE
| MSG_PEEK

! type socket_bool_option =
SO_DEBUG
| SO_BROADCAST
| SO_REUSEADDR
| SO_KEEPALIVE
| SO_DONTROUTE
| SO_OOBINLINE

• | SO_ACCEPTCONN
• type socket_int_option =

• SO_SNDBUF
  

• | SO_RCVBUF
  | SO_ERROR
• | SO_TYPE
• | SO_RCVLOWAT
• | SO_SNDLOWAT
• type socket_optint_option = SO_LINGER
• type socket_float_option =

• SO_RCVTIMEO
  

• | SO_SNDTIMEO

external socket : socket_domain -> socket_type -> int -> file_descr
= "unix_socket"

*** 394,400 ****
external bind : file_descr -> sockaddr -> unit = "unix_bind"
external connect : file_descr -> sockaddr -> unit = "unix_connect"
external listen : file_descr -> int -> unit = "unix_listen"
! external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown"
external getsockname : file_descr -> sockaddr = "unix_getsockname"
external getpeername : file_descr -> sockaddr = "unix_getpeername"

--- 408,414 ----
external bind : file_descr -> sockaddr -> unit = "unix_bind"
external connect : file_descr -> sockaddr -> unit = "unix_connect"
external listen : file_descr -> int -> unit = "unix_listen"
! external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown"
external getsockname : file_descr -> sockaddr = "unix_getsockname"
external getpeername : file_descr -> sockaddr = "unix_getpeername"

*** 427,436 ****
if len < 0 || ofs + len > String.length buf
then invalid_arg "Unix.sendto"
else unsafe_sendto fd buf ofs len flags addr

• external getsockopt : file_descr -> socket_option -> bool = "unix_getsockopt"
• external setsockopt : file_descr -> socket_option -> bool -> unit

•                                                       = "unix_setsockopt"
  

  type host_entry =
  { h_name : string;
  h_aliases : string array;
  --- 441,464 ----
  if len < 0 || ofs + len > String.length buf
  then invalid_arg "Unix.sendto"
  else unsafe_sendto fd buf ofs len flags addr

• external getsockopt : file_descr -> socket_bool_option -> bool

•                                             = "unix_getsockopt_bool"
  

• external setsockopt : file_descr -> socket_bool_option -> bool -> unit

•                                             = "unix_setsockopt_bool"
  

• external getsockopt_int : file_descr -> socket_int_option -> int

•                                             = "unix_getsockopt_int"
  

• external setsockopt_int : file_descr -> socket_int_option -> int -> unit

•                                             = "unix_setsockopt_int"
  

• external getsockopt_optint : file_descr -> socket_optint_option -> int option

•                                             = "unix_getsockopt_optint"
  

• external setsockopt_optint : file_descr -> socket_optint_option -> int option -> unit

•                                             = "unix_setsockopt_optint"
  

• external getsockopt_float : file_descr -> socket_float_option -> float

•                                             = "unix_getsockopt_float"
  

• external setsockopt_float : file_descr -> socket_float_option -> float -> unit

•                                             = "unix_setsockopt_float"
  

  type host_entry =
  { h_name : string;
  h_aliases : string array;

Index: unix.mli

RCS file: /caml/ocaml/otherlibs/unix/unix.mli,v
retrieving revision 1.53
diff -c -a -r1.53 unix.mli
*** unix.mli 2001/06/25 08:19:08 1.53
--- unix.mli 2001/07/24 15:52:49

*** 771,791 ****
-> mode:msg_flag list -> addr:sockaddr -> int
(* Send data over an unconnected socket. *)

! type socket_option =
SO_DEBUG (* Record debugging information )
| SO_BROADCAST ( Permit sending of broadcast messages )
| SO_REUSEADDR ( Allow reuse of local addresses for bind )
| SO_KEEPALIVE ( Keep connection active )
| SO_DONTROUTE ( Bypass the standard routing algorithms )
| SO_OOBINLINE ( Leave out-of-band data in line )
| SO_ERROR ( Get and clear the pending socket error )
( The socket options that can be consulted with [getsockopt]
and modified with [setsockopt]. *)

! val getsockopt : file_descr -> socket_option -> bool
(* Return the current status of an option in the given socket. )
! val setsockopt : file_descr -> socket_option -> bool -> unit
( Set or clear an option in the given socket. *)

(*** High-level network connection functions *)

--- 771,818 ----
-> mode:msg_flag list -> addr:sockaddr -> int
(* Send data over an unconnected socket. *)

! type socket_bool_option =
SO_DEBUG (* Record debugging information )
| SO_BROADCAST ( Permit sending of broadcast messages )
| SO_REUSEADDR ( Allow reuse of local addresses for bind )
| SO_KEEPALIVE ( Keep connection active )
| SO_DONTROUTE ( Bypass the standard routing algorithms )
| SO_OOBINLINE ( Leave out-of-band data in line *)

• | SO_ACCEPTCONN
• type socket_int_option =

• SO_SNDBUF
  

• | SO_RCVBUF
  | SO_ERROR (* Get and clear the pending socket error *)
• | SO_TYPE
• | SO_RCVLOWAT
• | SO_SNDLOWAT
• type socket_optint_option =

• SO_LINGER
  

• type socket_float_option =

• SO_RCVTIMEO
  

• | SO_SNDTIMEO
  (* The socket options that can be consulted with [getsockopt]
  and modified with [setsockopt]. *)

! val getsockopt : file_descr -> socket_bool_option -> bool
(* Return the current status of an option in the given socket. )
! val setsockopt : file_descr -> socket_bool_option -> bool -> unit
( Set or clear an option in the given socket. *)

• val getsockopt_int : file_descr -> socket_int_option -> int

•     (* Return the current status of an int option in the given socket. *)
  

• val setsockopt_int : file_descr -> socket_int_option -> int -> unit

•     (* Set the value of an int option in the given socket. *)
  

• val getsockopt_optint : file_descr -> socket_optint_option -> int option

•     (* Return the current status of an optional int option in the given socket. *)
  

• val setsockopt_optint : file_descr -> socket_optint_option -> int option -> unit

•     (* Disable or set the value of an int option in the given socket. *)
  

• val getsockopt_float : file_descr -> socket_float_option -> float

•     (* Return the current status of a float option in the given socket. *)
  

• val setsockopt_float : file_descr -> socket_float_option -> float -> unit

•     (* Set the value of a float option in the given socket. *)
  

  (*** High-level network connection functions *)