[ocaml-ctypes] Help with probable GC problem

[Andre Nathan]

Hi

I've been trying to find a bug in my OCaml MariaDB bindings but haven't 
had any luck so I decided to try the list.

The issue is that after a few hundred runs, the username passed to the 
MariaDB connection function becomes garbled, failing with a message like

   Access denied for user 'x��P�'@'localhost' (using password: YES)

It seems like a memory value is being overwritten, or maybe claimed by 
the OCaml GC, although in the library I explicitly copy the username 
string, and libmariadb calls strdup() on it so I'm not sure that's the 
problem.

Since the library is very large, I created a branch with the minimal 
bindings to open and close a connection, so that inspection of the code 
becomes feasible:

   https://github.com/andrenth/ocaml-mariadb/tree/minimal

The example test code simply opens and closes the connection 50k times. 
It uses Unix.select to avoid dependencies, but the problem also happens 
with, say, Lwt.

In C, the library is used like this:

   int status;
   MYSQL mysql, *ret;

   status = mysql_real_connect_start(&ret, &mysql,
                                     "host", "user", "pass",
                                     NULL, 0, NULL, 0);
   while (status) {
     status = wait_for_mysql(&mysql, status);
     status = mysql_real_connect_cont(&ret, &mysql, status);
   }

   if (!ret)
     fatal(&mysql, "Failed to mysql_real_connect()");

The idea is to try to connect with the "start" function and keep trying 
until the socket is ready and "cont" function succeeds.

In OCaml, the bindings are as below:

   type mysql = unit ptr
   let mysql : mysql typ = ptr void

   type mysql_opt = unit ptr option
   let mysql_opt : mysql_opt typ = ptr_opt void

   let mysql_real_connect_start = foreign "mysql_real_connect_start"
     (ptr mysql_opt @-> mysql @-> ptr_opt char @-> ptr_opt char @->
      ptr_opt char @-> ptr_opt char @-> uint @-> ptr_opt char @->
      ulong @-> returning int)

   let mysql_real_connect_cont = foreign "mysql_real_connect_cont"
     (ptr mysql_opt @-> mysql @-> int @-> returning int)

Then there are wrappers for the two connect functions:

   let handle_ret f =
     let ret = allocate B.mysql_opt None in
     let status = f ret in
     (status, !@ret)

   let mysql_real_connect_start mysql host user pass db port sock flags =
     (* convert string option to char ptr option *)
     let host, user, pass, db, sock = ...
     let port = Unsigned.UInt.of_int port in
     let flags = Unsigned.ULong.of_int flags in
     handle_ret
       (fun ret ->
         B.mysql_real_connect_start
           ret mysql host user pass db port socket flags)

   let mysql_real_connect_cont mysql status =
     handle_ret (fun ret -> B.mysql_real_connect_cont ret mysql status)

To implement the start/wait/cont loop, I have the function below:

   let rec nonblocking mariadb (start, cont) =
     match start () with
     | `Ok v -> return (Ok v)
     | `Error e -> return (Error e)
     | `Wait status ->
         W.wait mariadb status >>= fun s ->
         nonblocking mariadb ((fun () -> cont status), cont)

Here W is a user-provided module that checks socket readiness.

Then two more wrappers to allow the connect start/cont functions to be 
used with "nonblocking":

   let handle_opt mariadb = function
     | 0, Some _ -> `Ok mariadb
     | 0, None -> `Error (error mariadb)
     | s, _ -> `Wait (Status.of_int s)

   let connect_start mariadb host user pass db port sock () =
     handle_opt mariadb
       (B.mysql_real_connect_start mariadb host user pass db port sock 0)

   let connect_cont mariadb status =
     handle_opt mariadb
       (B.mysql_real_connect_cont mariadb (Status.to_int status))

Collect both functions in a tuple:

   let connect mariadb ?host ?user ?pass ?db ?(port=0) ?socket () =
     let start = connect_start mariadb host user pass db port socket in
     let cont = connect_cont mariadb in
     (start, cont)

And finally the user-visible function, which passes the tuple to 
"nonblocking":

   let connect ?host ?user ?pass ?db ?(port=0) ?socket () =
     match init () with
     | Some m ->
         nonblocking m (connect m ?host ?user ?pass ?db ~port ?socket ())
     | None ->
         return (Error (2008, "out of memory"))

I'm not sure if any sort of obvious error can be spotted from all that 
above, but any help would be appreciated.

Thanks in advance,
Andre