Use a C stub to call the uname function from the C standard library i…

…nstead of calling the uname POSIX command

master_changes.md

@@ -100,6 +100,9 @@ users)
 
 ## Internal
 
+## Internal: Unix
+  * Use a C stub to call the `uname` function from the C standard library instead of calling the `uname` POSIX command [#6217 @kit-ty-kate]
+
 ## Internal: Windows
 
 ## Test
@@ -132,6 +135,9 @@ users)
 
 ## opam-core
   * `OpamStd.Sys.{get_terminal_columns,uname,getconf,guess_shell_compat}`: Harden the process calls to account for failures [#6230 @kit-ty-kate - fix #6215]
-  * `OpamStd.Sys.{uname,getconf}`: now accepts only one argument as parameter, as per their documentation [#6230 @kit-ty-kate]
+  * `OpamStd.Sys.getconf`: was removed, replaced by `get_long_bit` [#6217 @kit-ty-kate]
+  * `OpamStd.Sys.get_long_bit`: was added, which returns the output of the `getconf LONG_BIT` command [#6217 @kit-ty-kate]
+  * `OpamStd.Sys.uname`: now returns the memoized result of the `uname` function from the C standard library [#6217 @kit-ty-kate]
+  * `OpamStd.Sys.get_freebsd_version`: was added, which returns the output of the `uname -U` command [#6217 @kit-ty-kate]
   * `OpamStubs.get_stdout_ws_col`: new Unix-only function returning the number of columns of the current terminal window [#6244 @kit-ty-kate]
   * `OpamSystem`: add `is_archive_from_string` that does the same than `is_archive` but without looking at the file, only analysing the string (extension) [#6219 @rjbou]

src/core/opamCommonStubs.c

@@ -37,6 +37,7 @@
 
 #if OCAML_VERSION < 50000
 #define caml_unix_access unix_access
+#define caml_uerror uerror
 #endif
 
 CAMLprim value opam_is_executable(value path)

src/core/opamStd.ml

@@ -991,20 +991,17 @@ module OpamSys = struct
 
   let etc () = "/etc"
 
-  let memo_command =
-    let memo = Hashtbl.create 7 in
-    fun cmd arg ->
-      try Hashtbl.find memo (cmd, arg) with Not_found ->
-        let r =
-          match process_in cmd [arg] with
-          | None -> None
-          | Some x -> Some (OpamString.strip x)
-        in
-        Hashtbl.add memo (cmd, arg) r;
-        r
-
-  let uname = memo_command "uname"
-  let getconf = memo_command "getconf"
+  let uname =
+    let uname = lazy (OpamStubs.uname ()) in
+    fun () ->
+      Lazy.force uname
+
+  (* We need to call [uname] here as the only way to get it
+     in C without calling a process or lookup files is to
+     use [__Freebsd_version] which is a define, so it is set
+     at compile time. *)
+  let get_freebsd_version () = process_in "uname" ["-U"]
+  let get_long_bit () = process_in "getconf" ["LONG_BIT"]
 
   let system =
     let system = Lazy.from_fun OpamStubs.getPathToSystem in
@@ -1026,14 +1023,14 @@ module OpamSys = struct
     let os = lazy (
       match Sys.os_type with
       | "Unix" -> begin
-          match uname "-s" with
-          | Some "Darwin"    -> Darwin
-          | Some "Linux"     -> Linux
-          | Some "FreeBSD"   -> FreeBSD
-          | Some "OpenBSD"   -> OpenBSD
-          | Some "NetBSD"    -> NetBSD
-          | Some "DragonFly" -> DragonFly
-          | _                -> Unix
+          match (uname ()).sysname with
+          | "Darwin"    -> Darwin
+          | "Linux"     -> Linux
+          | "FreeBSD"   -> FreeBSD
+          | "OpenBSD"   -> OpenBSD
+          | "NetBSD"    -> NetBSD
+          | "DragonFly" -> DragonFly
+          | _           -> Unix
         end
       | "Win32"  -> Win32
       | "Cygwin" -> Cygwin

src/core/opamStd.mli

@@ -510,11 +510,15 @@ module Sys : sig
   (** Queried lazily *)
   val os: unit -> os
 
-  (** The output of the command "uname", with the given argument. Memoised. *)
-  val uname: string -> string option
+  (** The output of the command "uname -U". FreeBSD only. Reasoning:
+      https://github.com/ocaml/opam/pull/4274#issuecomment-659280485 *)
+  val get_freebsd_version: unit -> string option
 
-  (** The output of the command "getconf", with the given argument. Memoised. *)
-  val getconf: string -> string option
+  (** The output of the command "getconf LONG_BIT". *)
+  val get_long_bit: unit -> string option
+
+  (** The memoized result of the uname function from the C standard library *)
+  val uname : unit -> OpamStubs.uname
 
   (** Append .exe (only if missing) to executable filenames on Windows *)
   val executable_name : string -> string

src/core/opamStubs.mli

@@ -171,3 +171,14 @@ val get_stdout_ws_col : unit -> int
     linked with stdout. If stdout isn't linked to any terminal
     (e.g. redirection), then this function will return 0. A valid number
     of columns should be strictly above 0. *)
+
+type uname = {
+  sysname : string; (** uname -s *)
+  release : string; (** uname -r *)
+  machine : string; (** uname -m *)
+}
+(** A subset of the [struct utsname] C structure, as modified by uname(2),
+    converted to OCaml datatypes. *)
+
+val uname : unit -> uname
+(** Unix only. Returns info from uname(2) *)

src/core/opamStubs.unix.ml

@@ -48,3 +48,4 @@ let getVersionInfo = that's_a_no_no
 let get_initial_environment = that's_a_no_no
 
 external get_stdout_ws_col : unit -> int = "opam_stdout_ws_col"
+external uname : unit -> uname = "opam_uname"

src/core/opamStubsTypes.ml

@@ -114,6 +114,12 @@ type win32_version_info = {
     (** Non-fixed string table. First field is a pair of Language and Codepage ID. *)
 }
 
+type uname = {
+  sysname : string;
+  release : string;
+  machine : string;
+}
+
 external is_executable : string -> bool = "opam_is_executable"
 (** faccessat on Unix; _waccess on Windows. Checks whether a path is executable
     for the current process. On Unix, unlike Unix.access, this is checked using

src/core/opamUnix.c

@@ -18,3 +18,20 @@ CAMLprim value opam_stdout_ws_col(value _unit) {
     }
     return Val_int(win.ws_col);
 }
+
+#include <sys/utsname.h>
+
+CAMLprim value opam_uname(value _unit) {
+  struct utsname buf;
+  value ret;
+
+  if (-1 == uname(&buf)) {
+    caml_uerror("uname", Nothing);
+  }
+  ret = caml_alloc(3, 0);
+  Store_field(ret, 0, caml_copy_string(buf.sysname));
+  Store_field(ret, 1, caml_copy_string(buf.release));
+  Store_field(ret, 2, caml_copy_string(buf.machine));
+
+  return ret;
+}

src/core/opamWin32Stubs.win32.ml

@@ -51,3 +51,4 @@ external get_initial_environment : unit -> string list = "OPAMW_CreateEnvironmen
 let that's_a_no_no _ = failwith "Unix only. This function isn't implemented."
 
 let get_stdout_ws_col = that's_a_no_no
+let uname = that's_a_no_no

src/state/opamSysPoll.ml

@@ -35,7 +35,7 @@ let normalise_arch raw =
 
 let poll_arch () =
   let raw = match Sys.os_type with
-    | "Unix" | "Cygwin" -> OpamStd.Sys.uname "-m"
+    | "Unix" | "Cygwin" -> Some (OpamStd.Sys.uname ()).machine
     | "Win32" ->
       begin match OpamStubs.getArchitecture () with
       | OpamStubs.AMD64 -> Some "x86_64"
@@ -56,7 +56,7 @@ let poll_arch () =
   | "Unix" | "Cygwin" ->
     (match normalised with
      | Some ("x86_64" | "arm64" | "ppc64" as arch) ->
-       (match OpamStd.Sys.getconf "LONG_BIT", arch with
+       (match OpamStd.Sys.get_long_bit (), arch with
         | Some "32", "x86_64" -> Some "x86_32"
         | Some "32", "arm64" -> Some "arm32"
         | Some "32", "ppc64" -> Some "ppc32"
@@ -74,7 +74,7 @@ let normalise_os raw =
 let poll_os () =
   let raw =
     match Sys.os_type with
-    | "Unix" -> OpamStd.Sys.uname "-s"
+    | "Unix" -> Some (OpamStd.Sys.uname ()).sysname
     | s -> norm s
   in
   match raw with
@@ -130,7 +130,7 @@ let poll_os_distribution () =
   | Some "win32" ->
     let kind =
       OpamStd.Sys.get_windows_executable_variant
-        ?search_in_first:(OpamCoreConfig.(!r.cygbin)) "cygpath.exe" 
+        ?search_in_first:(OpamCoreConfig.(!r.cygbin)) "cygpath.exe"
     in
     begin match kind with
     | `Msys2 -> Some "msys2"
@@ -158,9 +158,9 @@ let poll_os_version () =
        Scanf.sscanf s "%_s@[ Version %s@]" norm
      with Scanf.Scan_failure _ | End_of_file -> None)
   | Some "freebsd" ->
-    OpamStd.Sys.uname "-U" >>= norm
+    OpamStd.Sys.get_freebsd_version () >>= norm
   | _ ->
-    OpamStd.Sys.uname "-r" >>= norm
+    norm (OpamStd.Sys.uname ()).release
 let os_version = Lazy.from_fun poll_os_version
 
 let poll_os_family () =