summaryrefslogtreecommitdiff
path: root/otherlibs/unix
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/unix')
-rw-r--r--otherlibs/unix/open.c38
-rw-r--r--otherlibs/unix/unix.ml10
-rw-r--r--otherlibs/unix/unix.mli13
-rw-r--r--otherlibs/unix/unixLabels.mli5
-rw-r--r--otherlibs/unix/unixsupport.c12
-rw-r--r--otherlibs/unix/unixsupport.h1
6 files changed, 63 insertions, 16 deletions
diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c
index 097a0455ba..ecee013898 100644
--- a/otherlibs/unix/open.c
+++ b/otherlibs/unix/open.c
@@ -17,6 +17,9 @@
#include <signals.h>
#include "unixsupport.h"
#include <string.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
#include <fcntl.h>
#ifndef O_NONBLOCK
@@ -31,16 +34,31 @@
#ifndef O_RSYNC
#define O_RSYNC 0
#endif
+#ifndef O_CLOEXEC
+#define NEED_CLOEXEC_EMULATION
+#define O_CLOEXEC 0
+#endif
-static int open_flag_table[] = {
+static int open_flag_table[14] = {
O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL,
- O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC, 0
+ O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC,
+ 0, /* O_SHARE_DELETE, Windows-only */
+ O_CLOEXEC
+};
+
+#ifdef NEED_CLOEXEC_EMULATION
+static int open_cloexec_table[14] = {
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ 0,
+ 1
};
+#endif
CAMLprim value unix_open(value path, value flags, value perm)
{
CAMLparam3(path, flags, perm);
- int ret, cv_flags;
+ int fd, cv_flags;
char * p;
cv_flags = convert_flag_list(flags, open_flag_table);
@@ -48,9 +66,17 @@ CAMLprim value unix_open(value path, value flags, value perm)
strcpy(p, String_val(path));
/* open on a named FIFO can block (PR#1533) */
enter_blocking_section();
- ret = open(p, cv_flags, Int_val(perm));
+ fd = open(p, cv_flags, Int_val(perm));
leave_blocking_section();
stat_free(p);
- if (ret == -1) uerror("open", path);
- CAMLreturn (Val_int(ret));
+ if (fd == -1) uerror("open", path);
+#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)
+ if (convert_flag_list(flags, open_cloexec_table) != 0) {
+ int flags = fcntl(fd, F_GETFD, 0);
+ if (flags == -1 ||
+ fcntl(fd, F_SETFD, flags | FD_CLOEXEC) == -1)
+ uerror("open", path);
+ }
+#endif
+ CAMLreturn (Val_int(fd));
}
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 8a69ca7b44..8bd935f4cb 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -202,7 +202,8 @@ external execvp : string -> string array -> 'a = "unix_execvp"
external execvpe : string -> string array -> string array -> 'a = "unix_execvpe"
external fork : unit -> int = "unix_fork"
external wait : unit -> int * process_status = "unix_wait"
-external waitpid : wait_flag list -> int -> int * process_status = "unix_waitpid"
+external waitpid : wait_flag list -> int -> int * process_status
+ = "unix_waitpid"
external getpid : unit -> int = "unix_getpid"
external getppid : unit -> int = "unix_getppid"
external nice : int -> int = "unix_nice"
@@ -227,6 +228,7 @@ type open_flag =
| O_SYNC
| O_RSYNC
| O_SHARE_DELETE
+ | O_CLOEXEC
type file_perm = int
@@ -237,7 +239,8 @@ external openfile : string -> open_flag list -> file_perm -> file_descr
external close : file_descr -> unit = "unix_close"
external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read"
external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write"
-external unsafe_single_write : file_descr -> string -> int -> int -> int = "unix_single_write"
+external unsafe_single_write : file_descr -> string -> int -> int -> int
+ = "unix_single_write"
let read fd buf ofs len =
if ofs < 0 || len < 0 || ofs > String.length buf - len
@@ -306,7 +309,8 @@ external link : string -> string -> unit = "unix_link"
module LargeFile =
struct
- external lseek : file_descr -> int64 -> seek_command -> int64 = "unix_lseek_64"
+ external lseek : file_descr -> int64 -> seek_command -> int64
+ = "unix_lseek_64"
external truncate : string -> int64 -> unit = "unix_truncate_64"
external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64"
type stats =
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index a9b5510419..a483e42520 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -242,6 +242,9 @@ type open_flag =
O_SYNC/O_DSYNC) *)
| O_SHARE_DELETE (** Windows only: allow the file to be deleted
while still open *)
+ | O_CLOEXEC (** Set the close-on-exec flag on the
+ descriptor returned by {!openfile} *)
+
(** The flags to {!Unix.openfile}. *)
@@ -250,9 +253,9 @@ type file_perm = int
read for group, none for others *)
val openfile : string -> open_flag list -> file_perm -> file_descr
-(** Open the named file with the given flags. Third argument is
- the permissions to give to the file if it is created. Return
- a file descriptor on the named file. *)
+(** Open the named file with the given flags. Third argument is the
+ permissions to give to the file if it is created (see
+ {!umask}). Return a file descriptor on the named file. *)
val close : file_descr -> unit
(** Close a file descriptor. *)
@@ -480,7 +483,7 @@ val clear_close_on_exec : file_descr -> unit
val mkdir : string -> file_perm -> unit
-(** Create a directory with the given permissions. *)
+(** Create a directory with the given permissions (see {!umask}). *)
val rmdir : string -> unit
(** Remove an empty directory. *)
@@ -521,7 +524,7 @@ val pipe : unit -> file_descr * file_descr
opened for writing, that's the entrance to the pipe. *)
val mkfifo : string -> file_perm -> unit
-(** Create a named pipe with the given permissions. *)
+(** Create a named pipe with the given permissions (see {!umask}). *)
(** {6 High-level process and redirection management} *)
diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli
index 91636c6a8b..4dc411b0b5 100644
--- a/otherlibs/unix/unixLabels.mli
+++ b/otherlibs/unix/unixLabels.mli
@@ -183,7 +183,8 @@ val wait : unit -> int * process_status
and termination status. *)
val waitpid : mode:wait_flag list -> int -> int * process_status
-(** Same as {!UnixLabels.wait}, but waits for the child process whose pid is given.
+(** Same as {!UnixLabels.wait}, but waits for the child process whose pid
+ is given.
A pid of [-1] means wait for any child.
A pid of [0] means wait for any child in the same process group
as the current process.
@@ -239,6 +240,8 @@ type open_flag = Unix.open_flag =
| O_SYNC (** Writes complete as `Synchronised I/O file integrity completion' *)
| O_RSYNC (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *)
| O_SHARE_DELETE (** Windows only: allow the file to be deleted while still open *)
+ | O_CLOEXEC (** Set the close-on-exec flag on the
+ descriptor returned by {!openfile} *)
(** The flags to {!UnixLabels.openfile}. *)
diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c
index 15365f802e..f1df3fc72c 100644
--- a/otherlibs/unix/unixsupport.c
+++ b/otherlibs/unix/unixsupport.c
@@ -270,6 +270,15 @@ value unix_error_of_code (int errcode)
return err;
}
+extern int code_of_unix_error (value error)
+{
+ if (Is_block(error)) {
+ return Int_val(Field(error, 0));
+ } else {
+ return error_table[Int_val(error)];
+ }
+}
+
void unix_error(int errcode, char *cmdname, value cmdarg)
{
value res;
@@ -282,7 +291,8 @@ void unix_error(int errcode, char *cmdname, value cmdarg)
if (unix_error_exn == NULL) {
unix_error_exn = caml_named_value("Unix.Unix_error");
if (unix_error_exn == NULL)
- invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
+ invalid_argument("Exception Unix.Unix_error not initialized,"
+ " please link unix.cma");
}
res = alloc_small(4, 0);
Field(res, 0) = *unix_error_exn;
diff --git a/otherlibs/unix/unixsupport.h b/otherlibs/unix/unixsupport.h
index 4706355eb0..a8065d973a 100644
--- a/otherlibs/unix/unixsupport.h
+++ b/otherlibs/unix/unixsupport.h
@@ -18,6 +18,7 @@
#define Nothing ((value) 0)
extern value unix_error_of_code (int errcode);
+extern int code_of_unix_error (value error);
extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
extern void uerror (char * cmdname, value arg) Noreturn;
View Lorry Controller Status