fork download
copy 
  1. module OUnix = Unix
  2. open Core.Std
  3. open Async.Std
  4.  
  5. type pid = int
  6.  
  7. type t = { pid    : pid
  8. 	 ; stdin  : Writer.t
  9. 	 ; stdout : Reader.t
  10. 	 ; stderr : Reader.t
  11. 	 }
  12.  
  13. type cmd_exit = [ `Exited of int | `Signal of int | `Unknown ]
  14.  
  15. let read_all r =
  16.   let b = Buffer.create 1024
  17.   in
  18.   let rec read_all' () =
  19.     let str = String.create 4096
  20.     in
  21.     Reader.read r str >>= function
  22.       | `Ok n -> begin
  23. 	Buffer.add_substring b str 0 n;
  24. 	read_all' ()
  25.       end
  26.       | `Eof  -> begin
  27. 	let _ = Reader.close r in
  28. 	Deferred.return (Buffer.contents b)
  29.       end
  30.   in
  31.   read_all' ()
  32.  
  33. let wait pi =
  34.   In_thread.run
  35.     (fun () ->
  36.       match OUnix.waitpid [] pi.pid with
  37. 	| (_, OUnix.WEXITED exit_code) ->
  38. 	  `Exited exit_code
  39. 	| (_, OUnix.WSIGNALED signal) ->
  40. 	  `Signal signal
  41. 	| _ ->
  42. 	  `Unknown)
  43.  
  44. let run ~prog ~args =
  45.   let (c_stdin, m_stdin)   = OUnix.pipe ()
  46.   and (m_stdout, c_stdout) = OUnix.pipe ()
  47.   and (m_stderr, c_stderr) = OUnix.pipe ()
  48.   in
  49.   let pid =
  50.     OUnix.create_process
  51.       prog
  52.       (Array.of_list (prog::args))
  53.       c_stdin
  54.       c_stdout
  55.       c_stderr
  56.   in
  57.   OUnix.close c_stdin;
  58.   OUnix.close c_stdout;
  59.   OUnix.close c_stderr;
  60.   let module K = Async.Std.Fd.Kind
  61.   in
  62.   Deferred.return
  63.     { pid = pid
  64.     ; stdin  = Writer.create (Fd.create K.File m_stdin ~name:"stdin")
  65.     ; stdout = Reader.create (Fd.create K.File m_stdout ~name:"stdout")
  66.     ; stderr = Reader.create (Fd.create K.File m_stderr ~name:"stderr")
  67.     }
  68.  
  69. let background d =
  70.   let ret = Ivar.create () in
  71.   whenever (d >>| fun r -> Ivar.fill ret r);
  72.   ret
  73.  
  74. let get_output ~text ~prog ~args =
  75.   run ~prog:prog ~args:args >>= fun pi ->
  76.   Writer.write pi.stdin text;
  77.   Writer.close pi.stdin >>= fun () ->
  78.   let stdout = background (read_all pi.stdout) in
  79.   let stderr = background (read_all pi.stderr) in
  80.   wait pi >>= function
  81.     | `Exited 0 ->
  82.       Deferred.both (Ivar.read stdout) (Ivar.read stderr) >>= fun (stdout, stderr) ->
  83.       Deferred.return (Result.Ok (stdout, stderr))
  84.     | err ->
  85.       Deferred.both (Ivar.read stdout) (Ivar.read stderr) >>= fun (stdout, stderr) ->
  86.       Deferred.return (Result.Error (err, (stdout, stderr)))
  87.  
  88.  
  89. let async_cmd_get_output_test () =
  90.   get_output ~text:"testing" ~prog:"cat" ~args:[] >>= fun _ ->
  91.   Printf.printf "DONE!\n";
  92.   Deferred.return 0
  93.  
  94. let test () =
  95.   upon
  96.     (async_cmd_get_output_test ())
  97.     (fun ret -> never_returns (Shutdown.shutdown_and_raise ret))
  98.  
  99.  
  100. let () =
  101.   test ();
  102.   never_returns (Scheduler.go ())
  103.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
File "prog.ml", line 2, characters 0-13:
Unbound module Core.Std
stdout
copy 
Standard output is empty
https://ideone.com/WG9mN
language:
OCaml (ocamlopt 4.05.0)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!