opam_analyse.ml

(**************************************************************************)
(*                                                                        *)
(*    Copyright 2017 OCamlPro                                             *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

(* This file contains a prototype implementation of
   https://github.com/ocaml/opam/issues/3058, to help testing on different
   systems. The intent is to integrate the results as opam variables that will
   be used, typically, to select external dependencies.

   This code is partially from
   [opam-depext](https://github.com/ocaml/opam-depext), but this provides more
   variables and differs in several aspects. This is for experimentation.

   Run with 'ocaml unix.cma THIS_FILE [-d]'
*)

let version = 4
let debug = Array.length Sys.argv > 1 && Sys.argv.(1) = "-d"

let lines_of_channel ic =
  let rec aux acc =
    let line = try Some (input_line ic) with End_of_file -> None in
    match line with
    | Some s -> aux (s::acc)
    | None -> acc
  in
  List.rev (aux [])

let lines_of_command c =
  if debug then Printf.eprintf "+ %s\n%!" c;
  let ic = Unix.open_process_in c in
  let lines = lines_of_channel ic in
  match Unix.close_process_in ic with
  | Unix.WEXITED 0 -> lines
  | Unix.WEXITED 127 ->
    Printf.ksprintf failwith "Command not found: %s" c
  | Unix.WEXITED i ->
    Printf.ksprintf failwith "Command failed: %s returned %d" c i
  | Unix.WSIGNALED i ->
    Printf.ksprintf failwith "Command failed: %s signal %d" c i
  | Unix.WSTOPPED i ->
    Printf.ksprintf failwith "Command failed: %s stopped %d" c i

let lines_of_file f =
  let ic = open_in f in
  let lines = lines_of_channel ic in
  close_in ic;
  lines

let has_command c =
  let cmd = Printf.sprintf "command -v %s >/dev/null" c in
  try Sys.command cmd = 0 with Sys_error _ -> false

let command_output c =
  match List.filter (fun s -> String.trim s <> "") (lines_of_command c) with
  | [s] -> s
  | _ -> Printf.ksprintf failwith "Output of command too long: %S" c

let has_prefix s pfx =
  let pfxlen = String.length pfx in
  pfxlen <= String.length s &&
  try for i = 0 to pfxlen do
      if pfx.[i] <> s.[i] then raise Exit
    done;
    true
  with Exit -> false

let arch =
  let raw = match Sys.os_type with
    | "Unix" | "Cygwin" -> command_output "uname -m"
    | "Win32" ->
      (match Sys.getenv "PROCESSOR_ARCHITECTURE" with
       | "X86" as a ->
         (try Sys.getenv "PROCESSOR_ARCHITEW6432" with Not_found -> a)
       | arch -> arch)
    | _ -> failwith "Bad Sys.os_type"
  in
  match String.lowercase_ascii raw with
  | "x86" | "i386" | "i586" | "i686" -> "x86_32"
  | "x86_64" | "amd64" -> "x86_64"
  | "powerpc" | "ppc" | "ppcle" -> "ppc32"
  | "ppc64" | "ppc64le" -> "ppc64"
  | "aarch64_be" | "aarch64" | "armv8b" | "armv8l" -> "arm64"
  | a when List.exists (has_prefix a)
        ["armv5"; "armv6"; "earmv6"; "armv7"; "earmv7"] -> "arm32"
  | s -> s

let os =
  match Sys.os_type with
  | "Unix" -> (match String.lowercase_ascii (command_output "uname -s") with
      | "darwin" -> "macos"
      | s -> s)
  | s -> String.lowercase_ascii s

let os_release_field: string -> string =
  let os_release_file = lazy (
    List.find Sys.file_exists ["/etc/os-release"; "/usr/lib/os-release"] |>
    lines_of_file |>
    List.map (fun s -> Scanf.sscanf s "%s@= %s" (fun x v ->
        x,
        try Scanf.sscanf v "\"%s@\"" (fun s -> s)
        with Scanf.Scan_failure _ -> v))
  ) in
  fun f ->
    List.assoc f (Lazy.force os_release_file)

let is_android, android_release =
  let prop = lazy (
    command_output "getprop ro.build.version.release 2>/dev/null"
  ) in
  (fun () -> try ignore (Lazy.force prop); true with Failure _ -> false),
  (fun () -> Lazy.force prop)

let distribution =
  match os with
  | "macos" ->
    if has_command "brew" then "homebrew"
    else if has_command "port" then "macports"
    else os
  | "linux" ->
    (String.lowercase_ascii @@
     if is_android () then "android" else
     try os_release_field "ID" with Not_found ->
     try command_output "lsb_release -i -s 2>/dev/null" with Failure _ ->
     try
       List.find Sys.file_exists ["/etc/redhat-release";
                                  "/etc/centos-release";
                                  "/etc/gentoo-release";
                                  "/etc/issue"] |>
       fun s -> Scanf.sscanf s " %s " (fun s -> s)
     with Not_found -> os)
  | _ -> os

let os_version =
  match os with
  | "linux" ->
    (String.lowercase_ascii @@
     try android_release () with Failure _ ->
     try command_output "lsb_release -s -r" with Failure _ ->
     try os_release_field "VERSION_ID" with Not_found ->
       "#undefined")
  | "macos" ->
    (String.lowercase_ascii @@
     try command_output "sw_vers -productVersion" with Failure _ ->
       "#undefined")
  | "win32" | "cygwin" ->
    (try
       let s = command_output "cmd /C ver" in
       Scanf.sscanf s "%_s@[ Version %s@]" String.lowercase_ascii
     with Failure _ | Scanf.Scan_failure _ -> "#undefined")
  | "freebsd" ->
    (String.lowercase_ascii @@
     try command_output "uname -U" with Failure _ -> "#undefined")
  | _ ->
    (String.lowercase_ascii @@
     try command_output "uname -r" with Failure _ -> "#undefined")

let family =
  match os with
  | "linux" ->
    (try
       Scanf.sscanf (os_release_field "ID_LIKE")
         "%s" String.lowercase_ascii (* first word *)
     with Not_found -> distribution)
  | "freebsd" | "openbsd" | "netbsd" | "dragonfly" -> "bsd"
  | "win32" | "cygwin" -> "windows"
  | _ -> os

let () =
  Printf.printf "    # opam-analyse v.%d\n" version;
  Printf.printf "    arch:            %s\n" arch;
  Printf.printf "    os:              %s\n" os;
  Printf.printf "    os-distribution: %s\n" distribution;
  Printf.printf "    os-version:      %s\n" os_version;
  Printf.printf "    os-family:       %s\n" family