add wrappers for uv_[sg]et_process_title and uv_cwd

src/macros.h

@@ -321,3 +321,24 @@ strdup (const char *s)
   return n;
 }
 #endif
+
+#ifndef _WIN32
+#define ALLOC_PATH_LEN_MAX 131072
+#define ALLOC_PATH_LEN_MIN  16384
+
+#if defined(PATH_MAX) && PATH_MAX > 0 && ALLOC_PATH_LEN_MIN < PATH_MAX
+#define ALLOCA_PATH_LEN \
+  ((size_t)(UMIN_M(ALLOC_PATH_LEN_MAX,(UMAX_M(PATH_MAX + 1,ALLOCA_SIZE)))))
+#elif defined(MAXPATHLEN) && MAXPATHLEN > 0 && ALLOC_PATH_LEN_MIN < MAXPATHLEN
+#define ALLOCA_PATH_LEN \
+  ((size_t)(UMIN_M(ALLOC_PATH_LEN_MAX,UMAX_M(MAXPATHLEN + 1,ALLOCA_SIZE))))
+#elif defined(NAME_MAX) && NAME_MAX > 0 && ALLOC_PATH_LEN_MIN < NAME_MAX
+#define ALLOCA_PATH_LEN \
+  ((size_t)(UMIN_M(ALLOC_PATH_LEN_MAX,UMAX_M(NAME_MAX + 1,ALLOCA_SIZE))))
+#else
+#define ALLOCA_PATH_LEN ALLOC_PATH_LEN_MIN
+#endif
+
+#else /* ifndef _WIN32 */
+#define ALLOCA_PATH_LEN ((size_t)(UMAX_M(32767 + 17,MAX_PATH + 17)))
+#endif

src/uwt_base.ml

@@ -428,6 +428,15 @@ module Misc = struct
   external exepath: unit -> string uv_result = "uwt_exepath"
   external os_tmpdir: unit -> string uv_result = "uwt_os_tmpdir"
   external get_passwd: unit -> Unix.passwd_entry uv_result = "uwt_get_passwd"
+
+  external cwd: unit -> string uv_result = "uwt_cwd"
+  external get_process_title:
+    string array -> string uv_result = "uwt_get_process_title"
+  let get_process_title () = get_process_title Sys.argv
+  external set_process_title:
+    string array -> string -> Int_result.unit = "uwt_set_process_title_na" "noalloc"
+  let set_process_title s = set_process_title Sys.argv s
+
 end
 
 module Sys_info = struct

src/uwt_base.mli

@@ -546,6 +546,14 @@ module Misc : sig
   (** like Sys.executable_name , but utf-8 encoded under windows
       and perhaps more reliable under niche operating systems *)
   val exepath: unit -> string uv_result
+
+  val cwd: unit -> string uv_result
+
+  (** The following two functions don't work reliable,
+      especially with byte code. And set_process_title won't
+      necessary report an error, if it fails ... *)
+  val set_process_title: string -> Int_result.unit
+  val get_process_title: unit -> string uv_result
 end
 
 module Sys_info : sig

src/uwt_stubs.c

@@ -5163,20 +5163,18 @@ uwt_hrtime(value unit)
   return (caml_copy_int64(uv_hrtime()));
 }
 
