diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index 7e38efd3..2d0af1e7 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -46,6 +46,15 @@ let rec iter_gen f g = match g() with | None -> () | Some x -> f x; iter_gen f g +let finally_ f x ~h = + try + let y = f x in + ignore (h()); + y + with e -> + ignore (h ()); + raise e + (* print a string, but escaped if required *) let escape_str buf s = if str_exists s @@ -155,6 +164,71 @@ let stderr x = x#stderr let status x = x#status let errcode x = x#errcode +let with_in ?(mode=0o644) ?(flags=[]) file ~f = + let fd = Unix.openfile file (Unix.O_RDONLY::flags) mode in + let ic = Unix.in_channel_of_descr fd in + finally_ f ic + ~h:(fun () -> Unix.close fd) + +let with_out ?(mode=0o644) ?(flags=[Unix.O_CREAT; Unix.O_TRUNC]) file ~f = + let fd = Unix.openfile file (Unix.O_WRONLY::flags) mode in + let oc = Unix.out_channel_of_descr fd in + finally_ f oc + ~h:(fun () -> flush oc; Unix.close fd) + +let with_process_in cmd ~f = + let ic = Unix.open_process_in cmd in + finally_ f ic + ~h:(fun () -> ignore (Unix.close_process_in ic)) + +let with_process_out cmd ~f = + let oc = Unix.open_process_out cmd in + finally_ f oc + ~h:(fun () -> ignore (Unix.close_process_out oc)) + +type process_full = < + stdin: out_channel; + stdout: in_channel; + stderr: in_channel; + close: Unix.process_status; +> + +let with_process_full ?env cmd ~f = + let env = match env with None -> Unix.environment () | Some e -> e in + let oc, ic, err = Unix.open_process_full cmd env in + let p = object + method stdin = ic + method stdout = oc + method stderr = err + method close = Unix.close_process_full (oc,ic,err) + end in + finally_ f p ~h:(fun () -> p#close) + +let with_connection addr ~f = + let ic, oc = Unix.open_connection addr in + finally_ (fun () -> f ic oc) () + ~h:(fun () -> Unix.shutdown_connection ic) + +exception ExitServer + +(* version of {!Unix.establish_server} that doesn't fork *) +let establish_server sockaddr ~f = + let sock = + Unix.socket (Unix.domain_of_sockaddr sockaddr) Unix.SOCK_STREAM 0 in + Unix.setsockopt sock Unix.SO_REUSEADDR true; + Unix.bind sock sockaddr; + Unix.listen sock 5; + let continue = ref true in + while !continue do + try + let s, _ = Unix.accept sock in + let ic = Unix.in_channel_of_descr s in + let oc = Unix.out_channel_of_descr s in + ignore (f ic oc) + with ExitServer -> + continue := false + done + module Infix = struct let (?|) fmt = call fmt diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 779979e7..3eb47145 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -36,8 +36,7 @@ type 'a gen = unit -> 'a option (** {2 Calling Commands} *) val escape_str : Buffer.t -> string -> unit -(** Escape a string so it can be a shell argument. -*) +(** Escape a string so it can be a shell argument. *) (*$T CCPrint.sprintf "%a" escape_str "foo" = "foo" @@ -107,6 +106,57 @@ val stderr : < stderr : 'a; .. > -> 'a val status : < status : 'a; .. > -> 'a val errcode : < errcode : 'a; .. > -> 'a +(** {2 Simple IO} *) + +val with_in : ?mode:int -> ?flags:Unix.open_flag list -> + string -> f:(in_channel -> 'a) -> 'a +(** Open an input file with the given optional flag list, calls the function + on the input channel. When the function raises or returns, the + channel is closed. + @param flags opening flags. [Unix.O_RDONLY] is used in any cases + @since NEXT_RELEASE *) + +val with_out : ?mode:int -> ?flags:Unix.open_flag list -> + string -> f:(out_channel -> 'a) -> 'a +(** Same as {!with_in} but for an output channel + @param flags opening flags (default [[Unix.O_CREAT; Unix.O_TRUNC]]) + [Unix.O_WRONLY] is used in any cases. + @since NEXT_RELEASE *) + +val with_process_in : string -> f:(in_channel -> 'a) -> 'a +(** Open a subprocess and obtain a handle to its stdout + @since NEXT_RELEASE *) + +val with_process_out : string -> f:(out_channel -> 'a) -> 'a +(** Open a subprocess and obtain a handle to its stdin + @since NEXT_RELEASE *) + +(** Handle to a subprocess. + @since NEXT_RELEASE *) +type process_full = < + stdin: out_channel; + stdout: in_channel; + stderr: in_channel; + close: Unix.process_status; +> + +val with_process_full : ?env:string array -> string -> f:(process_full -> 'a) -> 'a +(** Open a subprocess and obtain a handle to its channels. + @param env environment to pass to the subprocess. + @since NEXT_RELEASE *) + +val with_connection : Unix.sockaddr -> f:(in_channel -> out_channel -> 'a) -> 'a +(** Wrap {!Unix.open_connection} with a handler + @since NEXT_RELEASE *) + +exception ExitServer + +val establish_server : Unix.sockaddr -> f:(in_channel -> out_channel -> _) -> unit +(** Listen on the address and calls the handler in a blocking fashion. + Using {!Thread} is recommended if handlers might take time. + The callback should raise {!ExitServer} to stop the loop. + @since NEXT_RELEASE *) + (** {2 Infix Functions} *) module Infix : sig