mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
wip: CCIO_unix with subprocess handling
This commit is contained in:
parent
cb311bf764
commit
2641c8b24b
4 changed files with 159 additions and 1 deletions
12
_oasis
12
_oasis
|
|
@ -33,6 +33,10 @@ Flag "lwt"
|
||||||
Description: Build modules which depend on Lwt
|
Description: Build modules which depend on Lwt
|
||||||
Default: false
|
Default: false
|
||||||
|
|
||||||
|
Flag "unix"
|
||||||
|
Description: Build modules that depend on Unix
|
||||||
|
Default: true
|
||||||
|
|
||||||
Flag "thread"
|
Flag "thread"
|
||||||
Description: Build modules that depend on threads
|
Description: Build modules that depend on threads
|
||||||
Default: false
|
Default: false
|
||||||
|
|
@ -66,6 +70,14 @@ Library "containers_advanced"
|
||||||
FindlibParent: containers
|
FindlibParent: containers
|
||||||
BuildDepends: containers
|
BuildDepends: containers
|
||||||
|
|
||||||
|
Library "containers_unix"
|
||||||
|
Path: unix
|
||||||
|
Pack: false
|
||||||
|
Modules: CCIO_unix
|
||||||
|
FindlibName: unix
|
||||||
|
FindlibParent: containers
|
||||||
|
BuildDepends: containers, unix
|
||||||
|
|
||||||
Library "containers_pervasives"
|
Library "containers_pervasives"
|
||||||
Path: pervasives
|
Path: pervasives
|
||||||
Modules: CCPervasives
|
Modules: CCPervasives
|
||||||
|
|
|
||||||
5
opam
5
opam
|
|
@ -23,7 +23,10 @@ depends: [
|
||||||
"base-bytes"
|
"base-bytes"
|
||||||
"cppo" {build}
|
"cppo" {build}
|
||||||
]
|
]
|
||||||
depopts: [ "lwt" ]
|
depopts: [
|
||||||
|
"lwt"
|
||||||
|
"base-unix"
|
||||||
|
]
|
||||||
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
|
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
|
||||||
homepage: "https://github.com/c-cube/ocaml-containers/"
|
homepage: "https://github.com/c-cube/ocaml-containers/"
|
||||||
doc: "http://cedeela.fr/~simon/software/containers/"
|
doc: "http://cedeela.fr/~simon/software/containers/"
|
||||||
|
|
|
||||||
66
unix/CCIO_unix.ml
Normal file
66
unix/CCIO_unix.ml
Normal file
|
|
@ -0,0 +1,66 @@
|
||||||
|
|
||||||
|
(*
|
||||||
|
copyright (c) 2013-2014, simon cruanes
|
||||||
|
all rights reserved.
|
||||||
|
|
||||||
|
redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
redistributions of source code must retain the above copyright notice, this
|
||||||
|
list of conditions and the following disclaimer. redistributions in binary
|
||||||
|
form must reproduce the above copyright notice, this list of conditions and the
|
||||||
|
following disclaimer in the documentation and/or other materials provided with
|
||||||
|
the distribution.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||||
|
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||||
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||||
|
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||||
|
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||||
|
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||||
|
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||||
|
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||||
|
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** {1 Extending CCIO with unix bindings} *)
|
||||||
|
|
||||||
|
module Proc = struct
|
||||||
|
type t = {
|
||||||
|
pid : int;
|
||||||
|
mutable status : Unix.process_status option;
|
||||||
|
stdin : out_channel;
|
||||||
|
stdout : in_channel;
|
||||||
|
stderr : in_channel;
|
||||||
|
}
|
||||||
|
|
||||||
|
let pid t = t.pid
|
||||||
|
|
||||||
|
let kill ?(signal=15) t =
|
||||||
|
Unix.kill t.pid signal
|
||||||
|
|
||||||
|
let wait t =
|
||||||
|
match t.status with
|
||||||
|
| Some s -> s
|
||||||
|
| None ->
|
||||||
|
let _, status = Unix.waitpid [] t.pid in
|
||||||
|
t.status <- Some status;
|
||||||
|
status
|
||||||
|
|
||||||
|
let stdin t = t.stdin
|
||||||
|
let stderr t = t.stderr
|
||||||
|
let stdout t = t.stdout
|
||||||
|
|
||||||
|
(** {6 Running a sub-process} *)
|
||||||
|
|
||||||
|
type cmd = string * string array
|
||||||
|
type redirect = [ `Redirect of Unix.file_descr | `Pipe ]
|
||||||
|
|
||||||
|
let sh cmd = "sh", [| "sh"; "-c"; cmd |]
|
||||||
|
|
||||||
|
let with_proc ?(stdin=`Pipe) ?(stdout=`Pipe) ?(stderr=`Pipe) ?env
|
||||||
|
(prog, args) f =
|
||||||
|
let stdin = match
|
||||||
|
|
||||||
|
end
|
||||||
77
unix/CCIO_unix.mli
Normal file
77
unix/CCIO_unix.mli
Normal file
|
|
@ -0,0 +1,77 @@
|
||||||
|
|
||||||
|
(*
|
||||||
|
copyright (c) 2013-2014, simon cruanes
|
||||||
|
all rights reserved.
|
||||||
|
|
||||||
|
redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
redistributions of source code must retain the above copyright notice, this
|
||||||
|
list of conditions and the following disclaimer. redistributions in binary
|
||||||
|
form must reproduce the above copyright notice, this list of conditions and the
|
||||||
|
following disclaimer in the documentation and/or other materials provided with
|
||||||
|
the distribution.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||||
|
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||||
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||||
|
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||||
|
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||||
|
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||||
|
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||||
|
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||||
|
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** {1 Extending CCIO with unix bindings}
|
||||||
|
|
||||||
|
A few utils to make {!Unix} more convenient to use.
|
||||||
|
|
||||||
|
@since NEXT_RELEASE *)
|
||||||
|
|
||||||
|
(** {2 Sub-process} *)
|
||||||
|
module Proc : sig
|
||||||
|
type t
|
||||||
|
(** A sub-process *)
|
||||||
|
|
||||||
|
val pid : t -> int
|
||||||
|
(** PID of the process *)
|
||||||
|
|
||||||
|
val kill : ?signal:int -> t -> unit
|
||||||
|
(** Kill the process with signal (default [15]) *)
|
||||||
|
|
||||||
|
val wait : t -> Unix.process_status
|
||||||
|
(** Wait for the process to stop, and return its status *)
|
||||||
|
|
||||||
|
val stdin : t -> out_channel
|
||||||
|
(** Input stream of the process *)
|
||||||
|
|
||||||
|
val stderr : t -> in_channel
|
||||||
|
(** Error stream of the process *)
|
||||||
|
|
||||||
|
val stdout : t -> in_channel
|
||||||
|
(** Output of the process *)
|
||||||
|
|
||||||
|
(** {6 Running a sub-process} *)
|
||||||
|
|
||||||
|
type cmd = string * string array
|
||||||
|
(** A command used to start a process *)
|
||||||
|
|
||||||
|
type redirect = [ `Redirect of Unix.file_descr | `Pipe ]
|
||||||
|
(** Redirecting a file descriptor: either to an existing one, or create
|
||||||
|
a pipe to communicate with the sub-process *)
|
||||||
|
|
||||||
|
val sh : string -> cmd
|
||||||
|
(** Use the shell to run a command, even with pipes and other redirections *)
|
||||||
|
|
||||||
|
val with_proc : ?stdin:redirect ->
|
||||||
|
?stdout:redirect ->
|
||||||
|
?stderr:redirect ->
|
||||||
|
?env:string array ->
|
||||||
|
cmd -> (t -> 'a) -> 'a
|
||||||
|
(** [with_proc cmd f] starts a subprocess and gives it to [f]. When [f]
|
||||||
|
returns, we wait for the subprocess to end. *)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
Loading…
Add table
Reference in a new issue