From 660b75e0b45b6166120ca945e6926dae90b64ede Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 30 Dec 2013 18:00:05 +0100 Subject: [PATCH] more functions in Lwt_automaton (automaton that reads/writes on a Unix FD) --- META | 4 ++-- _oasis | 4 ++-- _tags | 3 ++- lwt_automaton.ml | 54 +++++++++++++++++++++++++++++++++++++++++++++-- lwt_automaton.mli | 13 ++++++++++++ setup.ml | 9 ++++---- 6 files changed, 76 insertions(+), 11 deletions(-) diff --git a/META b/META index 1d11ac3d..79591c55 100644 --- a/META +++ b/META @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 228a31c6369b1dd4a6ea763cff7e020e) +# DO NOT EDIT (digest: 6c4b4efc4408717882c37d4e5ee32d91) version = "0.1" description = "A bunch of modules, including polymorphic containers." requires = "unix" @@ -22,7 +22,7 @@ package "thread" ( package "lwt" ( version = "0.1" description = "A bunch of modules, including polymorphic containers." - requires = "containers lwt" + requires = "containers lwt lwt.unix" archive(byte) = "containers_lwt.cma" archive(byte, plugin) = "containers_lwt.cma" archive(native) = "containers_lwt.cmxa" diff --git a/_oasis b/_oasis index e82be260..359d61b8 100644 --- a/_oasis +++ b/_oasis @@ -61,8 +61,8 @@ Library "containers_lwt" FindlibParent: containers Build$: flag(lwt) Install$: flag(lwt) - BuildDepends: containers,lwt - XMETARequires: containers,lwt + BuildDepends: containers,lwt,lwt.unix + XMETARequires: containers,lwt,lwt.unix Library "containers_cgi" Path: cgi diff --git a/_tags b/_tags index 90173891..dd128438 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: cb8d0069d6571765cb2126aec9384e1e) +# DO NOT EDIT (digest: 9646ccb2c67bd5510c1a73553e55f6ff) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -62,6 +62,7 @@ "lwt_automaton.cmx": for-pack(Containers_lwt) <*.ml{,i}>: use_containers <*.ml{,i}>: package(lwt) +<*.ml{,i}>: package(lwt.unix) <*.ml{,i}>: package(unix) # Library containers_cgi "cgi/containers_cgi.cmxs": use_containers_cgi diff --git a/lwt_automaton.ml b/lwt_automaton.ml index 8d459ae6..cdd03e50 100644 --- a/lwt_automaton.ml +++ b/lwt_automaton.ml @@ -28,10 +28,10 @@ of this software, even if advised of the possibility of such damage. module I = struct let send f i = - Lwt.on_success f (fun x -> Automaton.I.send x i) + Lwt.on_success f (Automaton.I.send i) let iter_stream str i = - Lwt_stream.iter (fun x -> Automaton.I.send x i) str + Lwt_stream.iter (Automaton.I.send i) str end module O = struct @@ -42,3 +42,53 @@ module O = struct end let next_transition a = O.next (Automaton.Instance.transitions a) + +let (>>=) = Lwt.bind + +module Unix = struct + let read_write fd = + let err_fut, err_send = Lwt.wait () in + let transition st i = match st, i with + | `Error _, _ + | `Stopped, _ -> st, [] + | `Active, `Failwith e -> + Lwt.ignore_result (Lwt_unix.close fd); + `Error e, [ `Error e ] + | `Active, `Stop -> + Lwt.ignore_result (Lwt_unix.close fd); + `Stopped, [`Closed] + | `Active, `Write s -> + let fut = Lwt_unix.write fd s 0 (String.length s) in + (* propagate error *) + Lwt.on_failure fut (fun e -> Lwt.wakeup err_send e); + st, [] + | `Active, `JustRead s -> + st, [`Read s] + in + let a = Automaton.Instance.create ~f:transition `Active in + let buf = String.make 128 ' ' in + (* read a string from buffer *) + let rec _read () = + if Automaton.Instance.state a = `Active + then Lwt_unix.read fd buf 0 (String.length buf) >>= fun n -> + begin if n = 0 + then Automaton.Instance.send a `Stop + else + let s = String.sub buf 0 n in + Automaton.Instance.send a (`JustRead s) + end; + _read () + else Lwt.return_unit + in + Lwt.ignore_result (_read ()); + Lwt.on_success err_fut + (fun e -> Automaton.Instance.send a (`Failwith e)); + a + + let timeout f = + let o = Automaton.O.create () in + let fut = Lwt_unix.sleep f in + Lwt.on_success fut + (fun () -> Automaton.O.send o `Timeout); + o +end diff --git a/lwt_automaton.mli b/lwt_automaton.mli index 166f9463..79dda242 100644 --- a/lwt_automaton.mli +++ b/lwt_automaton.mli @@ -43,3 +43,16 @@ end val next_transition : ('s,'i,'o) Automaton.Instance.t -> ('s * 'i * 's * 'o list) Lwt.t + +(** {2 Interface with Unix} *) +module Unix : sig + val read_write : Lwt_unix.file_descr -> + ( [ `Active | `Stopped | `Error of exn ] + , [ `Stop | `Write of string | `JustRead of string | `Failwith of exn ] + , [> `Read of string | `Closed | `Error of exn ] + ) Automaton.Instance.t + (** Read and write on the given filedescriptor *) + + val timeout : float -> [`Timeout] Automaton.O.t + (** Wait the given amount of time, then trigger [`Timeout] *) +end diff --git a/setup.ml b/setup.ml index 979607d8..e9a77f12 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 7dab10989ebb7fbf9c63ffe468939fec) *) +(* DO NOT EDIT (digest: 939751db7ca9dddc45e30f49085683b0) *) (* Regenerated by OASIS v0.4.1 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6963,7 +6963,8 @@ let setup_t = bs_build_depends = [ InternalLibrary "containers"; - FindlibPackage ("lwt", None) + FindlibPackage ("lwt", None); + FindlibPackage ("lwt.unix", None) ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; @@ -7216,7 +7217,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.1"; - oasis_digest = Some "Vjm\254\b\1605[\023\195\024\190\191}\232i"; + oasis_digest = Some "!\199\188\179\016A\015A\130\196J\1291\159\2182"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7224,6 +7225,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7228 "setup.ml" +# 7229 "setup.ml" (* OASIS_STOP *) let () = setup ();;