diff options
| -rw-r--r-- | otherlibs/unix/unix.ml | 85 | ||||
| -rw-r--r-- | otherlibs/unix/unix.mli | 49 |
2 files changed, 98 insertions, 36 deletions
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml index b2d7d124b..1b61cdbba 100644 --- a/otherlibs/unix/unix.ml +++ b/otherlibs/unix/unix.ml @@ -133,6 +133,11 @@ let stdin = 0 let stdout = 1 let stderr = 2 +let max_opened_descr = ref 2 + +let record_descr fd = + if fd > !max_opened_descr then max_opened_descr := fd + type open_flag = O_RDONLY | O_WRONLY @@ -146,8 +151,14 @@ type open_flag = type file_perm = int -external openfile : string -> open_flag list -> file_perm -> file_descr +external sys_openfile : string -> open_flag list -> file_perm -> file_descr = "unix_open" + +let openfile name flags perm = + let fd = sys_openfile name flags perm in + record_descr fd; + fd + 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" @@ -218,7 +229,11 @@ external fchown : file_descr -> int -> int -> unit = "unix_fchown" external umask : int -> int = "unix_umask" external access : string -> access_permission list -> unit = "unix_access" -external dup : file_descr -> file_descr = "unix_dup" +external sys_dup : file_descr -> file_descr = "unix_dup" + +let dup fd = + let newfd = sys_dup fd in record_descr newfd; newfd + external dup2 : file_descr -> file_descr -> unit = "unix_dup2" external set_nonblock : file_descr -> unit = "unix_set_nonblock" external clear_nonblock : file_descr -> unit = "unix_clear_nonblock" @@ -236,7 +251,13 @@ external opendir : string -> dir_handle = "unix_opendir" external readdir : dir_handle -> string = "unix_readdir" external rewinddir : dir_handle -> unit = "unix_rewinddir" external closedir : dir_handle -> unit = "unix_closedir" -external pipe : unit -> file_descr * file_descr = "unix_pipe" + +external sys_pipe : unit -> file_descr * file_descr = "unix_pipe" + +let pipe () = + let (fd1, fd2 as fdpair) = sys_pipe() in + record_descr fd1; record_descr fd2; fdpair + external symlink : string -> string -> unit = "unix_symlink" external readlink : string -> string = "unix_readlink" external mkfifo : string -> file_perm -> unit = "unix_mkfifo" @@ -369,12 +390,25 @@ type socket_option = | SO_DONTROUTE | SO_OOBINLINE -external socket : socket_domain -> socket_type -> int -> file_descr +external sys_socket : socket_domain -> socket_type -> int -> file_descr = "unix_socket" -external socketpair : +let socket domain typ proto = + let fd = sys_socket domain typ proto in + record_descr fd; fd + +external sys_socketpair : socket_domain -> socket_type -> int -> file_descr * file_descr = "unix_socketpair" -external accept : file_descr -> file_descr * sockaddr = "unix_accept" +let socketpair domain typ proto = + let (fd1, fd2 as fdpair) = sys_socketpair domain typ proto in + record_descr fd1; record_descr fd2; fdpair + +external sys_accept : file_descr -> file_descr * sockaddr = "unix_accept" + +let accept fd = + let (newfd, addr as result) = sys_accept fd in + record_descr newfd; result + external bind : file_descr -> sockaddr -> unit = "unix_bind" external connect : file_descr -> sockaddr -> unit = "unix_connect" external listen : file_descr -> int -> unit = "unix_listen" @@ -503,11 +537,27 @@ external tcflow: file_descr -> flow_action -> unit = "unix_tcflow" (* High-level process management (system, popen) *) +let closeall () = + for i = 3 to !max_opened_descr do close i done + let system cmd = match fork() with - 0 -> execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; exit 127 + 0 -> closeall(); + execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; + exit 127 | id -> snd(waitpid [] id) +let create_process cmd args new_stdin new_stdout new_stderr = + match fork() with + 0 -> + if new_stdin <> stdin then dup2 new_stdin stdin; + if new_stdout <> stdout then dup2 new_stdout stdout; + if new_stderr <> stderr then dup2 new_stderr stderr; + closeall(); + execvp cmd args; + exit 127 + | id -> id + type popen_process = Process of in_channel * out_channel | Process_in of in_channel @@ -515,26 +565,22 @@ type popen_process = let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) -let open_proc cmd proc input output toclose = - match fork() with - 0 -> if input <> stdin then begin dup2 input stdin; close input end; - if output <> stdout then begin dup2 output stdout; close output end; - List.iter close toclose; - execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; - exit 127 - | id -> Hashtbl.add popen_processes proc id +let open_proc cmd proc input output = + let pid = + create_process "/bin/sh" [| "/bin/sh"; "-c"; cmd |] input output stderr in + Hashtbl.add popen_processes proc pid let open_process_in cmd = let (in_read, in_write) = pipe() in let inchan = in_channel_of_descr in_read in - open_proc cmd (Process_in inchan) stdin in_write [in_read]; + open_proc cmd (Process_in inchan) stdin in_write; close in_write; inchan let open_process_out cmd = let (out_read, out_write) = pipe() in let outchan = out_channel_of_descr out_write in - open_proc cmd (Process_out outchan) out_read stdout [out_write]; + open_proc cmd (Process_out outchan) out_read stdout; close out_read; outchan @@ -543,8 +589,9 @@ let open_process cmd = let (out_read, out_write) = pipe() in let inchan = in_channel_of_descr in_read in let outchan = out_channel_of_descr out_write in - open_proc cmd (Process(inchan, outchan)) - out_read in_write [in_read; out_write]; + open_proc cmd (Process(inchan, outchan)) out_read in_write; + close in_write; + close out_read; (inchan, outchan) let find_proc_id fun_name proc = diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 01875b497..c0fe064b6 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -201,8 +201,7 @@ type open_flag = type file_perm = int (* The type of file access rights. *) -external openfile : string -> open_flag list -> file_perm -> file_descr - = "unix_open" +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. *) @@ -327,8 +326,9 @@ external access : string -> access_permission list -> unit = "unix_access" (*** Operations on file descriptors *) -external dup : file_descr -> file_descr = "unix_dup" - (* Duplicate a descriptor. *) +val dup : file_descr -> file_descr + (* Return a new file descriptor referencing the same file as + the given descriptor. *) external dup2 : file_descr -> file_descr -> unit = "unix_dup2" (* [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already opened. *) @@ -378,11 +378,35 @@ external closedir : dir_handle -> unit = "unix_closedir" (*** Pipes and redirections *) -external pipe : unit -> file_descr * file_descr = "unix_pipe" +val pipe : unit -> file_descr * file_descr (* Create a pipe. The first component of the result is opened for reading, that's the exit to the pipe. The second component is opened for writing, that's the entrance to the pipe. *) +external mkfifo : string -> file_perm -> unit = "unix_mkfifo" + (* Create a named pipe with the given permissions. *) + + +(*** High-level process and redirection management *) + +val create_process : + string -> string array -> file_descr -> file_descr -> file_descr -> int + (* [create_process prog args new_stdin new_stdout new_stderr] + forks a new process that executes the program + in file [prog], with arguments [args]. The pid of the new + process is returned immediately; the new process executes + concurrently with the current process. + The standard input and outputs of the new process are connected + to the descriptors [new_stdin], [new_stdout] and [new_stderr]. + Passing e.g. [stdout] for [new_stdout] prevents the redirection + and causes the new process to have the same standard output + as the current process. + The executable file [prog] is searched in the path. + The new process has the same environment as the current process. + All file descriptors of the current process are closed in the + new process, except those redirected to standard input and + outputs. *) + val open_process_in: string -> in_channel val open_process_out: string -> out_channel val open_process: string -> in_channel * out_channel @@ -400,7 +424,6 @@ val close_process: in_channel * out_channel -> process_status and [open_process], respectively, wait for the associated command to terminate, and return its termination status. *) - (*** Symbolic links *) external symlink : string -> string -> unit = "unix_symlink" @@ -410,12 +433,6 @@ external readlink : string -> string = "unix_readlink" (* Read the contents of a link. *) -(*** Named pipes *) - -external mkfifo : string -> file_perm -> unit = "unix_mkfifo" - (* Create a named pipe with the given permissions. *) - - (*** Special files *) external ioctl_int : file_descr -> int -> int -> int = "unix_ioctl_int" @@ -651,16 +668,14 @@ type sockaddr = domain; [addr] is the Internet address of the machine, and [port] is the port number. *) -external socket : socket_domain -> socket_type -> int -> file_descr - = "unix_socket" +val socket : socket_domain -> socket_type -> int -> file_descr (* Create a new socket in the given domain, and with the given kind. The third argument is the protocol type; 0 selects the default protocol for that kind of sockets. *) -external socketpair : +val socketpair : socket_domain -> socket_type -> int -> file_descr * file_descr - = "unix_socketpair" (* Create a pair of unnamed sockets, connected together. *) -external accept : file_descr -> file_descr * sockaddr = "unix_accept" +val accept : file_descr -> file_descr * sockaddr (* Accept connections on the given socket. The returned descriptor is a socket connected to the client; the returned address is the address of the connecting client. *) |