Revert "Get rid of unlocked/locked."

This reverts commit 03f78bc.

CHANGES.md

@@ -1,7 +1,6 @@
 0.3.1 (unreleased)
 =====
 * Added missing dependency on `ocamlfind`
-* Remove `locked`/`unlocked` mode.
 
 0.3.0 (2022-03-04)
 =====

examples/dune

@@ -1,4 +1,3 @@
 (test
  (name test)
- (modes exe)
  (libraries srt))

src/dune

@@ -8,13 +8,19 @@
  (name srt)
  (foreign_stubs
   (language c)
-  (names srt_generated_stubs)
+  (names srt_generated_stubs srt_generated_stubs_locked)
   (flags
    (:include c_flags.sexp)))
  (c_library_flags
   (:include c_library_flags.sexp))
  (synopsis "Binding for the Secure, Reliable, Transport protocol library")
- (libraries threads integers srt.stubs ctypes.stubs ctypes.foreign))
+ (libraries
+  threads
+  integers
+  srt.stubs
+  srt.stubs.locked
+  ctypes.stubs
+  ctypes.foreign))
 
 (rule
  (targets c_flags.sexp c_library_flags.sexp)
@@ -36,3 +42,19 @@
   (:gen ./generator/gen_stubs.exe))
  (action
   (system "%{exec} %{ocaml-config:system} %{gen} c %{targets}")))
+
+(rule
+ (targets srt_generated_stubs_locked.ml)
+ (deps
+  (:exec ./generator/exec.sh)
+  (:gen ./generator/gen_stubs.exe))
+ (action
+  (system "%{exec} %{ocaml-config:system} %{gen} ml %{targets} locked")))
+
+(rule
+ (targets srt_generated_stubs_locked.c)
+ (deps
+  (:exec ./generator/exec.sh)
+  (:gen ./generator/gen_stubs.exe))
+ (action
+  (system "%{exec} %{ocaml-config:system} %{gen} c %{targets} locked")))

src/generator/build_native.sh

@@ -24,4 +24,7 @@ ocamlfind ${TOOLCHAIN} ocamlopt \
   -I ../stubs \
   -I ../stubs/.srt_stubs.objs/native/ \
   -I ../stubs/.srt_stubs.objs/byte/ \
+  -I ../stubs/locked \
+  -I ../stubs/locked/.srt_stubs_locked.objs/native/ \
+  -I ../stubs/locked/.srt_stubs_locked.objs/byte/ \
   $@ ${ML} -o ${OUTPUT}

src/generator/dune

@@ -16,10 +16,16 @@
    ../stubs/.srt_stubs.objs/native/
    -I
    ../stubs/.srt_stubs.objs/byte/
+   -I
+   ../stubs/locked
+   -I
+   ../stubs/locked/.srt_stubs_locked.objs/native/
+   -I
+   ../stubs/locked/.srt_stubs_locked.objs/byte/
    %{lib-private:srt.constants:srt_constants.cmxa}
    %{lib-private:srt.types:srt_types.cmxa}
    %{lib-private:srt.stubs:srt_stubs.cmxa}
-   %{lib-private:srt.stubs:.srt_stubs.objs/native/srt_stubs.cmx})))
+   %{lib-private:srt.stubs:locked/.srt_stubs_locked.objs/native/srt_stubs_locked.cmx})))
 
 (rule
  (targets gen_types_c.exe)

src/generator/gen_stubs.ml

@@ -8,7 +8,6 @@ let c_headers =
 #include <pthread.h>
 #include <srt/srt.h>
 #include <stdio.h>
-#include <string.h>
 
 #define MAX_LOG_STRING 1024
 
@@ -99,19 +98,28 @@ CAMLprim value ocaml_srt_clear_log_callback() {
 }
 |}
 
+let locked_c_headers = {|
+#include <string.h>
+|}
+
 let () =
   let mode = Sys.argv.(1) in
   let fname = Sys.argv.(2) in
+  let locked = Array.length Sys.argv > 3 in
   let oc = open_out_bin fname in
   let format = Format.formatter_of_out_channel oc in
   let fn =
     match mode with
       | "ml" -> Cstubs.write_ml
       | "c" ->
-          Format.fprintf format "%s@\n" c_headers;
+          if locked then Format.fprintf format "%s@\n" locked_c_headers
+          else Format.fprintf format "%s@\n" c_headers;
           Cstubs.write_c
       | _ -> assert false
   in
-  fn format ~prefix:"ocaml_srt" (module Srt_stubs.Def);
+  if locked then fn format ~prefix:"ocaml_srt" (module Srt_stubs_locked.Def)
+  else
+    fn ~concurrency:Cstubs.unlocked format ~prefix:"ocaml_srt"
+      (module Srt_stubs.Def);
   Format.pp_print_flush format ();
   close_out oc

src/srt.ml

@@ -2,6 +2,8 @@ open Ctypes
 open Posix_socket
 module Srt = Srt_stubs.Def (Srt_generated_stubs)
 open Srt
+module Srt_locked = Srt_stubs_locked.Def (Srt_generated_stubs_locked)
+open Srt_locked
 open Unsigned
 
 exception Invalid_argument of string
