diff -rbBcN ocaml-3.01/otherlibs/unix/Makefile ocaml-salex-3.01/otherlibs/unix/Makefile *** ocaml-3.01/otherlibs/unix/Makefile Thu Mar 9 04:12:28 2000 --- ocaml-salex-3.01/otherlibs/unix/Makefile Mon Jun 18 09:06:11 2001 *************** *** 33,39 **** mkfifo.o nice.o open.o opendir.o pipe.o putenv.o read.o \ readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \ setgid.o setsid.o setuid.o shutdown.o signals.o \ ! sleep.o socket.o socketaddr.o \ socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \ time.o times.o truncate.o umask.o unixsupport.o unlink.o \ utimes.o wait.o write.o --- 33,39 ---- mkfifo.o nice.o open.o opendir.o pipe.o putenv.o read.o \ readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \ setgid.o setsid.o setuid.o shutdown.o signals.o \ ! sioc.o sleep.o socket.o socketaddr.o \ socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \ time.o times.o truncate.o umask.o unixsupport.o unlink.o \ utimes.o wait.o write.o diff -rbBcN ocaml-3.01/otherlibs/unix/sioc.c ocaml-salex-3.01/otherlibs/unix/sioc.c *** ocaml-3.01/otherlibs/unix/sioc.c Wed Dec 31 19:00:00 1969 --- ocaml-salex-3.01/otherlibs/unix/sioc.c Mon Jun 18 09:36:13 2001 *************** *** 0 **** --- 1,215 ---- + /***********************************************************************/ + /* */ + /* Objective Caml */ + /* */ + /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ + /* */ + /* Copyright 1996 Institut National de Recherche en Informatique et */ + /* Automatique. Distributed only by permission. */ + /* */ + /***********************************************************************/ + + #include + #include + #include + #include + /* #include */ + #include + #include + #include "unixsupport.h" + + #ifdef HAS_SOCKETS + + #include + #include + #include + #include + #include + #include + #include /* for ARPHDR_* */ + #include "socketaddr.h" + + /* Must be the same order as type if_flag */ + static int if_flags[] = { + IFF_UP, IFF_BROADCAST, IFF_DEBUG, IFF_LOOPBACK, IFF_POINTOPOINT, + IFF_NOTRAILERS, IFF_RUNNING, IFF_NOARP, IFF_PROMISC, IFF_ALLMULTI, + IFF_MULTICAST }; + + /* Unfortunately, I don't know of any simple way to figure out how + * many interfaces are on the machine before doing the call to SIOCGIFCONF. + * As such, I allocate enough space so that the kernel can return + * information on 20 interfaces. For Linux, in kernel 2.1.65, this + * takes 648 bytes (32 bytes/interface, plus 8 bytes for a header). + */ + #define MAX_IFS 20 + value unix_siocgifconf(value sock) + { + int ret; + struct ifconf ifconf; + struct ifreq ifreqs[20]; + value h, t, addr, sa, ifrp; + int num_ifs; + int i; + + ifconf.ifc_len = sizeof(ifreqs); + ifconf.ifc_req = ifreqs; + enter_blocking_section(); + ret = ioctl(Int_val(sock), SIOCGIFCONF, &ifconf); + leave_blocking_section(); + if (ret == -1) uerror("siocgifconf", Nothing); + Begin_roots5 (h, t, addr, sa, ifrp); + num_ifs = ifconf.ifc_len / sizeof(struct ifreq); + h = Val_int(0); /* nil at end of list */ + t = Val_int(0); /* keep GC happy */ + for (i = 0; i < num_ifs; i++) { + if (ifreqs[i].ifr_addr.sa_family != AF_INET) { + failwith("siocgifconf: sa_familty != AF_INET\n"); + } + addr = + alloc_inet_addr((*(struct sockaddr_in *) &ifreqs[i].ifr_addr) + .sin_addr.s_addr); + sa = alloc(2, 1); + Field(sa, 0) = addr; + Field(sa, 1) = Val_int(0); + ifrp = alloc(2, 0); + Field(ifrp, 0) = copy_string(ifreqs[i].ifr_name); + Field(ifrp, 1) = sa; + t = h; + h = alloc_tuple(2); + Field(h, 0) = ifrp; + Field(h, 1) = t; + } + End_roots(); + return h; + } + + static value make_list_from_flags(short flags) + { + int i; + value res; + + Begin_root (res); + res = Val_int(0); + for (i = 0; i < (sizeof(if_flags)/sizeof(if_flags[0])); i++) { + if (flags&if_flags[i]) { + value newres = alloc(2, 0); + Field(newres, 0) = Val_int(i); + Field(newres, 1) = res; + res = newres; + } + } + End_roots(); + return res; + } + + value unix_siocgifflags(value sock, value ifreq) + { + int retcode; + struct ifreq interface; + value device; + mlsize_t len; + + if (Tag_val(ifreq) != 5) { + unix_error(EINVAL, "", Nothing); + } + + device = Field(ifreq, 0); + len = string_length(device); + if (len >= sizeof(interface.ifr_name)) { + unix_error(ENAMETOOLONG, "", device); + } + bcopy(String_val(device), interface.ifr_name, (int) len + 1); + interface.ifr_flags = 0; + enter_blocking_section(); + retcode = ioctl(Int_val(sock), SIOCGIFFLAGS, &interface); + leave_blocking_section(); + if (retcode == -1) { + uerror("siocgifflags", Nothing); + /*NOTREACHED*/ + } + else { + value res = alloc(2, Tag_val(ifreq)); + + Begin_root (res); + Field(res, 0) = copy_string(interface.ifr_name); + Field(res, 1) = make_list_from_flags(interface.ifr_flags); + End_roots(); + return res; + } + } + + value unix_siocsifflags(sock, ifreq) + value sock, ifreq; + { + int retcode; + struct ifreq interface; + value device; + mlsize_t len; + + if (Tag_val(ifreq) != 5) { + unix_error(EINVAL, "", Nothing); + } + + device = Field(ifreq, 0); + len = string_length(device); + if (len >= sizeof(interface.ifr_name)) { + unix_error(ENAMETOOLONG, "", device); + } + bcopy(String_val(device), interface.ifr_name, (int) len + 1); + interface.ifr_flags = convert_flag_list(Field(ifreq, 1), if_flags); + enter_blocking_section(); + retcode = ioctl(Int_val(sock), SIOCSIFFLAGS, &interface); + leave_blocking_section(); + if (retcode == -1) { + uerror("siocgifflags", Nothing); + } + return Val_int(retcode); + } + + value unix_siocgifhwaddr(sock, dev) + value sock, dev; + { + struct ifreq ifreq; + value hwaddr; + unsigned long hwaddr_lo; + unsigned long hwaddr_hi; + mlsize_t len; + int retcode; + + len = string_length(dev); + if (len >= sizeof(ifreq.ifr_name)) { + unix_error(ENAMETOOLONG, "", dev); + } + bcopy(String_val(dev), ifreq.ifr_name, (int) len + 1); + enter_blocking_section(); + retcode = ioctl(Int_val(sock), SIOCGIFHWADDR, &ifreq); + leave_blocking_section(); + if (retcode == -1) { + uerror("siocgifhwaddr", Nothing); + } + if ((ifreq.ifr_hwaddr.sa_family != ARPHRD_ETHER) + && (ifreq.ifr_hwaddr.sa_family != ARPHRD_IEEE802)) { + failwith("siocgifhwaddr: unknown hardware type"); + } + hwaddr_hi = ((ifreq.ifr_hwaddr.sa_data[0] & 0xff) << 16) + | ((ifreq.ifr_hwaddr.sa_data[1] & 0xff) << 8) + | (ifreq.ifr_hwaddr.sa_data[2] & 0xff); + hwaddr_lo = ((ifreq.ifr_hwaddr.sa_data[3] &0xff) << 16) + | ((ifreq.ifr_hwaddr.sa_data[4] &0xff) << 8) + | (ifreq.ifr_hwaddr.sa_data[5] & 0xff); + Begin_root (hwaddr); + hwaddr = alloc(2, 0); + Field(hwaddr, 0) = Val_int(hwaddr_hi); + Field(hwaddr, 1) = Val_int(hwaddr_lo); + End_roots(); + return hwaddr; + } + + #else + + value unix_siocgifconf() {invalid_argument("siocgifconf not implemented"); } + value unix_siocgifflags() {invalid_argument("siocgifflags not implemented"); } + value unix_siocsifflags() {invalid_argument("siocsifflags not implemented"); } + value unix_siocgifhwaddr() {invalid_argument("siocgifhwaddr not implemented");} + + #endif diff -rbBcN ocaml-3.01/otherlibs/unix/socket.c ocaml-salex-3.01/otherlibs/unix/socket.c *** ocaml-3.01/otherlibs/unix/socket.c Wed Nov 17 13:58:06 1999 --- ocaml-salex-3.01/otherlibs/unix/socket.c Mon Jun 18 09:36:42 2001 *************** *** 25,31 **** }; int socket_type_table[] = { ! SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET }; value unix_socket(value domain, value type, value proto) /* ML */ --- 25,36 ---- }; int socket_type_table[] = { ! SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET, ! #ifdef SOCK_PACKET ! SOCK_PACKET ! #else ! -1 ! #endif }; value unix_socket(value domain, value type, value proto) /* ML */ diff -rbBcN ocaml-3.01/otherlibs/unix/socketaddr.c ocaml-salex-3.01/otherlibs/unix/socketaddr.c *** ocaml-3.01/otherlibs/unix/socketaddr.c Thu Nov 23 08:45:02 2000 --- ocaml-salex-3.01/otherlibs/unix/socketaddr.c Mon Jun 18 09:33:14 2001 *************** *** 73,78 **** --- 73,102 ---- *adr_len = sizeof(struct sockaddr_in); break; } + case 2: /* ADDR_PKT */ + { + #ifdef linux + char *p; + int n; + value device; + mlsize_t len; + for (p = (char *) &adr->s_pkt, n = sizeof(adr->s_pkt); + n > 0; p++, n--) + *p = 0; + adr->s_pkt.spkt_family = Int_val(Field(mladr, 0)); + device = Field(mladr, 1); + len = string_length(device); + if (len >= sizeof(adr->s_pkt.spkt_device)) { + unix_error(ENAMETOOLONG, "", device); + } + bcopy(String_val(device), adr->s_pkt.spkt_device, (int) len + 1); + adr->s_pkt.spkt_protocol = Int_val(Field(mladr, 2)); + *adr_len = sizeof(struct sockaddr_pkt); + break; + #else + unix_error(EAFNOSUPPORT, "", Nothing); + #endif + } } } *************** *** 80,85 **** --- 104,128 ---- socklen_param_type adr_len) { value res; + #ifdef linux + /* Sigh. The sa_family chunk of a sockaddr_pkt is actually the + * device type (ie, the ARP hardware type) for the device. For + * Ethernet, this 1 which is the same as the value AF_UNIX. Since + * the size of each type of sockaddr is different, we go with the + * blind hope that if sock_addr_len == sizeof(struct sockaddr_pkt), + * then we must have a sockaddr_pkt, else, we have some other sort. */ + if (adr_len == sizeof(struct sockaddr_pkt)) { + value n = copy_string(adr->s_pkt.spkt_device); + Begin_root (n); + res = alloc(3, 2); + Field(res,0) = Val_int(adr->s_pkt.spkt_family); + Field(res,1) = n; + Field(res,2) = Val_int(adr->s_pkt.spkt_protocol); + End_roots(); + } + else + #endif + switch(adr->s_gen.sa_family) { #ifndef _WIN32 case AF_UNIX: diff -rbBcN ocaml-3.01/otherlibs/unix/socketaddr.h ocaml-salex-3.01/otherlibs/unix/socketaddr.h *** ocaml-3.01/otherlibs/unix/socketaddr.h Tue Mar 7 04:07:39 2000 --- ocaml-salex-3.01/otherlibs/unix/socketaddr.h Mon Jun 18 09:34:33 2001 *************** *** 18,28 **** --- 18,34 ---- #include #include #include + #ifdef linux + #include + #endif union sock_addr_union { struct sockaddr s_gen; struct sockaddr_un s_unix; struct sockaddr_in s_inet; + #ifdef linux + struct sockaddr_pkt s_pkt; + #endif }; extern union sock_addr_union sock_addr; diff -rbBcN ocaml-3.01/otherlibs/unix/unix.ml ocaml-salex-3.01/otherlibs/unix/unix.ml *** ocaml-3.01/otherlibs/unix/unix.ml Thu Dec 28 08:05:32 2000 --- ocaml-salex-3.01/otherlibs/unix/unix.ml Mon Jun 18 09:09:54 2001 *************** *** 361,370 **** --- 361,398 ---- | SOCK_DGRAM | SOCK_RAW | SOCK_SEQPACKET + | SOCK_PACKET type sockaddr = ADDR_UNIX of string | ADDR_INET of inet_addr * int + | ADDR_PKT of int * string * int + + type if_flag = + IFF_UP + | IFF_BROADCAST + | IFF_DEBUG + | IFF_LOOPBACK + | IFF_POINTOPOINT + | IFF_NOTRAILERS + | IFF_RUNNING + | IFF_NOARP + | IFF_PROMISC + | IFF_ALLMULTI + | IFF_MULTICAST + + type ifreq = + ADDR of string * sockaddr + | DSTADDR of string * sockaddr + | BROADADDR of string * sockaddr + | NETMASK of string * sockaddr + | HWADDR of string * sockaddr + | FLAGS of string * if_flag list + | METRIC of string * int + | MTU of string * int + (* MAP and SLAVE are not implemented *) + + type hwaddr = ETHER of int * int type shutdown_command = SHUTDOWN_RECEIVE *************** *** 427,432 **** --- 455,465 ---- then invalid_arg "Unix.sendto" else unsafe_sendto fd buf ofs len flags addr + external siocgifconf : file_descr -> ifreq list = "unix_siocgifconf" + external siocgifflags : file_descr -> ifreq -> ifreq = "unix_siocgifflags" + external siocsifflags : file_descr -> ifreq -> int = "unix_siocsifflags" + external siocgifhwaddr : file_descr -> string -> hwaddr = "unix_siocgifhwaddr" + external getsockopt : file_descr -> socket_option -> bool = "unix_getsockopt" external setsockopt : file_descr -> socket_option -> bool -> unit = "unix_setsockopt" *************** *** 675,681 **** let open_connection sockaddr = let domain = ! match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in let sock = socket domain SOCK_STREAM 0 in try --- 708,716 ---- let open_connection sockaddr = let domain = ! match sockaddr with ADDR_UNIX _ -> PF_UNIX ! | ADDR_INET(_,_) -> PF_INET ! | ADDR_PKT _ -> raise(Unix_error(EAFNOSUPPORT, "", "")) in let sock = socket domain SOCK_STREAM 0 in try *************** *** 689,695 **** let establish_server server_fun sockaddr = let domain = ! match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in let sock = socket domain SOCK_STREAM 0 in setsockopt sock SO_REUSEADDR true; --- 724,732 ---- let establish_server server_fun sockaddr = let domain = ! match sockaddr with ADDR_UNIX _ -> PF_UNIX ! | ADDR_INET(_,_) -> PF_INET ! | ADDR_PKT _ -> raise(Unix_error(EAFNOSUPPORT, "", "")) in let sock = socket domain SOCK_STREAM 0 in setsockopt sock SO_REUSEADDR true; diff -rbBcN ocaml-3.01/otherlibs/unix/unix.mli ocaml-salex-3.01/otherlibs/unix/unix.mli *** ocaml-3.01/otherlibs/unix/unix.mli Mon Feb 5 04:07:42 2001 --- ocaml-salex-3.01/otherlibs/unix/unix.mli Mon Jun 18 09:12:18 2001 *************** *** 698,703 **** --- 698,704 ---- | SOCK_DGRAM (* Datagram socket *) | SOCK_RAW (* Raw socket *) | SOCK_SEQPACKET (* Sequenced packets socket *) + | SOCK_PACKET (* Special socket *) (* The type of socket kinds, specifying the semantics of communications. *) *************** *** 705,710 **** --- 706,752 ---- type sockaddr = ADDR_UNIX of string | ADDR_INET of inet_addr * int + | ADDR_PKT of int * string * int + + type if_flag = + IFF_UP (* Interface is up *) + | IFF_BROADCAST (* broadcast address is valid *) + | IFF_DEBUG (* turn on debugging *) + | IFF_LOOPBACK (* this is a loopback interface *) + | IFF_POINTOPOINT (* this is a point-to-point link *) + | IFF_NOTRAILERS (* avoid use of trailers *) + | IFF_RUNNING (* resources allocated *) + | IFF_NOARP (* no ARP protocol *) + | IFF_PROMISC (* receive all packets *) + | IFF_ALLMULTI (* receive all multicast packets *) + | IFF_MULTICAST (* supports multicast *) + (* Socket flags set/returned by [siocsifflags]/[siocgifflags]. *) + + type ifreq = + ADDR of string * sockaddr + | DSTADDR of string * sockaddr + | BROADADDR of string * sockaddr + | NETMASK of string * sockaddr + | HWADDR of string * sockaddr + | FLAGS of string * if_flag list + | METRIC of string * int + | MTU of string * int + (* MAP and SLAVE are not implemented *) + (* The generalized datatype for socket ioctls *) + + type hwaddr = ETHER of int * int + + external siocgifconf : file_descr -> ifreq list = "unix_siocgifconf" + (* Returns a list of the interfaces on the current machine *) + + external siocgifflags : file_descr -> ifreq -> ifreq = "unix_siocgifflags" + (* Returns the values of the flags for a given interface *) + + external siocsifflags : file_descr -> ifreq -> int = "unix_siocsifflags" + (* Set the values of the flags for a given interface *) + + external siocgifhwaddr : file_descr -> string -> hwaddr = "unix_siocgifhwaddr" + (* Get the hardware address for a given interface *) (* The type of socket addresses. [ADDR_UNIX name] is a socket address in the Unix domain; [name] is a file name in the file