Skip to content

Add ?cloexec:bool argument to wrapped Unix functions in Lwt_unix #901

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
smorimoto merged 1 commit into from
Nov 19, 2021
Merged

Add ?cloexec:bool argument to wrapped Unix functions in Lwt_unix #901

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGES
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,8 @@

* Support IPv6 (always) and PF_UNIX (with OCaml >= 4.14) socketpair on Windows (#870, #876, Antonin Décimo, David Allsopp).

* In the Lwt_unix module, add `?cloexec:bool` optional arguments to functions that create file descriptors (`dup`, `dup2`, `pipe`, `pipe_in`, `pipe_out`, `socket`, `socketpair`, `accept`, `accept_n`). The `?cloexec` argument is simply forwarded to the wrapped Unix function (with OCaml >= 4.05, see PR ocaml/ocaml#650), or emulated as best-effort with `Unix.set_close_on_exec` on older OCaml versions (#327, #847, #872, #901, Antonin Décimo).

====== Misc ======

* Code quality improvement: remove an uneeded Obj.magic (#844, Benoit Montagu).
Expand Down
110 changes: 84 additions & 26 deletions src/unix/lwt_unix.cppo.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1233,9 +1233,14 @@ let access name mode =
| Operations on file descriptors |
+-----------------------------------------------------------------+ *)

let dup ch =
let dup ?cloexec ch =
check_descriptor ch;
#if OCAML_VERSION >= (4, 05, 0)
let fd = Unix.dup ?cloexec ch.fd in
#else
let fd = Unix.dup ch.fd in
if cloexec = Some true then Unix.set_close_on_exec fd;
#endif
{
fd = fd;
state = Opened;
Expand All @@ -1252,9 +1257,14 @@ let dup ch =
hooks_writable = Lwt_sequence.create ();
}

let dup2 ch1 ch2 =
let dup2 ?cloexec ch1 ch2 =
check_descriptor ch1;
#if OCAML_VERSION >= (4, 05, 0)
Unix.dup2 ?cloexec ch1.fd ch2.fd;
#else
Unix.dup2 ch1.fd ch2.fd;
if cloexec = Some true then Unix.set_close_on_exec ch2.fd;
#endif
ch2.set_flags <- ch1.set_flags;
ch2.blocking <- (
if ch2.set_flags then
Expand Down Expand Up @@ -1439,16 +1449,40 @@ let files_of_directory path =
| Pipes and redirections |
+-----------------------------------------------------------------+ *)

let pipe () =
let (out_fd, in_fd) = Unix.pipe() in
let pipe ?cloexec () =
#if OCAML_VERSION >= (4, 05, 0)
let (out_fd, in_fd) = Unix.pipe ?cloexec () in
#else
let (out_fd, in_fd) = Unix.pipe () in
if cloexec = Some true then begin
Unix.set_close_on_exec out_fd;
Unix.set_close_on_exec in_fd
end;
#endif
(mk_ch ~blocking:Sys.win32 out_fd, mk_ch ~blocking:Sys.win32 in_fd)

let pipe_in () =
let (out_fd, in_fd) = Unix.pipe() in
let pipe_in ?cloexec () =
#if OCAML_VERSION >= (4, 05, 0)
let (out_fd, in_fd) = Unix.pipe ?cloexec () in
#else
let (out_fd, in_fd) = Unix.pipe () in
if cloexec = Some true then begin
Unix.set_close_on_exec out_fd;
Unix.set_close_on_exec in_fd
end;
#endif
(mk_ch ~blocking:Sys.win32 out_fd, in_fd)

let pipe_out () =
let (out_fd, in_fd) = Unix.pipe() in
let pipe_out ?cloexec () =
#if OCAML_VERSION >= (4, 05, 0)
let (out_fd, in_fd) = Unix.pipe ?cloexec () in
#else
let (out_fd, in_fd) = Unix.pipe () in
if cloexec = Some true then begin
Unix.set_close_on_exec out_fd;
Unix.set_close_on_exec in_fd
end;
#endif
(out_fd, mk_ch ~blocking:Sys.win32 in_fd)

external mkfifo_job : string -> int -> unit job = "lwt_unix_mkfifo_job"
Expand Down Expand Up @@ -1664,8 +1698,13 @@ type socket_type =

type sockaddr = Unix.sockaddr = ADDR_UNIX of string | ADDR_INET of inet_addr * int

let socket dom typ proto =
let socket ?cloexec dom typ proto =
#if OCAML_VERSION >= (4, 05, 0)
let s = Unix.socket ?cloexec dom typ proto in
#else
let s = Unix.socket dom typ proto in
if cloexec = Some true then Unix.set_close_on_exec s;
#endif
mk_ch ~blocking:false s

type shutdown_command =
Expand All @@ -1680,37 +1719,56 @@ let shutdown ch shutdown_command =

external stub_socketpair : socket_domain -> socket_type -> int -> Unix.file_descr * Unix.file_descr = "lwt_unix_socketpair_stub"

let socketpair dom typ proto =
#if OCAML_VERSION >= (4, 05, 0)
let stub_socketpair ?cloexec dom typ proto =
let (s1, s2) = stub_socketpair dom typ proto in
if cloexec = Some true then begin
Unix.set_close_on_exec s1;
Unix.set_close_on_exec s2
end;
(s1, s2)
#endif

let socketpair ?cloexec dom typ proto =
let (s1, s2) =
#if OCAML_VERSION >= (4, 14, 0)
let do_socketpair =
if Sys.win32 && (dom <> Unix.PF_UNIX) then stub_socketpair
else Unix.socketpair ?cloexec:None in
if Sys.win32 && (dom <> Unix.PF_UNIX) then
stub_socketpair ?cloexec dom typ proto
else Unix.socketpair ?cloexec dom typ proto in
#elif OCAML_VERSION >= (4, 05, 0)
let do_socketpair =
if Sys.win32 then stub_socketpair
else Unix.socketpair ?cloexec:None in
if Sys.win32 then stub_socketpair ?cloexec dom typ proto
else Unix.socketpair ?cloexec dom typ proto in
#else
let do_socketpair = if Sys.win32 then stub_socketpair else Unix.socketpair in
if Sys.win32 then stub_socketpair dom typ proto
else Unix.socketpair dom typ proto in
if cloexec = Some true then begin
Unix.set_close_on_exec s1;
Unix.set_close_on_exec s2
end;
#endif
let (s1, s2) = do_socketpair dom typ proto in
(mk_ch ~blocking:false s1, mk_ch ~blocking:false s2)

external accept4 :
close_on_exec:bool -> nonblock:bool -> Unix.file_descr ->
Unix.file_descr * Unix.sockaddr = "lwt_unix_accept4"
?cloexec:bool -> nonblock:bool ->
Unix.file_descr -> Unix.file_descr * Unix.sockaddr = "lwt_unix_accept4"

let accept_and_set_nonblock ch_fd =
let accept_and_set_nonblock ?cloexec ch_fd =
if Lwt_config._HAVE_ACCEPT4 then
let (fd, addr) = accept4 ~close_on_exec:false ~nonblock:true ch_fd in
let (fd, addr) = accept4 ?cloexec ~nonblock:true ch_fd in
(mk_ch ~blocking:false ~set_flags:false fd, addr)
else
#if OCAML_VERSION >= (4, 05, 0)
let (fd, addr) = Unix.accept ?cloexec ch_fd in
#else
let (fd, addr) = Unix.accept ch_fd in
if cloexec = Some true then Unix.set_close_on_exec fd;
#endif
(mk_ch ~blocking:false fd, addr)

let accept ch =
wrap_syscall Read ch (fun _ -> accept_and_set_nonblock ch.fd)
let accept ?cloexec ch =
wrap_syscall Read ch (fun _ -> accept_and_set_nonblock ?cloexec ch.fd)

let accept_n ch n =
let accept_n ?cloexec ch n =
let l = ref [] in
Lazy.force ch.blocking >>= fun blocking ->
Lwt.catch
Expand All @@ -1720,7 +1778,7 @@ let accept_n ch n =
try
for _i = 1 to n do
if blocking && not (unix_readable ch.fd) then raise Retry;
l := accept_and_set_nonblock ch.fd :: !l
l := accept_and_set_nonblock ?cloexec ch.fd :: !l
done
with
| (Unix.Unix_error((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) | Retry) when !l <> [] ->
Expand Down
27 changes: 18 additions & 9 deletions src/unix/lwt_unix.cppo.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -681,10 +681,12 @@ val access : string -> access_permission list -> unit Lwt.t

(** {2 Operations on file descriptors} *)

val dup : file_descr -> file_descr
val dup : ?cloexec:bool ->
file_descr -> file_descr
(** Wrapper for [Unix.dup] *)

val dup2 : file_descr -> file_descr -> unit
val dup2 : ?cloexec:bool ->
file_descr -> file_descr -> unit
(** Wrapper for [Unix.dup2] *)

val set_close_on_exec : file_descr -> unit
Expand Down Expand Up @@ -751,17 +753,20 @@ val files_of_directory : string -> string Lwt_stream.t

(** {2 Pipes and redirections} *)

val pipe : unit -> file_descr * file_descr
val pipe : ?cloexec:bool ->
unit -> file_descr * file_descr
(** [pipe ()] creates pipe using [Unix.pipe] and returns two lwt {b
file descriptor}s created from unix {b file_descriptor} *)

val pipe_in : unit -> file_descr * Unix.file_descr
val pipe_in : ?cloexec:bool ->
unit -> file_descr * Unix.file_descr
(** [pipe_in ()] is the same as {!pipe} but maps only the unix {b
file descriptor} for reading into a lwt one. The second is not
put into non-blocking mode. You usually want to use this before
forking to receive data from the child process. *)

val pipe_out : unit -> Unix.file_descr * file_descr
val pipe_out : ?cloexec:bool ->
unit -> Unix.file_descr * file_descr
(** [pipe_out ()] is the inverse of {!pipe_in}. You usually want to
use this before forking to send data to the child process *)

Expand Down Expand Up @@ -874,11 +879,13 @@ type socket_type =

type sockaddr = Unix.sockaddr = ADDR_UNIX of string | ADDR_INET of inet_addr * int

val socket : socket_domain -> socket_type -> int -> file_descr
val socket : ?cloexec:bool ->
socket_domain -> socket_type -> int -> file_descr
(** [socket domain type proto] is the same as [Unix.socket] but maps
the result into a lwt {b file descriptor} *)

val socketpair : socket_domain -> socket_type -> int -> file_descr * file_descr
val socketpair : ?cloexec:bool ->
socket_domain -> socket_type -> int -> file_descr * file_descr
(** Wrapper for [Unix.socketpair] *)

val bind : file_descr -> sockaddr -> unit Lwt.t
Expand All @@ -892,10 +899,12 @@ val bind : file_descr -> sockaddr -> unit Lwt.t
val listen : file_descr -> int -> unit
(** Wrapper for [Unix.listen] *)

val accept : file_descr -> (file_descr * sockaddr) Lwt.t
val accept : ?cloexec:bool ->
file_descr -> (file_descr * sockaddr) Lwt.t
(** Wrapper for [Unix.accept] *)

val accept_n : file_descr -> int -> ((file_descr * sockaddr) list * exn option) Lwt.t
val accept_n : ?cloexec:bool ->
file_descr -> int -> ((file_descr * sockaddr) list * exn option) Lwt.t
(** [accept_n fd count] accepts up to [count] connections at one time.

- if no connection is available right now, it returns a sleeping
Expand Down
4 changes: 2 additions & 2 deletions src/unix/unix_c/unix_accept4.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,8 @@ CAMLprim value lwt_unix_accept4(value vcloexec, value vnonblock, value vsock)

union sock_addr_union addr;
socklen_param_type addr_len;
int cloexec = Int_val(vcloexec) ? SOCK_CLOEXEC : 0;
int nonblock = Int_val(vnonblock) ? SOCK_NONBLOCK : 0;
int cloexec = Is_block(vcloexec) && Bool_val(Field(vcloexec, 0)) ? SOCK_CLOEXEC : 0;
int nonblock = Bool_val(vnonblock) ? SOCK_NONBLOCK : 0;
addr_len = sizeof(addr);

int fd =
Expand Down