@@ -208,8 +210,15 @@ let send sock msg =
 let sendmsg sock msg b v =
   check_err (sendmsg sock (Bytes.unsafe_to_string msg) (Bytes.length msg) b v)
 
-let recv sock buf len = check_err (recv sock (ocaml_bytes_start buf) len)
-let recvmsg sock buf len = check_err (recvmsg sock (ocaml_bytes_start buf) len)
+let mk_recv fn sock buf len =
+  if Bytes.length buf < len then raise (Invalid_argument "buffer too short!");
+  let ptr = allocate_n char ~count:len in
+  let length = check_err (fn sock ptr len) in
+  memcpy (ocaml_bytes_start buf) ptr length;
+  length
+
+let recv = mk_recv recv
+let recvmsg = mk_recv recvmsg
 
 let getsockflag : type a b. socket -> (a, b) socket_opt -> b =
  fun sock opt ->
@@ -250,15 +259,18 @@ let getsockflag : type a b. socket -> (a, b) socket_opt -> b =
 let setsockflag : type a b. socket -> (a, b) socket_opt -> b -> unit =
  fun sock opt v ->
   let f t v = to_voidp (allocate t v) in
-  let setsockflag value len sock opt = setsockflag sock opt value len in
-  let setsockflag_str value len sock opt = setsockflag_str sock opt value len in
   let of_bool v =
     let v = if v then 1 else 0 in
-    setsockflag (f int v) (sizeof int)
+    (f int v, sizeof int)
+  in
+  let of_int v = (f int v, sizeof int) in
+  let of_string v =
+    let len = String.length v in
+    let ptr = allocate_n char ~count:len in
+    memcpy_str ptr (ocaml_string_start v) len;
+    (to_voidp ptr, len)
   in
-  let of_int v = setsockflag (f int v) (sizeof int) in
-  let of_string v = setsockflag_str (ocaml_string_start v) (String.length v) in
-  let setsockflag =
+  let arg, arglen =
     match opt with
       | Enforced_encryption -> of_bool v
       | Rcvsyn -> of_bool v
@@ -278,11 +290,12 @@ let setsockflag : type a b. socket -> (a, b) socket_opt -> b -> unit =
       | Rcvlatency -> of_int v
       | Transtype ->
           let transtype = int_of_transtype v in
-          setsockflag (f int transtype) (sizeof int)
+          (f int transtype, sizeof int)
       | Passphrase -> of_string v
       | Streamid -> of_string v
   in
-  ignore (check_err (setsockflag sock (srt_socket_opt_of_socket_opt opt)))
+  ignore
+    (check_err (setsockflag sock (srt_socket_opt_of_socket_opt opt) arg arglen))
 
 let close s =
   ignore (check_err (close s));

src/stubs/locked/dune

@@ -0,0 +1,4 @@
+(library
+ (name srt_stubs_locked)
+ (public_name srt.stubs.locked)
+ (libraries ctypes.stubs))

src/stubs/locked/srt_stubs_locked.ml

@@ -0,0 +1,11 @@
+open Ctypes
+
+module Def (F : Cstubs.FOREIGN) = struct
+  open F
+
+  let memcpy =
+    foreign "memcpy" (ocaml_bytes @-> ptr char @-> int @-> returning void)
+
+  let memcpy_str =
+    foreign "memcpy" (ptr char @-> ocaml_string @-> int @-> returning void)
+end

src/stubs/srt_stubs.ml

@@ -5,7 +5,6 @@ type socket = int
 
 let const_string = typedef (ptr char) "const char*"
 let const_sockaddr = typedef (ptr sockaddr_t) "const struct sockaddr*"
-let signed_ocaml_bytes = typedef ocaml_bytes "char*"
 
 module ListenCallback =
   (val Foreign.dynamic_funptr ~thread_registration:true ~runtime_lock:true
@@ -49,12 +48,10 @@ module Def (F : Cstubs.FOREIGN) = struct
      @-> returning int)
 
   let send = foreign "srt_send" (int @-> string @-> int @-> returning int)
-
-  let recv =
-    foreign "srt_recv" (int @-> signed_ocaml_bytes @-> int @-> returning int)
+  let recv = foreign "srt_recv" (int @-> ptr char @-> int @-> returning int)
 
   let recvmsg =
-    foreign "srt_recvmsg" (int @-> signed_ocaml_bytes @-> int @-> returning int)
+    foreign "srt_recvmsg" (int @-> ptr char @-> int @-> returning int)
 
   let sendmsg =
     foreign "srt_sendmsg"
@@ -64,10 +61,6 @@ module Def (F : Cstubs.FOREIGN) = struct
     foreign "srt_setsockflag"
       (int @-> socket_opt @-> ptr void @-> int @-> returning int)
 
-  let setsockflag_str =
-    foreign "srt_setsockflag"
-      (int @-> socket_opt @-> ocaml_string @-> int @-> returning int)
-
   let getsockflag =
     foreign "srt_getsockflag"
       (int @-> socket_opt @-> ptr void @-> ptr int @-> returning int)