mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-07 03:35:30 -05:00
add many helpers in CCUnix (for sockets, files, and processes)
This commit is contained in:
parent
7dbf3f983b
commit
7f42c94df7
2 changed files with 126 additions and 2 deletions
|
|
@ -46,6 +46,15 @@ let rec iter_gen f g = match g() with
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| Some x -> f x; iter_gen f g
|
| 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 *)
|
(* print a string, but escaped if required *)
|
||||||
let escape_str buf s =
|
let escape_str buf s =
|
||||||
if str_exists s
|
if str_exists s
|
||||||
|
|
@ -155,6 +164,71 @@ let stderr x = x#stderr
|
||||||
let status x = x#status
|
let status x = x#status
|
||||||
let errcode x = x#errcode
|
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
|
module Infix = struct
|
||||||
let (?|) fmt = call fmt
|
let (?|) fmt = call fmt
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -36,8 +36,7 @@ type 'a gen = unit -> 'a option
|
||||||
(** {2 Calling Commands} *)
|
(** {2 Calling Commands} *)
|
||||||
|
|
||||||
val escape_str : Buffer.t -> string -> unit
|
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
|
(*$T
|
||||||
CCPrint.sprintf "%a" escape_str "foo" = "foo"
|
CCPrint.sprintf "%a" escape_str "foo" = "foo"
|
||||||
|
|
@ -107,6 +106,57 @@ val stderr : < stderr : 'a; .. > -> 'a
|
||||||
val status : < status : 'a; .. > -> 'a
|
val status : < status : 'a; .. > -> 'a
|
||||||
val errcode : < errcode : '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} *)
|
(** {2 Infix Functions} *)
|
||||||
|
|
||||||
module Infix : sig
|
module Infix : sig
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue