unikernel/duniverse/dune_/otherlibs/xdg/dune

@@ -0,0 +1,17 @@
+(rule
+ (with-stdout-to
+  c_library_flags.sexp
+  (run gen_flags/gen_flags.exe %{os_type})))
+
+(library
+ (name xdg)
+ (public_name xdg)
+ (c_library_flags
+  (:include c_library_flags.sexp))
+ (foreign_stubs
+  (language c)
+  (names xdg_stubs))
+ (synopsis "[Internal] XDG base directories specification implementation"))
+
+(documentation
+ (package xdg))

unikernel/duniverse/dune_/otherlibs/xdg/gen_flags/dune

@@ -0,0 +1,2 @@
+(executable
+ (name gen_flags))

unikernel/duniverse/dune_/otherlibs/xdg/gen_flags/gen_flags.ml

@@ -0,0 +1,5 @@
+let () =
+  match Sys.argv.(1) with
+  | "Win32" -> print_endline "(-lshell32 -lole32 -luuid)"
+  | _ -> print_endline "()"
+;;

unikernel/duniverse/dune_/otherlibs/xdg/index.mld

@@ -0,0 +1,29 @@
+{1 xdg - the XDG base directories specification}
+
+{2 Introduction}
+
+Where should your application put its files? Somewhere in [$HOME]? Do non-Unix
+systems have something like that? What about cache files?
+
+Fortunately, there is a standard for this -
+{{:https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html}
+the XDG base directories specification}.
+
+This library implements this standard and extends it in a way that works on
+Windows too.
+
+{2 Example}
+
+This computes the name of a config file for a program named [acme].
+
+{[
+  let config_file_path =
+    let xdg = Xdg.create ~env:Sys.getenv_opt () in
+    let config_dir = Xdg.config_dir xdg in
+    Filename.concat config_dir "acme"
+]}
+
+{2 API documentation}
+
+The entry point for this library is {!Xdg}.
+

unikernel/duniverse/dune_/otherlibs/xdg/xdg.ml

@@ -0,0 +1,94 @@
+type t =
+  { env : string -> string option
+  ; win32 : bool
+  ; home_dir : string
+  ; mutable cache_dir : string
+  ; mutable config_dir : string
+  ; mutable data_dir : string
+  ; mutable state_dir : string
+  ; mutable runtime_dir : string option
+  }
+
+let ( / ) = Filename.concat
+
+type known_folder =
+  | InternetCache
+  | LocalAppData
+
+external get_known_folder_path
+  :  known_folder
+  -> string option
+  = "dune_xdg__get_known_folder_path"
+
+let make t env_var unix_default win32_folder =
+  let default =
+    if t.win32
+    then (
+      match get_known_folder_path win32_folder with
+      | None -> ""
+      | Some s -> s)
+    else unix_default
+  in
+  match t.env env_var with
+  | None -> default
+  | Some s when Filename.is_relative s -> default
+  | Some s -> s
+;;
+
+let cache_dir t =
+  let home = t.home_dir in
+  make t "XDG_CACHE_HOME" (home / ".cache") InternetCache
+;;
+
+let config_dir t =
+  let home = t.home_dir in
+  make t "XDG_CONFIG_HOME" (home / ".config") LocalAppData
+;;
+
+let data_dir t =
+  let home = t.home_dir in
+  make t "XDG_DATA_HOME" (home / ".local" / "share") LocalAppData
+;;
+
+let state_dir t =
+  let home = t.home_dir in
+  make t "XDG_STATE_HOME" (home / ".local" / "state") LocalAppData
+;;
+
+let create ?win32 ~env () =
+  let win32 =
+    match win32 with
+    | None -> Sys.win32
+    | Some s -> s
+  in
+  let home_dir =
+    let var = if win32 then "USERPROFILE" else "HOME" in
+    match env var with
+    | None -> ""
+    | Some s -> s
+  in
+  let t =
+    { env
+    ; win32
+    ; home_dir
+    ; cache_dir = ""
+    ; config_dir = ""
+    ; data_dir = ""
+    ; state_dir = ""
+    ; runtime_dir = None
+    }
+  in
+  t.cache_dir <- cache_dir t;
+  t.config_dir <- config_dir t;
+  t.data_dir <- data_dir t;
+  t.state_dir <- state_dir t;
+  t.runtime_dir <- env "XDG_RUNTIME_DIR";
+  t
+;;
+
+let home_dir t = t.home_dir
+let config_dir t = t.config_dir
+let data_dir t = t.data_dir
+let cache_dir t = t.cache_dir
+let state_dir t = t.state_dir
+let runtime_dir t = t.runtime_dir

