diff options
Diffstat (limited to 'otherlibs/threads/unix.ml')
| -rw-r--r-- | otherlibs/threads/unix.ml | 151 |
1 files changed, 144 insertions, 7 deletions
diff --git a/otherlibs/threads/unix.ml b/otherlibs/threads/unix.ml index 2f02d7c4e..beec810aa 100644 --- a/otherlibs/threads/unix.ml +++ b/otherlibs/threads/unix.ml @@ -484,7 +484,7 @@ external getgrnam : string -> group_entry = "unix_getgrnam" external getpwuid : int -> passwd_entry = "unix_getpwuid" external getgrgid : int -> group_entry = "unix_getgrgid" -type inet_addr +type inet_addr = string external inet_addr_of_string : string -> inet_addr = "unix_inet_addr_of_string" @@ -492,10 +492,18 @@ external string_of_inet_addr : inet_addr -> string = "unix_string_of_inet_addr" let inet_addr_any = inet_addr_of_string "0.0.0.0" +let inet_addr_loopback = inet_addr_of_string "127.0.0.1" +let inet6_addr_any = + try inet_addr_of_string "::" with Failure _ -> inet_addr_any +let inet6_addr_loopback = + try inet_addr_of_string "::1" with Failure _ -> inet_addr_loopback + +let is_inet6_addr s = String.length s = 16 type socket_domain = PF_UNIX | PF_INET + | PF_INET6 type socket_type = SOCK_STREAM @@ -507,6 +515,10 @@ type sockaddr = ADDR_UNIX of string | ADDR_INET of inet_addr * int +let domain_of_sockaddr = function + ADDR_UNIX _ -> PF_UNIX + | ADDR_INET(a, _) -> if is_inet6_addr a then PF_INET6 else PF_INET + type shutdown_command = SHUTDOWN_RECEIVE | SHUTDOWN_SEND @@ -675,6 +687,135 @@ external getservbyname : string -> string -> service_entry = "unix_getservbyname" external getservbyport : int -> string -> service_entry = "unix_getservbyport" +type addr_info = + { ai_family : socket_domain; + ai_socktype : socket_type; + ai_protocol : int; + ai_addr : sockaddr; + ai_canonname : string } + +type getaddrinfo_option = + AI_FAMILY of socket_domain + | AI_SOCKTYPE of socket_type + | AI_PROTOCOL of int + | AI_NUMERICHOST + | AI_CANONNAME + | AI_PASSIVE + +external getaddrinfo_system + : string -> string -> getaddrinfo_option list -> addr_info list + = "unix_getaddrinfo" + +let getaddrinfo_emulation node service opts = + (* Parse options *) + let opt_socktype = ref None + and opt_protocol = ref 0 + and opt_passive = ref false in + List.iter + (function AI_SOCKTYPE s -> opt_socktype := Some s + | AI_PROTOCOL p -> opt_protocol := p + | AI_PASSIVE -> opt_passive := true + | _ -> ()) + opts; + (* Determine socket types and port numbers *) + let get_port ty kind = + if service = "" then [ty, 0] else + try + [ty, int_of_string service] + with Failure _ -> + try + [ty, (getservbyname service kind).s_port] + with Not_found -> [] + in + let ports = + match !opt_socktype with + | None -> + get_port SOCK_STREAM "tcp" @ get_port SOCK_DGRAM "udp" + | Some SOCK_STREAM -> + get_port SOCK_STREAM "tcp" + | Some SOCK_DGRAM -> + get_port SOCK_DGRAM "udp" + | Some ty -> + if service = "" then [ty, 0] else [] in + (* Determine IP addresses *) + let addresses = + if node = "" then + if List.mem AI_PASSIVE opts + then [inet_addr_any, "0.0.0.0"] + else [inet_addr_loopback, "127.0.0.1"] + else + try + [inet_addr_of_string node, node] + with Failure _ -> + try + let he = gethostbyname node in + List.map + (fun a -> (a, he.h_name)) + (Array.to_list he.h_addr_list) + with Not_found -> + [] in + (* Cross-product of addresses and ports *) + List.flatten + (List.map + (fun (ty, port) -> + List.map + (fun (addr, name) -> + { ai_family = PF_INET; + ai_socktype = ty; + ai_protocol = !opt_protocol; + ai_addr = ADDR_INET(addr, port); + ai_canonname = name }) + addresses) + ports) + +let getaddrinfo node service opts = + try + List.rev(getaddrinfo_system node service opts) + with Invalid_argument _ -> + getaddrinfo_emulation node service opts + +type name_info = + { ni_hostname : string; + ni_service : string } + +type getnameinfo_option = + NI_NOFQDN + | NI_NUMERICHOST + | NI_NAMEREQD + | NI_NUMERICSERV + | NI_DGRAM + +external getnameinfo_system + : sockaddr -> getnameinfo_option list -> name_info + = "unix_getnameinfo" + +let getnameinfo_emulation addr opts = + match addr with + | ADDR_UNIX f -> + { ni_hostname = ""; ni_service = f } (* why not? *) + | ADDR_INET(a, p) -> + let hostname = + try + if List.mem NI_NUMERICHOST opts then raise Not_found; + (gethostbyaddr a).h_name + with Not_found -> + if List.mem NI_NAMEREQD opts then raise Not_found; + string_of_inet_addr a in + let service = + try + if List.mem NI_NUMERICSERV opts then raise Not_found; + let kind = if List.mem NI_DGRAM opts then "udp" else "tcp" in + (getservbyport p kind).s_name + with Not_found -> + string_of_int p in + { ni_hostname = hostname; ni_service = service } + +let getnameinfo addr opts = + try + getnameinfo_system addr opts + with Invalid_argument _ -> + getnameinfo_emulation addr opts + type terminal_io = { mutable c_ignbrk: bool; mutable c_brkint: bool; @@ -894,10 +1035,8 @@ let close_process_full (inchan, outchan, errchan) = (* High-level network functions *) 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 + socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in try connect sock sockaddr; (in_channel_of_descr sock, out_channel_of_descr sock) @@ -908,10 +1047,8 @@ let shutdown_connection inchan = shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND 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 + socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in setsockopt sock SO_REUSEADDR true; bind sock sockaddr; listen sock 5; |