mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
wip: CCUnix (with a small subprocess API, not working well yet)
This commit is contained in:
parent
4ab5a709ad
commit
62426ed4dc
6 changed files with 149 additions and 0 deletions
|
|
@ -1,11 +1,13 @@
|
||||||
#use "topfind";;
|
#use "topfind";;
|
||||||
#thread
|
#thread
|
||||||
#require "bigarray";;
|
#require "bigarray";;
|
||||||
|
#require "unix";;
|
||||||
#directory "_build/src/core";;
|
#directory "_build/src/core";;
|
||||||
#directory "_build/src/misc";;
|
#directory "_build/src/misc";;
|
||||||
#directory "_build/src/pervasives/";;
|
#directory "_build/src/pervasives/";;
|
||||||
#directory "_build/src/string";;
|
#directory "_build/src/string";;
|
||||||
#directory "_build/src/io";;
|
#directory "_build/src/io";;
|
||||||
|
#directory "_build/src/unix";;
|
||||||
#directory "_build/src/iter";;
|
#directory "_build/src/iter";;
|
||||||
#directory "_build/src/data";;
|
#directory "_build/src/data";;
|
||||||
#directory "_build/src/sexp";;
|
#directory "_build/src/sexp";;
|
||||||
|
|
@ -16,6 +18,7 @@
|
||||||
#load "containers_iter.cma";;
|
#load "containers_iter.cma";;
|
||||||
#load "containers_data.cma";;
|
#load "containers_data.cma";;
|
||||||
#load "containers_io.cma";;
|
#load "containers_io.cma";;
|
||||||
|
#load "containers_unix.cma";;
|
||||||
#load "containers_sexp.cma";;
|
#load "containers_sexp.cma";;
|
||||||
#load "containers_string.cma";;
|
#load "containers_string.cma";;
|
||||||
#load "containers_pervasives.cma";;
|
#load "containers_pervasives.cma";;
|
||||||
|
|
|
||||||
11
_oasis
11
_oasis
|
|
@ -25,6 +25,10 @@ Flag "misc"
|
||||||
Description: Build the misc library, with experimental modules still susceptible to change
|
Description: Build the misc library, with experimental modules still susceptible to change
|
||||||
Default: true
|
Default: true
|
||||||
|
|
||||||
|
Flag "unix"
|
||||||
|
Description: Build the containers.unix library (depends on Unix)
|
||||||
|
Default: false
|
||||||
|
|
||||||
Flag "lwt"
|
Flag "lwt"
|
||||||
Description: Build modules which depend on Lwt
|
Description: Build modules which depend on Lwt
|
||||||
Default: false
|
Default: false
|
||||||
|
|
@ -60,6 +64,13 @@ Library "containers_io"
|
||||||
FindlibParent: containers
|
FindlibParent: containers
|
||||||
FindlibName: io
|
FindlibName: io
|
||||||
|
|
||||||
|
Library "containers_unix"
|
||||||
|
Path: src/unix
|
||||||
|
Modules: CCUnix
|
||||||
|
BuildDepends: bytes, unix
|
||||||
|
FindlibParent: containers
|
||||||
|
FindlibName: unix
|
||||||
|
|
||||||
Library "containers_sexp"
|
Library "containers_sexp"
|
||||||
Path: src/sexp
|
Path: src/sexp
|
||||||
Modules: CCSexp, CCSexpStream, CCSexpM
|
Modules: CCSexp, CCSexpStream, CCSexpM
|
||||||
|
|
|
||||||
1
opam
1
opam
|
|
@ -12,6 +12,7 @@ build: [
|
||||||
"--%{lwt:enable}%-lwt"
|
"--%{lwt:enable}%-lwt"
|
||||||
"--%{base-bigarray:enable}%-bigarray"
|
"--%{base-bigarray:enable}%-bigarray"
|
||||||
"--%{sequence:enable}%-advanced"
|
"--%{sequence:enable}%-advanced"
|
||||||
|
"--%{base-unix:enable}%-unix"
|
||||||
"--enable-docs"
|
"--enable-docs"
|
||||||
"--enable-misc"]
|
"--enable-misc"]
|
||||||
[make "build"]
|
[make "build"]
|
||||||
|
|
|
||||||
2
src/unix/.merlin
Normal file
2
src/unix/.merlin
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
PKG unix
|
||||||
|
REC
|
||||||
81
src/unix/CCUnix.ml
Normal file
81
src/unix/CCUnix.ml
Normal file
|
|
@ -0,0 +1,81 @@
|
||||||
|
|
||||||
|
(*
|
||||||
|
copyright (c) 2013-2015, 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 High-level Functions on top of Unix} *)
|
||||||
|
|
||||||
|
type 'a or_error = [`Ok of 'a | `Error of string]
|
||||||
|
|
||||||
|
(** {2 Calling Commands} *)
|
||||||
|
|
||||||
|
type cmd = string * string array
|
||||||
|
(** A command: program + arguments *)
|
||||||
|
|
||||||
|
let cmd_of_sh s = "/bin/sh", [| "/bin/sh"; "-c"; s |]
|
||||||
|
|
||||||
|
let int_of_process_status = function
|
||||||
|
| Unix.WEXITED i
|
||||||
|
| Unix.WSIGNALED i
|
||||||
|
| Unix.WSTOPPED i -> i
|
||||||
|
|
||||||
|
let read_all ?(size=1024) ic =
|
||||||
|
let buf = ref (Bytes.create size) in
|
||||||
|
let len = ref 0 in
|
||||||
|
try
|
||||||
|
while true do
|
||||||
|
(* resize *)
|
||||||
|
if !len = Bytes.length !buf then (
|
||||||
|
buf := Bytes.extend !buf 0 !len;
|
||||||
|
);
|
||||||
|
assert (Bytes.length !buf > !len);
|
||||||
|
let n = input ic !buf !len (Bytes.length !buf - !len) in
|
||||||
|
len := !len + n;
|
||||||
|
if n = 0 then raise Exit; (* exhausted *)
|
||||||
|
done;
|
||||||
|
assert false (* never reached*)
|
||||||
|
with Exit ->
|
||||||
|
Bytes.sub_string !buf 0 !len
|
||||||
|
|
||||||
|
let call ?(stdin="") cmd =
|
||||||
|
let cmd, args = match cmd with
|
||||||
|
| `Sh s -> cmd_of_sh s
|
||||||
|
| `Cmd (c, args) -> c, args
|
||||||
|
in
|
||||||
|
let oc, ic, errc = Unix.open_process_full cmd args in
|
||||||
|
(* send stdin *)
|
||||||
|
output_string ic stdin;
|
||||||
|
close_out ic;
|
||||||
|
(* read out and err *)
|
||||||
|
let out = read_all oc in
|
||||||
|
let err = read_all errc in
|
||||||
|
let status = Unix.close_process_full (oc, ic, errc) in
|
||||||
|
object
|
||||||
|
method stdout = out
|
||||||
|
method stderr = err
|
||||||
|
method status = status
|
||||||
|
method errcode = int_of_process_status status
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
51
src/unix/CCUnix.mli
Normal file
51
src/unix/CCUnix.mli
Normal file
|
|
@ -0,0 +1,51 @@
|
||||||
|
|
||||||
|
(*
|
||||||
|
copyright (c) 2013-2015, 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 High-level Functions on top of Unix}
|
||||||
|
|
||||||
|
Some useful functions built on top of Unix.
|
||||||
|
|
||||||
|
@since NEXT_RELEASE *)
|
||||||
|
|
||||||
|
type 'a or_error = [`Ok of 'a | `Error of string]
|
||||||
|
|
||||||
|
(** {2 Calling Commands} *)
|
||||||
|
|
||||||
|
type cmd = string * string array
|
||||||
|
(** A command: program + arguments *)
|
||||||
|
|
||||||
|
val call :
|
||||||
|
?stdin:string ->
|
||||||
|
[`Sh of string | `Cmd of cmd] ->
|
||||||
|
< stdout:string;
|
||||||
|
stderr:string;
|
||||||
|
status:Unix.process_status;
|
||||||
|
errcode:int; (** extracted from status *)
|
||||||
|
>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Loading…
Add table
Reference in a new issue