fork download
  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
stdin
Standard input is empty
compilation info
File "prog.ml", line 2, characters 0-13:
Unbound module Core.Std
stdout

Standard output is empty