balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Utils/Socket: use getaddrinfo instead of gethostbyname

Browse Source
This commit is contained in:
Vincent Bernardoff 2018-07-15 21:49:02 +02:00 committed by Benjamin Canou
parent b76b5367bb
commit fe21585462
2 changed files with 46 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
src/lib_stdlib_unix/lwt_utils_unix.ml
View File

@ -280,56 +280,62 @@ module Socket = struct
type addr = type addr =
| Unix of string | Unix of string
| Tcp of string * int | Tcp of string * string * Unix.getaddrinfo_option list
let get_addrs host = let handle_litteral_ipv6 host =
try return (Array.to_list (Unix.gethostbyname host).h_addr_list) (* To strip '[' and ']' when a litteral IPv6 is provided *)
with Not_found -> failwith "Host %s not found" host match Ipaddr.of_string host with
| None -> host
| Some ipaddr -> Ipaddr.to_string ipaddr
let connect path = let connect = function
match path with
| Unix path -> | Unix path ->
let addr = Lwt_unix.ADDR_UNIX path in let addr = Lwt_unix.ADDR_UNIX path in
let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
Lwt_unix.connect sock addr >>= fun () -> Lwt_unix.connect sock addr >>= fun () ->
return sock return sock
| Tcp (host, port) -> | Tcp (host, service, opts) ->
get_addrs host >>=? fun addrs -> let host = handle_litteral_ipv6 host in
let rec try_connect = function Lwt_unix.getaddrinfo host service opts >>= function
| [] -> failwith "could not resolve host '%s'" host | [] ->
| addr :: addrs -> failwith "could not resolve host '%s'" host
Lwt.catch | addrs ->
(fun () -> let rec try_connect = function
let addr = Lwt_unix.ADDR_INET (addr, port) in | [] ->
let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in failwith "could not connect to '%s'" host
Lwt_unix.connect sock addr >>= fun () -> | { Unix.ai_family; ai_socktype; ai_protocol; ai_addr } :: addrs ->
return sock) let sock = Lwt_unix.socket ai_family ai_socktype ai_protocol in
(fun _ -> try_connect addrs) in Lwt.catch
try_connect addrs (fun () ->
Lwt_unix.connect sock ai_addr >>= fun () ->
return sock)
(fun exn ->
Format.printf "@{<error>@{<title>Unable to connect to %s@}@}@.\
\ @[<h 0>%a@]@."
host Format.pp_print_text (Printexc.to_string exn) ;
Lwt_unix.close sock >>= fun () ->
try_connect addrs) in
try_connect addrs
let bind ?(backlog = 10) path = let bind ?(backlog = 10) = function
match path with
| Unix path -> | Unix path ->
let addr = Lwt_unix.ADDR_UNIX path in let addr = Lwt_unix.ADDR_UNIX path in
let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
Lwt_unix.bind sock addr >>= fun () -> Lwt_unix.bind sock addr >>= fun () ->
Lwt_unix.listen sock backlog ; Lwt_unix.listen sock backlog ;
return sock return [sock]
| Tcp (host, port) -> | Tcp (host, service, opts) ->
get_addrs host >>=? fun addrs -> Lwt_unix.getaddrinfo
let rec try_bind = function (handle_litteral_ipv6 host) service (AI_PASSIVE :: opts) >>= function
| [] -> failwith "could not resolve host '%s'" host | [] -> failwith "could not resolve host '%s'" host
| addr :: addrs -> | addrs ->
Lwt.catch let do_bind { Unix.ai_family; ai_socktype; ai_protocol; ai_addr } =
(fun () -> let sock = Lwt_unix.socket ai_family ai_socktype ai_protocol in
let addr = Lwt_unix.ADDR_INET (addr, port) in Lwt_unix.setsockopt sock SO_REUSEADDR true ;
let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in Lwt_unix.bind sock ai_addr >>= fun () ->
Lwt_unix.setsockopt sock SO_REUSEADDR true ; Lwt_unix.listen sock backlog ;
Lwt_unix.bind sock addr >>= fun () -> return sock in
Lwt_unix.listen sock backlog ; map_s do_bind addrs
return sock)
(fun _ -> try_bind addrs) in
try_bind addrs
type error += type error +=
| Encoding_error | Encoding_error

5
src/lib_stdlib_unix/lwt_utils_unix.mli
View File

@ -76,10 +76,11 @@ module Socket : sig
type addr = type addr =
| Unix of string | Unix of string
| Tcp of string * int | Tcp of string * string * Unix.getaddrinfo_option list
val connect: addr -> Lwt_unix.file_descr tzresult Lwt.t val connect: addr -> Lwt_unix.file_descr tzresult Lwt.t
val bind: ?backlog:int -> addr -> Lwt_unix.file_descr tzresult Lwt.t val bind:
?backlog:int -> addr -> Lwt_unix.file_descr list tzresult Lwt.t
type error += type error +=
| Encoding_error | Encoding_error