From 6fb26288ad46fc107d064046d33a50724f3fe432 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 28 Mar 2015 12:00:08 +0100 Subject: [PATCH] richer CCUnix.call API, with tests --- Makefile | 2 ++ _oasis | 4 +-- src/data/CCIntMap.ml | 2 +- src/unix/CCUnix.ml | 82 +++++++++++++++++++++++++++++++------------- src/unix/CCUnix.mli | 35 ++++++++++++++++--- 5 files changed, 93 insertions(+), 32 deletions(-) diff --git a/Makefile b/Makefile index a7079cec..81d3621b 100644 --- a/Makefile +++ b/Makefile @@ -65,6 +65,8 @@ QTESTABLE=$(filter-out $(DONTTEST), \ $(wildcard src/string/*.mli) \ $(wildcard src/io/*.ml) \ $(wildcard src/io/*.mli) \ + $(wildcard src/unix/*.ml) \ + $(wildcard src/unix/*.mli) \ $(wildcard src/sexp/*.ml) \ $(wildcard src/sexp/*.mli) \ $(wildcard src/advanced/*.ml) \ diff --git a/_oasis b/_oasis index 9b2f05df..7a2b6dce 100644 --- a/_oasis +++ b/_oasis @@ -203,8 +203,8 @@ Executable run_qtest Build$: flag(tests) && flag(bigarray) BuildDepends: containers, containers.misc, containers.string, containers.iter, containers.io, containers.advanced, containers.sexp, - containers.bigarray, - sequence, gen, oUnit, QTest2Lib + containers.bigarray, containers.unix, + sequence, gen, unix, oUnit, QTest2Lib Executable run_qtest_lwt Path: qtest/lwt/ diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index 7a0fed15..c3fecc7f 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -134,7 +134,7 @@ let rec insert_ c k v t = match t with let add k v t = insert_ (fun ~old:_ v -> v) k v t -(*$Q +(*$Q & ~count:20 Q.(list (pair int int)) (fun l -> \ let l = CCList.Set.uniq l in let m = of_list l in \ List.for_all (fun (k,v) -> find_exn k m = v) l) diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index b7bd8dc2..238ef0c2 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -27,19 +27,40 @@ 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] +type 'a gen = unit -> 'a option (** {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 str_exists s p = + let rec f s p i = + if i = String.length s then false + else p s.[i] || f s p (i+1) + in + f s p 0 + +let rec iter_gen f g = match g() with + | None -> () + | Some x -> f x; iter_gen f g + +(* print a string, but escaped if required *) +let escape_str buf s = + if str_exists s + (function ' ' | '"' | '\'' -> true | _ -> false) + then ( + Buffer.add_char buf '\''; + String.iter + (function + | '\'' -> Buffer.add_string buf "''" + | c -> Buffer.add_char buf c + ) s; + Buffer.add_char buf '\''; + ) else Buffer.add_string buf s + let read_all ?(size=1024) ic = let buf = ref (Bytes.create size) in let len = ref 0 in @@ -58,24 +79,37 @@ let read_all ?(size=1024) ic = 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 +type call_result = + < stdout:string; + stderr:string; + status:Unix.process_status; + errcode:int; (** extracted from status *) + > +let kbprintf' buf fmt k = Printf.kbprintf k buf fmt + +let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=[||]) cmd = + (* render the command *) + let buf = Buffer.create 256 in + kbprintf' buf cmd + (fun buf -> + let cmd = Buffer.contents buf in + let oc, ic, errc = Unix.open_process_full cmd env in + (* send stdin *) + begin match stdin with + | `Str s -> output_string ic s + | `Gen g -> iter_gen (output_string ic) g + end; + close_out ic; + (* read out and err *) + let out = read_all ~size:bufsize oc in + let err = read_all ~size:bufsize 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 + ) diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 003f8406..a4f037d0 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -31,21 +31,46 @@ Some useful functions built on top of Unix. @since NEXT_RELEASE *) type 'a or_error = [`Ok of 'a | `Error of string] +type 'a gen = unit -> 'a option (** {2 Calling Commands} *) -type cmd = string * string array -(** A command: program + arguments *) +val escape_str : Buffer.t -> string -> unit +(** Escape a string so it can be a shell argument. +*) -val call : - ?stdin:string -> - [`Sh of string | `Cmd of cmd] -> +(*$T + CCPrint.sprintf "%a" escape_str "foo" = "foo" + CCPrint.sprintf "%a" escape_str "foo bar" = "'foo bar'" + CCPrint.sprintf "%a" escape_str "fo'o b'ar" = "'fo''o b''ar'" +*) + +type call_result = < stdout:string; stderr:string; status:Unix.process_status; errcode:int; (** extracted from status *) > +val call : ?bufsize:int -> + ?stdin:[`Gen of string gen | `Str of string] -> + ?env:string array -> + ('a, Buffer.t, unit, call_result) format4 -> + 'a +(** [call cmd] wraps the result of [Unix.open_process_full cmd] into an + object. It reads the full stdout and stderr of the subprocess before + returning. + @param stdin if provided, the generator or string is consumed and fed to + the subprocess input channel, which is then closed. + @param bufsize buffer size used to read stdout and stderr + @param env environment to run the command in +*) + +(*$T + (call ~stdin:(`Str "abc") "cat")#stdout = "abc" + (call "echo %a" escape_str "a'b'c")#stdout = "abc\n" + (call "echo %s" "a'b'c")#stdout = "abc\n" +*)