-#if HAVE_DECL_UV_OS_HOMEDIR || HAVE_DECL_UV_OS_TMPDIR
 typedef int(*os_dir)(char *, size_t *);
 static value
 uwt_os_dir(os_dir fdir_func)
 {
   CAMLparam0();
   CAMLlocal1(p);
-#define BSIZE 16384
   value ret;
-  char buffer[BSIZE];
-  size_t size = BSIZE;
+  char buffer[ALLOCA_PATH_LEN];
+  size_t size = ALLOCA_PATH_LEN;
   int tag;
   const int r = fdir_func(buffer,&size);
-  if ( r == 0 && size > 0 && size <= BSIZE ){
+  if ( r == 0 && size > 0 && size <= ALLOCA_PATH_LEN ){
     p = caml_alloc_string(size);
     memcpy(String_val(p), buffer, size);
     tag = Ok_tag;
@@ -5188,10 +5186,21 @@ uwt_os_dir(os_dir fdir_func)
   ret = caml_alloc_small(1,tag);
   Field(ret,0) = p;
   CAMLreturn(ret);
-#undef BSIZE
 }
-#endif
 
+CAMLprim value
+uwt_exepath(value unit)
+{
+  (void)unit;
+  return (uwt_os_dir(uv_exepath));
+}
+
+CAMLprim value
+uwt_cwd(value unit)
+{
+  (void)unit;
+  return (uwt_os_dir(uv_cwd));
+}
 
 CAMLprim value
 uwt_os_homedir(value unit)
@@ -5286,24 +5295,85 @@ uwt_get_passwd(value unit)
 #endif
 }
 
+static char ** uv_setup_args_ret = NULL;
+static char ** dummy_argv = NULL;
+
+static int
+uwt_setup_args(value sys_argv)
+{
+  if ( sys_argv == Atom(0) || Wosize_val(sys_argv) == 0 ){
+    uv_setup_args_ret = NULL;
+    return 0;
+  }
+  else {
+    const int argc = Wosize_val(sys_argv);
+    int size = 0;
+    char ** argv;
+    char *p;
+    char * memb;
+    int i;
+
+    argv = malloc( (argc+1) * sizeof (char**) );
+    if ( argv == NULL ) {
+      return UV_ENOMEM;
+    }
+
+    for ( i = 0; i < argc; i++ ) {
+      value s = Field(sys_argv,i);
+      if ( !uwt_is_safe_string(s) ){
+        return UV_ECHARSET;
+      }
+      size += strlen(String_val(s)) + 1;
+    }
+
+    memb = malloc(size);
+    if ( memb == NULL ){
+      free(argv);
+      return UV_ENOMEM;
+    }
+
+    /* libuv want the argv arguments in this order in memory.
+       Otherwise an assert failure is triggered,.... */
+    p = memb;
+    for ( i = 0; i < argc ; i++ ) {
+      size_t n = strlen(String_val(Field(sys_argv,i)));
+      argv[i] = p;
+      memcpy(p,String_val(Field(sys_argv,i)),n + 1);
+      p = p + n + 1;
+    }
+    argv[argc] = NULL;
+
+    uv_setup_args_ret = uv_setup_args(argc,argv);
+    dummy_argv = argv;
+
+    return 0;
+  }
+}
+
 CAMLprim value
-uwt_exepath(value unit)
+uwt_get_process_title(value sys_argv)
 {
-#define BSIZE 8192
   CAMLparam0();
   CAMLlocal1(p);
+#define BSIZE 16384
   value ret;
   char buffer[BSIZE];
-  size_t size = BSIZE;
   int tag;
-  (void)unit;
-  const int r = uv_exepath(buffer,&size);
-  if ( r == 0 && size > 0 && size <= BSIZE ){
-    p = caml_alloc_string(size);
-    memcpy(String_val(p), buffer, size);
+  int r;
+  if ( uv_setup_args_ret == NULL ){
+    r = uwt_setup_args(sys_argv);
+    if ( r ){
+      goto error_end;
+    }
+  }
+  r = uv_get_process_title(buffer,BSIZE - 1);
+  if ( r == 0 ){
+    buffer[BSIZE-1] = '\0';
+    p = caml_copy_string(buffer);
     tag = Ok_tag;
   }
   else {
+  error_end:
     p = Val_uwt_error(r);
     tag = Error_tag;
   }
@@ -5313,6 +5383,24 @@ uwt_exepath(value unit)
 #undef BSIZE
 }
 
+CAMLprim value
+uwt_set_process_title_na(value sys_argv, value o_str)
+{
+  int r;
+  if ( !uwt_is_safe_string(o_str) ){
+    return VAL_UWT_INT_RESULT_ECHARSET;
+  }
+  if ( uv_setup_args_ret == NULL ){
+    r = uwt_setup_args(sys_argv);
+    if ( r ){
+      return (VAL_UWT_INT_RESULT(r));
+    }
+  }
+  r = uv_set_process_title(String_val(o_str));
+  return (VAL_UWT_INT_RESULT(r));
+}
+
+
 #ifdef _WIN32
 char *
 uwt_utf16_to_utf8(const WCHAR* utf16_buffer, int * error)

src/uwt_stubs.h

@@ -185,6 +185,9 @@ P1(uwt_os_homedir);
 P1(uwt_os_tmpdir);
 P1(uwt_get_passwd);
 P1(uwt_exepath);
+P1(uwt_cwd);
+P1(uwt_get_process_title);
+P2(uwt_set_process_title_na);
 
 P6(uwt_getaddrinfo_native);
 BY(uwt_getaddrinfo_byte);

src/uwt_stubs_unix.c

@@ -2053,27 +2053,6 @@ uwt_pipe(value o_close_exec)
 CAMLextern value uwt_realpath(value o_name, value o_uwt);
 CAMLextern value uwt_realpath_sync(value o_name);
 
-#define ALLOC_PATH_LEN_MAX 131072
-
-#ifndef _WIN32
-
-#if defined(PATH_MAX) && PATH_MAX > 0
-#define ALLOCA_PATH_LEN \
-  ((size_t)(UMIN_M(ALLOC_PATH_LEN_MAX,(UMAX_M(PATH_MAX + 1,ALLOCA_SIZE)))))
-#elif defined(MAXPATHLEN) && MAXPATHLEN > 0
-#define ALLOCA_PATH_LEN \
-  ((size_t)(UMIN_M(ALLOC_PATH_LEN_MAX,UMAX_M(MAXPATHLEN + 1,ALLOCA_SIZE))))
-#elif defined(NAME_MAX) && NAME_MAX > 0
-#define ALLOCA_PATH_LEN \
-  ((size_t)(UMIN_M(ALLOC_PATH_LEN_MAX,UMAX_M(NAME_MAX + 1,ALLOCA_SIZE))))
-#else
-#define ALLOCA_PATH_LEN ALLOCA_SIZE
-#endif
-
-#else /* ifndef _WIN32 */
-#define ALLOCA_PATH_LEN ((size_t)(UMAX_M(32767 + 17,MAX_PATH + 17)))
-#endif
-
 #ifdef _WIN32
 #define BSIZE ALLOCA_PATH_LEN
 static void

test/t_misc.ml

@@ -134,6 +134,14 @@ let l = [
           let slen = D.show_win_version x |> String.length in
           let open Uwt_base.Sys_info in
           assert_equal true ( slen > 30 && x.major_version >= 5 ));
+  ("cwd">:: fun _ -> assert_equal (Ok (Sys.getcwd ())) (cwd ()));
+  ("process_title">:: fun ctx ->
+      is_contingent ctx;
+      let pt = "uwt test" in
+      let p = set_process_title pt in
+      assert_equal (p :> int) 0;
+      let pt' = get_process_title () in
+      assert_equal (Ok pt) pt' );
 ]
 
 let l = "Misc">:::l