language: Ocaml (ocamlopt 3.10.2)
date: 223 days 5 hours ago
link:
visibility: public 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

module OUnix = Unix
open Core.Std
open Async.Std
 
type pid = int
 
type t = { pid    : pid
         ; stdin  : Writer.t
         ; stdout : Reader.t
         ; stderr : Reader.t
         }
 
type cmd_exit = [ `Exited of int | `Signal of int | `Unknown ]
 
let read_all r =
  let b = Buffer.create 1024
  in
  let rec read_all' () =
    let str = String.create 4096
    in
    Reader.read r str >>= function
      | `Ok n -> begin
        Buffer.add_substring b str 0 n;
        read_all' ()
      end
      | `Eof  -> begin
        let _ = Reader.close r in
        Deferred.return (Buffer.contents b)
      end
  in
  read_all' ()
 
let wait pi =
  In_thread.run
    (fun () ->
      match OUnix.waitpid [] pi.pid with
        | (_, OUnix.WEXITED exit_code) ->
          `Exited exit_code
        | (_, OUnix.WSIGNALED signal) ->
          `Signal signal
        | _ ->
          `Unknown)
 
let run ~prog ~args =
  let (c_stdin, m_stdin)   = OUnix.pipe ()
  and (m_stdout, c_stdout) = OUnix.pipe ()
  and (m_stderr, c_stderr) = OUnix.pipe ()
  in
  let pid =
    OUnix.create_process
      prog
      (Array.of_list (prog::args))
      c_stdin
      c_stdout
      c_stderr
  in
  OUnix.close c_stdin;
  OUnix.close c_stdout;
  OUnix.close c_stderr;
  let module K = Async.Std.Fd.Kind
  in
  Deferred.return
    { pid = pid
    ; stdin  = Writer.create (Fd.create K.File m_stdin ~name:"stdin")
    ; stdout = Reader.create (Fd.create K.File m_stdout ~name:"stdout")
    ; stderr = Reader.create (Fd.create K.File m_stderr ~name:"stderr")
    }
 
let background d =
  let ret = Ivar.create () in
  whenever (d >>| fun r -> Ivar.fill ret r);
  ret
 
let get_output ~text ~prog ~args =
  run ~prog:prog ~args:args >>= fun pi ->
  Writer.write pi.stdin text;
  Writer.close pi.stdin >>= fun () ->
  let stdout = background (read_all pi.stdout) in
  let stderr = background (read_all pi.stderr) in
  wait pi >>= function
    | `Exited 0 ->
      Deferred.both (Ivar.read stdout) (Ivar.read stderr) >>= fun (stdout, stderr) ->
      Deferred.return (Result.Ok (stdout, stderr))
    | err ->
      Deferred.both (Ivar.read stdout) (Ivar.read stderr) >>= fun (stdout, stderr) ->
      Deferred.return (Result.Error (err, (stdout, stderr)))
 
 
let async_cmd_get_output_test () =
  get_output ~text:"testing" ~prog:"cat" ~args:[] >>= fun _ ->
  Printf.printf "DONE!\n";
  Deferred.return 0
 
let test () =
  upon
    (async_cmd_get_output_test ())
    (fun ret -> never_returns (Shutdown.shutdown_and_raise ret))
 
 
let () =
  test ();
  never_returns (Scheduler.go ())
 
File "prog.ml", line 2, characters 0-13:
Unbound module Core.Std