Date: Tue, 9 Nov 2004 15:29:40 +0100
From: "Wesley W. Terpstra" <terpstra at gkec.tu-darmstadt.de>
To: Olivier Andrieu <andrieu at ijm.jussieu.fr>
Cc: lablgtk at kaba.or.jp
Subject: Re: Bug in ml_g_io_add_watch
Message-ID: <20041109142940.GA7509 at muffin>
References: <20041109030536.GA9792 at muffin> <20041109.122655.41646513.andrieu at ijm.jussieu.fr>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
In-Reply-To: <20041109.122655.41646513.andrieu at ijm.jussieu.fr>

On Tue, Nov 09, 2004 at 12:26:55PM +0100, Olivier Andrieu wrote:
>  > The fix is simply to kill the first two statements.
>  > I have tested this and it appears to work.
>=20
> Thanks for the bug report. It is already corrected in the CVS
> repository.=20

Excellent; thanks. =3D)
What is the release schedule and contribution policy for lablgtk2 btw?

>  > This bug is a problem b/c lablgtk2 provides no way of unhooking a
>  > watch for `HUP and `IN at the same time. This means programs like
>  > giotest.ml (from the examples) cannot be fixed for pipes. Either
>  > they go into an infinite event spawn (consuming 100% CPU) when the
>  > HUP occures, or they bind the `HUP event and then cannot unbind (or
>  > close) the pipe's `IN event.
>=20
> Yeah, actually this function should have type
>   val add_watch :=20
>     condition list -> (condition list -> bool) -> channel -> id
> instead of
>   val add_watch : condition -> (unit -> bool) -> channel -> id
>=20
> The problem if you set up two watches (one for `HUP and one for `IN)
> is that you don't known in what order the callbacks will be called
> when a `HUP+`IN event occurs.

Yes, that's correct.
I worked around this as follows:

---------------------------------------------------------------------------=
--

let stream ~prog ~args ~stdin ~stdout ~stderr
           ~msg ~pipe ~blocklen ~callback ~quit =3D
  (* Create the process *)
  let pid =3D create_process prog
    args stdin stdout stderr in
  let ch =3D GMain.Io.channel_of_descr pipe in

  (* Stub methods to allow binding first *)
  let cleanup =3D ref (fun _ -> false) in
  let process =3D ref (fun _ -> false) in

  (* Buffer for reading *)
  let buf  =3D ref (String.create blocklen) in
  let fill =3D ref 0 in

  (* process stderr from the encoder for status *)
  let get =3D GMain.Io.add_watch ch ~prio:0 ~cond:`GET
            ~callback:(fun () -> !process `GET) in
  let hup =3D GMain.Io.add_watch ch ~prio:0 ~cond:`HUP
            ~callback:(fun () -> !process `HUP) in
  let err =3D GMain.Io.add_watch ch ~prio:0 ~cond:`ERR
            ~callback:(fun () -> !cleanup `ERR) in

  (* Cleanup method *)
  cleanup :=3D begin fun hook ->
    (* prerr_endline "EOF"; *)
    close pipe; (* close early to cause SIGPIPE if app still running *)
    begin match waitpid [] pid with
     | (_, WEXITED 0) -> if hook !=3D =05RR then () else
       Gui.die (args.(0) ^ " failed")
       (msg ^ "Received error condition on pipe")
     | (_, WEXITED x) -> Gui.die (args.(0) ^ " failed")
       (msg ^ "Exit status: " ^ string_of_int x)
     | (_, WSIGNALED x) -> Gui.die (args.(0) ^ " failed")
       (msg ^ "Killed by signal " ^ string_of_int x)
     | (_, WSTOPPED x) -> Gui.die (args.(0) ^ " failed")
       (msg ^ "Stopped by signal " ^ string_of_int x)
    end;
    quit ();
    if hook !=3D `GET then GMain.Io.remove get;
    if hook !=3D `HUP then GMain.Io.remove hup;
    if hook !=3D `ERR then GMain.Io.remove err;
    false (* unhook last binding *)
  end;

  (* Data processing method *)
  process :=3D begin fun hook ->
    let got =3D GMain.Io.read ch ~buf:!buf ~pos:!fill ~len:(blocklen- !fill=
) in
    if got <=3D 0 then !cleanup hook
    else begin
      fill :=3D !fill + got;
      if !fill =3D blocklen then begin
        fill :=3D 0 ;
        callback !buf
      end;
      true
    end
  end

---------------------------------------------------------------------------=
--

You will notice that I bind the hup event also to the processing handler.
The test for read <=3D 0 is enough to catch both the HUP and EOF cases.

If there was a method
>   val add_watch :
>     condition list -> (condition list -> bool) -> channel -> id
this huge piece of ugly code would be radically improved.

How do I commit? ;)

PS:

I can't figure out how to kill the child process when my application
quits under windows. There's no kill! What should I do? It doesn't even
get a SIGPIPE if it was already blocked in write(...).

Also, what exactly is an `ERR condition?
Can it ever really occur on a pipe?

--=20
Wesley W. Terpstra