Merge pull request #62 from paurkedal/server-properties

Server properties

Author: paurkedal

bindings/ffi_bindings.ml

@@ -308,6 +308,18 @@ module Functions (F : Ctypes.FOREIGN) = struct
   let mysql_ping = foreign "mysql_ping"
     (mysql @-> returning int)
 
+  let mysql_get_server_info = foreign "mysql_get_server_info"
+    (mysql @-> returning string)
+
+  let mysql_get_server_version = foreign "mysql_get_server_version"
+    (mysql @-> returning ulong)
+
+  let mysql_get_host_info = foreign "mysql_get_host_info"
+    (mysql @-> returning string)
+
+  let mysql_get_proto_info = foreign "mysql_get_proto_info"
+    (mysql @-> returning uint)
+
   let mysql_stmt_prepare = foreign "mysql_stmt_prepare"
     (stmt @-> ptr char @-> ulong @-> returning int)
 

lib/blocking.ml

@@ -121,6 +121,11 @@ let change_user mariadb user pass db =
   wrap_unit mariadb
     (B.mysql_change_user mariadb.Common.raw user pass mariadb.Common.db)
 
+let get_server_info = Common.get_server_info
+let get_server_version = Common.get_server_version
+let get_host_info = Common.get_host_info
+let get_proto_info = Common.get_proto_info
+
 let set_client_option =
   Common.set_client_option
 

lib/common.ml

@@ -199,6 +199,18 @@ let int_of_flag = function
 let int_of_flags =
   List.fold_left (fun acc flag -> Int32.logor acc (int_of_flag flag)) 0l
 
+let get_server_info mariadb =
+  B.mysql_get_server_info mariadb.raw
+
+let get_server_version mariadb =
+  Unsigned.ULong.to_int (B.mysql_get_server_version mariadb.raw)
+
+let get_host_info mariadb =
+  B.mysql_get_host_info mariadb.raw
+
+let get_proto_info mariadb =
+  Unsigned.UInt.to_int (B.mysql_get_proto_info mariadb.raw)
+
 module Res = struct
   open Ctypes
 

lib/mariadb.ml

@@ -156,6 +156,10 @@ module type S = sig
   val set_character_set : t -> string -> unit result
   val select_db : t -> string -> unit result
   val change_user : t -> string -> string -> string option -> unit result
+  val get_server_info : t -> string
+  val get_server_version : t -> int
+  val get_host_info : t -> string
+  val get_proto_info : t -> int
   val set_client_option : t -> client_option -> unit
   val set_server_option : t -> server_option -> unit result
   val ping : t -> unit result

lib/mariadb.mli

@@ -255,6 +255,18 @@ module type S = sig
         [user] with password [password] and optionally change to database
         [db]. *)
 
+  val get_server_info : t -> string
+    (** The version version as a string. *)
+
+  val get_server_version : t -> int
+    (** The server version encoded as [major * 10000 + minor * 100 + patch]. *)
+
+  val get_host_info : t -> string
+    (** A string representing the server host name and the connection type. *)
+
+  val get_proto_info : t -> int
+    (** The protocol version used for the connection. *)
+
   val set_client_option : t -> client_option -> unit
     (** Sets the given client option on the connection. *)
 
@@ -514,6 +526,10 @@ module Nonblocking : sig
     val select_db : t -> string -> unit result future
     val change_user : t -> string -> string -> string option
                    -> unit result future
+    val get_server_info : t -> string
+    val get_server_version : t -> int
+    val get_host_info : t -> string
+    val get_proto_info : t -> int
     val set_client_option : t -> client_option -> unit
     val set_server_option : t -> server_option -> unit result future
     val ping : t -> unit result future

lib/nonblocking.ml

@@ -525,6 +525,10 @@ module type S = sig
   val set_character_set : t -> string -> unit result future
   val select_db : t -> string -> unit result future
   val change_user : t -> string -> string -> string option -> unit result future
+  val get_server_info : t -> string
+  val get_server_version : t -> int
+  val get_host_info : t -> string
+  val get_proto_info : t -> int
   val set_client_option : t -> client_option -> unit
   val set_server_option : t -> server_option -> unit result future
   val ping : t -> unit result future
@@ -712,6 +716,14 @@ module Make (W : Wait) : S with type 'a future = 'a W.IO.future = struct
     m.Common.db <- char_ptr_opt_buffer_of_string db;
     nonblocking m (change_user m)
 
+  let get_server_info = Common.get_server_info
+
+  let get_server_version = Common.get_server_version
+
+  let get_host_info = Common.get_host_info
+
+  let get_proto_info = Common.get_proto_info
+
   let set_client_option = Common.set_client_option
 
   let set_server_option m opt = nonblocking m (set_server_option m opt)

tests/nonblocking/nonblocking_testsuite.ml

@@ -16,6 +16,8 @@ struct
 
   let env var def = try Sys.getenv var with Not_found -> def
 
+  let die_f ppf = ksprintf (fun msg -> eprintf "%s\n%!" msg; exit 2) ppf
+
   let or_die where = function
     | Ok r -> return r
     | Error (i, e) -> eprintf "%s: (%d) %s\n%!" where i e; exit 2
@@ -134,6 +136,24 @@ struct
      | None -> failwith "expecting one row, no rows returned"
      | Some a -> a)
 
+  let test_server_properties () =
+    connect () >>= or_die "connect" >>= fun dbh ->
+    let v = M.get_server_version dbh in
+    assert (v >= 10000 && v < 10000000); (* 1 <= major_version < 1000 *)
+    let info = M.get_server_info dbh in
+    let info' = sprintf "%d.%d.%d" (v / 10000) (v / 100 mod 100) (v mod 100) in
+    assert (String.starts_with ~prefix:info' info);
+    let host = M.get_host_info dbh in
+    assert (String.length host < 1024);
+    for i = 0 to String.length host - 1 do
+      match host.[i] with
+      | '\x20'..'\x7f' -> ()
+      | _ -> die_f "result from get_host_info looks suspicious: %S" host
+    done;
+    let proto = M.get_proto_info dbh in
+    assert (proto >= 0 && proto < 10000); (* it's 10 for MariaDB 10.11.8 *)
+    return ()
+
   let test_insert_id () =
     connect () >>= or_die "connect" >>= fun dbh ->
     M.prepare dbh
@@ -323,6 +343,7 @@ struct
     (test_integer, test_bigint)
 
   let main () =
+    test_server_properties () >>= fun () ->
     test_insert_id () >>= fun () ->
     test_txn () >>= fun () ->
     test_many_select () >>= fun () ->