[PATCH] Glib.Io + socket on win32 on Windows

--cWoXeonUoKmBZSoM
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Hello, while porting CoqIDE to windows I had to write a patch for the
Glib.Io module.  The function to get an Io.channel on windows is not
the same, and it also depends on the nature of the descriptor
(pipe/file v.s. socket).

I had to add the channel_of_descr_socket variant, that under unix is
just an alias for g_io_channel_unix_new, but that on windows calls
g_io_channel_win32_new_socket instead of g_io_channel_win32_new_fd.

I'm attaching my patch, and a small interactive test (one has to netcat
to the printed port and see if the server correctly reacts when some
data is sent).  
According to my tests, if one uses g_io_channel_win32_new_fd on sockets
things go wrong.  Also using add_watch on a pipe (on which one can
call g_io_channel_win32_new_fd) does not work.

Best,
-- 
Enrico Tassi

--cWoXeonUoKmBZSoM
Content-Type: text/x-diff; charset=us-ascii
Content-Disposition: attachment; filename="io-channels.diff"

--- lablgtk-2.18.0/src/glib.mli	2013-10-01 01:31:50.000000000 -0700
+++ lablgtk-2.18.0.new/src/glib.mli	2013-12-06 11:57:34.203675200 -0800
@@ -75,6 +75,7 @@
   type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI]
   type id
   val channel_of_descr : Unix.file_descr -> channel
+  val channel_of_descr_socket : Unix.file_descr -> channel
   val add_watch :
     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
   val remove : id -> unit
--- lablgtk-2.18.0/src/glib.ml	2013-10-01 01:31:50.000000000 -0700
+++ lablgtk-2.18.0.new/src/glib.ml	2013-12-06 11:57:53.070804800 -0800
@@ -72,6 +72,8 @@
   type id
   external channel_of_descr : Unix.file_descr -> channel
     = "ml_g_io_channel_unix_new"
+  external channel_of_descr_socket : Unix.file_descr -> channel
+    = "ml_g_io_channel_unix_new_socket"
   external remove : id -> unit = "ml_g_source_remove"
   external add_watch :
     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
--- lablgtk-2.18.0/src/ml_glib.c	2013-10-01 01:31:50.000000000 -0700
+++ lablgtk-2.18.0.new/src/ml_glib.c	2013-12-10 02:03:33.940371800 -0800
@@ -25,6 +25,8 @@
 #include <string.h>
 #include <locale.h>
 #ifdef _WIN32
+/* to kill a #warning: include winsock2.h before windows.h */
+#include <winsock2.h>
 #include "win32.h"
 #include <wtypes.h>
 #include <io.h>
@@ -38,6 +40,11 @@
 #include <caml/callback.h>
 #include <caml/threads.h>
 
+#ifdef _WIN32
+/* for Socket_val */
+#include <caml/unixsupport.h>
+#endif
+
 #include "wrappers.h"
 #include "ml_glib.h"
 #include "glib_tags.h"
@@ -325,14 +332,23 @@
 
 #ifndef _WIN32
 ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref)
+CAMLprim value ml_g_io_channel_unix_new_socket (value arg1) {
+  return Val_GIOChannel_noref (g_io_channel_unix_new (Int_val (arg1))); 
+}
 
 #else
 CAMLprim value ml_g_io_channel_unix_new(value wh)
 {
   return Val_GIOChannel_noref
-    (g_io_channel_unix_new
+    (g_io_channel_win32_new_fd
      (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY)));
 }
+
+CAMLprim value ml_g_io_channel_unix_new_socket(value wh)
+{
+  return Val_GIOChannel_noref
+    (g_io_channel_win32_new_socket(Socket_val(wh)));
+}
 #endif
 
 static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c,

--cWoXeonUoKmBZSoM
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="test.ml"


let main () =
  let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  Unix.bind s (Unix.ADDR_INET (Unix.inet_addr_loopback,0));
  Unix.listen s 1;
  let host, port =
    match Unix.getsockname s with
    | Unix.ADDR_INET(host, port) ->
        Unix.string_of_inet_addr host, string_of_int port
    | _ -> assert false in
  prerr_endline ("connect to " ^ host^" "^port);
  let cs, _ = Unix.accept s in
  prerr_endline "nc connected";

  let ch = Glib.Io.channel_of_descr_socket cs in

  let print_cond = function
    | `IN -> "IN"
    | `ERR -> "ERR"
    | `OUT -> "OUT"
    | `PRI -> "PRI"
    | `NVAL -> "NVAL"
    | `HUP -> "HUP"
  in

  let watch conds =
    prerr_endline "something happened";
    List.iter prerr_endline (List.map print_cond conds);
    true
  in

  let _ = Glib.Io.add_watch ~cond:[`IN] ~callback:watch ch in

  GMain.main ();
  exit 0
;;

main ()

--cWoXeonUoKmBZSoM
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
Lablgtk-list mailing list
[email protected]
https://lists.ocamlcore.org/cgi-bin/listinfo/lablgtk-list

--cWoXeonUoKmBZSoM--