unikernel/duniverse/dune_/otherlibs/xdg/xdg.mli

@@ -0,0 +1,26 @@
+(** Base directories. Values of type {!t} are created using {!create}. *)
+type t
+
+(** The user's home directory. Uses [$USERPROFILE] on Windows, [$HOME]
+    otherwise. *)
+val home_dir : t -> string
+
+(** The directory where the application should read/write config files. *)
+val config_dir : t -> string
+
+(** The directory where the application should read/write data files. *)
+val data_dir : t -> string
+
+(** The directory where the application should read/write cached files. *)
+val cache_dir : t -> string
+
+(** The directory where the application should read/write state files. *)
+val state_dir : t -> string
+
+(** The directory where the application should store socket files. *)
+val runtime_dir : t -> string option
+
+(** Constructor of type {!t}. [~win32] (default: {!Sys.win32}) determines
+    whether to use Win32-specific APIs. [~env] is the function to get
+    environment variables, typically {!Sys.getenv_opt}. *)
+val create : ?win32:bool -> env:(string -> string option) -> unit -> t

unikernel/duniverse/dune_/otherlibs/xdg/xdg_stubs.c

@@ -0,0 +1,71 @@
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+
+#ifdef _WIN32
+
+/*  Windows Vista functions enabled */
+
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
+
+#include <windows.h>
+#include <knownfolders.h>
+#include <shlobj.h>
+
+value dune_xdg__get_known_folder_path(value v_known_folder)
+{
+  CAMLparam1(v_known_folder);
+  CAMLlocal2(v_res, v_path);
+  WCHAR* wcp = NULL;
+  HRESULT res;
+  int wlen, len;
+  const KNOWNFOLDERID *rfid;
+
+  v_res = Val_int(0);
+
+  switch (Int_val(v_known_folder)) {
+    case 0:
+      rfid = &FOLDERID_InternetCache;
+      break;
+    case 1:
+      rfid = &FOLDERID_LocalAppData;
+      break;
+    default:
+      caml_invalid_argument("get_known_folder_path");
+      break;
+  }
+
+  res = SHGetKnownFolderPath(rfid, 0, NULL, &wcp);
+
+  if (res != S_OK)
+    goto done;
+
+  wlen = wcslen(wcp);
+  len = WideCharToMultiByte(CP_UTF8, WC_ERR_INVALID_CHARS, wcp, wlen, NULL, 0, NULL, NULL);
+
+  if (!len)
+    goto done;
+
+  v_path = caml_alloc_string(len);
+
+  if (!WideCharToMultiByte(CP_UTF8, WC_ERR_INVALID_CHARS, wcp, wlen, (char *)String_val(v_path), len, NULL, NULL))
+    goto done;
+
+  v_res = caml_alloc_small(1, 0);
+  Field(v_res, 0) = v_path;
+
+ done:
+  CoTaskMemFree(wcp);
+  CAMLreturn(v_res);
+}
+
+#else /* _WIN32 */
+
+value dune_xdg__get_known_folder_path(value v_unit) {
+  (void)v_unit;
+  caml_invalid_argument("get_known_folder_path: not implemented");
+}
+
+#endif /* _WIN32 */