(**************************************************************************) (* *) (* Copyright (c) 2014 - 2018. *) (* Dynamic Ledger Solutions, Inc. *) (* *) (* All rights reserved. No warranty, explicit or implicit, provided. *) (* *) (**************************************************************************) open Lwt.Infix let read_bytes ?(pos = 0) ?len fd buf = let len = match len with None -> Bytes.length buf - pos | Some l -> l in let rec inner pos len = if len = 0 then Lwt.return_unit else Lwt_unix.read fd buf pos len >>= function | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *) | nb_read -> inner (pos + nb_read) (len - nb_read) in inner pos len let read_mbytes ?(pos=0) ?len fd buf = let len = match len with None -> MBytes.length buf - pos | Some l -> l in let rec inner pos len = if len = 0 then Lwt.return_unit else Lwt_bytes.read fd buf pos len >>= function | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *) | nb_read -> inner (pos + nb_read) (len - nb_read) in inner pos len let write_mbytes ?(pos=0) ?len descr buf = let len = match len with None -> MBytes.length buf - pos | Some l -> l in let rec inner pos len = if len = 0 then Lwt.return_unit else Lwt_bytes.write descr buf pos len >>= function | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *) | nb_written -> inner (pos + nb_written) (len - nb_written) in inner pos len let write_bytes ?(pos=0) ?len descr buf = let len = match len with None -> Bytes.length buf - pos | Some l -> l in let rec inner pos len = if len = 0 then Lwt.return_unit else Lwt_unix.write descr buf pos len >>= function | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *) | nb_written -> inner (pos + nb_written) (len - nb_written) in inner pos len let (>>=) = Lwt.bind let remove_dir dir = let rec remove dir = let files = Lwt_unix.files_of_directory dir in Lwt_stream.iter_s (fun file -> if file = "." || file = ".." then Lwt.return () else begin let file = Filename.concat dir file in if Sys.is_directory file then remove file else Lwt_unix.unlink file end) files >>= fun () -> Lwt_unix.rmdir dir in if Sys.file_exists dir && Sys.is_directory dir then remove dir else Lwt.return () let rec create_dir ?(perm = 0o755) dir = Lwt_unix.file_exists dir >>= function | false -> create_dir (Filename.dirname dir) >>= fun () -> Lwt_unix.mkdir dir perm | true -> Lwt_unix.stat dir >>= function | { st_kind = S_DIR ; _ } -> Lwt.return_unit | _ -> Pervasives.failwith "Not a directory" let create_file ?(perm = 0o644) name content = Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd -> Lwt_unix.write_string fd content 0 (String.length content) >>= fun _ -> Lwt_unix.close fd let safe_close fd = Lwt.catch (fun () -> Lwt_unix.close fd) (fun _ -> Lwt.return_unit) let of_sockaddr = function | Unix.ADDR_UNIX _ -> None | Unix.ADDR_INET (addr, port) -> match Ipaddr_unix.of_inet_addr addr with | V4 addr -> Some (Ipaddr.v6_of_v4 addr, port) | V6 addr -> Some (addr, port) let getaddrinfo ~passive ~node ~service = let open Lwt_unix in getaddrinfo node service ( AI_SOCKTYPE SOCK_STREAM :: (if passive then [AI_PASSIVE] else []) ) >>= fun addr -> let points = TzList.filter_map (fun { ai_addr ; _ } -> of_sockaddr ai_addr) addr in Lwt.return points