l4/pkg/ocaml/contrib/otherlibs/win32unix/socket.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: socket.c 4765 2002-04-30 15:00:48Z xleroy $ */
  15
  16 #include <mlvalues.h>
  17 #include "unixsupport.h"
  18
  19 int socket_domain_table[] = {
  20   PF_UNIX, PF_INET
  21 };
  22
  23 int socket_type_table[] = {
  24   SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
  25 };
  26
  27 CAMLprim value unix_socket(domain, type, proto)
  28      value domain, type, proto;
  29 {
  30   SOCKET s;
  31   int oldvalue, oldvaluelen, newvalue, retcode;
  32
  33   oldvaluelen = sizeof(oldvalue);
  34   retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
  35                        (char *) &oldvalue, &oldvaluelen);
  36   if (retcode == 0) {
  37     /* Set sockets to synchronous mode */
  38     newvalue = SO_SYNCHRONOUS_NONALERT;
  39     setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
  40                (char *) &newvalue, sizeof(newvalue));
  41   }
  42   s = socket(socket_domain_table[Int_val(domain)],
  43                    socket_type_table[Int_val(type)],
  44                    Int_val(proto));
  45   if (retcode == 0) {
  46     /* Restore initial mode */
  47     setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
  48                (char *) &oldvalue, oldvaluelen);
  49   }
  50   if (s == INVALID_SOCKET) {
  51     win32_maperr(WSAGetLastError());
  52     uerror("socket", Nothing);
  53   }
  54   return win_alloc_socket(s);
  55 }