···
+
type source = Default | Env of string | Cmdline
+
config_dir : Eio.Fs.dir_ty Eio.Path.t;
+
config_dir_source : source;
+
data_dir : Eio.Fs.dir_ty Eio.Path.t;
+
data_dir_source : source;
+
cache_dir : Eio.Fs.dir_ty Eio.Path.t;
+
cache_dir_source : source;
+
state_dir : Eio.Fs.dir_ty Eio.Path.t;
+
state_dir_source : source;
+
runtime_dir : Eio.Fs.dir_ty Eio.Path.t option;
+
runtime_dir_source : source;
+
config_dirs : Eio.Fs.dir_ty Eio.Path.t list;
+
data_dirs : Eio.Fs.dir_ty Eio.Path.t list;
+
let ensure_dir ?(perm = 0o755) path = Eio.Path.mkdirs ~exists_ok:true ~perm path
+
let validate_runtime_base_dir base_path =
+
(* Validate the base XDG_RUNTIME_DIR has correct permissions per spec *)
+
let path_str = Eio.Path.native_exn base_path in
+
let stat = Eio.Path.stat ~follow:true base_path in
+
let current_perm = stat.perm land 0o777 in
+
if current_perm <> 0o700 then
+
"XDG_RUNTIME_DIR base directory %s has incorrect permissions: %o \
+
path_str current_perm);
+
(* Check ownership - directory should be owned by current user *)
+
let uid = Unix.getuid () in
+
if stat.uid <> Int64.of_int uid then
+
"XDG_RUNTIME_DIR base directory %s not owned by current user (uid \
+
(* TODO: Check that directory is on local filesystem (not networked).
+
This would require filesystem type detection which is OS-specific. *)
+
(Printf.sprintf "Cannot validate XDG_RUNTIME_DIR: %s"
+
(Printexc.to_string exn))
+
let ensure_runtime_dir _fs app_runtime_path =
+
(* Base directory validation is done in resolve_runtime_dir,
+
so we just create the app subdirectory *)
+
ensure_dir app_runtime_path
+
match Sys.getenv_opt "HOME" with
+
| "Win32" | "Cygwin" -> (
+
match Sys.getenv_opt "USERPROFILE" with
+
| Some profile -> profile
+
| None -> failwith "Cannot determine home directory")
+
try Unix.((getpwuid (getuid ())).pw_dir)
+
with _ -> failwith "Cannot determine home directory"))
+
Eio.Path.(fs / home_str)
+
let make_env_var_name app_name suffix =
+
String.uppercase_ascii app_name ^ "_" ^ suffix
+
exception Invalid_xdg_path of string
+
let validate_absolute_path context path =
+
if Filename.is_relative path then
+
(Printf.sprintf "%s must be an absolute path, got: %s" context path))
+
let resolve_path fs home_path base_path =
+
if Filename.is_relative base_path then Eio.Path.(home_path / base_path)
+
else Eio.Path.(fs / base_path)
+
(* Helper to resolve system directories (config_dirs or data_dirs) *)
+
let resolve_system_dirs fs home_path app_name override_suffix xdg_var
+
let override_var = make_env_var_name app_name override_suffix in
+
match Sys.getenv_opt override_var with
+
| Some dirs when dirs <> "" ->
+
String.split_on_char ':' dirs
+
|> List.filter (fun s -> s <> "")
+
|> List.filter_map (fun path ->
+
validate_absolute_path override_var path;
+
Some Eio.Path.(resolve_path fs home_path path / app_name)
+
with Invalid_xdg_path _ -> None)
+
match Sys.getenv_opt xdg_var with
+
| Some dirs when dirs <> "" ->
+
String.split_on_char ':' dirs
+
|> List.filter (fun s -> s <> "")
+
|> List.filter_map (fun path ->
+
validate_absolute_path xdg_var path;
+
Some Eio.Path.(resolve_path fs home_path path / app_name)
+
with Invalid_xdg_path _ -> None)
+
(fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
+
(* Helper to resolve a user directory with override precedence *)
+
let resolve_user_dir fs home_path app_name xdg_ctx xdg_getter override_suffix =
+
let override_var = make_env_var_name app_name override_suffix in
+
match Sys.getenv_opt override_var with
+
| Some dir when dir <> "" ->
+
validate_absolute_path override_var dir;
+
(Eio.Path.(fs / dir / app_name), Env override_var)
+
let xdg_base = xdg_getter xdg_ctx in
+
let base_path = resolve_path fs home_path xdg_base in
+
(Eio.Path.(base_path / app_name), Default)
+
(* Helper to resolve runtime directory (special case since it can be None) *)
+
let resolve_runtime_dir fs home_path app_name xdg_ctx =
+
let override_var = make_env_var_name app_name "RUNTIME_DIR" in
+
match Sys.getenv_opt override_var with
+
| Some dir when dir <> "" ->
+
validate_absolute_path override_var dir;
+
(* Validate the base runtime directory has correct permissions *)
+
let base_runtime_dir = resolve_path fs home_path dir in
+
validate_runtime_base_dir base_runtime_dir;
+
(Some Eio.Path.(base_runtime_dir / app_name), Env override_var)
+
( (match Xdg.runtime_dir xdg_ctx with
+
(* Validate the base runtime directory has correct permissions *)
+
let base_runtime_dir = resolve_path fs home_path base in
+
validate_runtime_base_dir base_runtime_dir;
+
Some Eio.Path.(base_runtime_dir / app_name)
+
let validate_standard_xdg_vars () =
+
(* Validate standard XDG environment variables for absolute paths *)
+
match Sys.getenv_opt var with
+
| Some value when value <> "" ->
+
if String.contains value ':' then
+
(* Colon-separated list - validate each part *)
+
String.split_on_char ':' value
+
|> List.filter (fun s -> s <> "")
+
|> List.iter (fun path -> validate_absolute_path var path)
+
validate_absolute_path var value
+
let create fs app_name =
+
let home_path = get_home_dir fs in
+
(* First validate all standard XDG environment variables *)
+
validate_standard_xdg_vars ();
+
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
+
let config_dir, config_dir_source =
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.config_dir "CONFIG_DIR"
+
let data_dir, data_dir_source =
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.data_dir "DATA_DIR"
+
let cache_dir, cache_dir_source =
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.cache_dir "CACHE_DIR"
+
let state_dir, state_dir_source =
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.state_dir "STATE_DIR"
+
(* Runtime directory *)
+
let runtime_dir, runtime_dir_source =
+
resolve_runtime_dir fs home_path app_name xdg_ctx
+
(* System directories *)
+
resolve_system_dirs fs home_path app_name "CONFIG_DIRS" "XDG_CONFIG_DIRS"
+
resolve_system_dirs fs home_path app_name "DATA_DIRS" "XDG_DATA_DIRS"
+
[ "/usr/local/share"; "/usr/share" ]
+
Option.iter (ensure_runtime_dir fs) runtime_dir;
+
let app_name t = t.app_name
+
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
+
let config_dirs t = t.config_dirs
+
let data_dirs t = t.data_dirs
+
(* File search following XDG specification *)
+
let find_file_in_dirs dirs filename =
+
let rec search_dirs = function
+
| dir :: remaining_dirs -> (
+
let file_path = Eio.Path.(dir / filename) in
+
(* Try to check if file exists and is readable *)
+
let _ = Eio.Path.stat ~follow:true file_path in
+
(* File is inaccessible (non-existent, permissions, etc.)
+
Skip and continue with next directory per XDG spec *)
+
search_dirs remaining_dirs)
+
let find_config_file t filename =
+
(* Search user config dir first, then system config dirs *)
+
find_file_in_dirs (t.config_dir :: t.config_dirs) filename
+
let find_data_file t filename =
+
(* Search user data dir first, then system data dirs *)
+
find_file_in_dirs (t.data_dir :: t.data_dirs) filename
+
let pp ?(brief = false) ?(sources = false) ppf t =
+
let pp_source ppf = function
+
| Default -> Fmt.(styled `Faint string) ppf "default"
+
| Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
+
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
+
let pp_path_with_source ppf path source =
+
Fmt.(styled `Green Eio.Path.pp)
+
Fmt.(styled `Faint (brackets pp_source))
+
else Fmt.(styled `Green Eio.Path.pp) ppf path
+
let pp_path_opt_with_source ppf path_opt source =
+
Fmt.(styled `Red string)
+
Fmt.(styled `Faint (brackets pp_source))
+
else Fmt.(styled `Red string) ppf "<none>"
+
| Some path -> pp_path_with_source ppf path source
+
let pp_paths ppf paths =
+
Fmt.(list ~sep:(any ";@ ") (styled `Green Eio.Path.pp)) ppf paths
+
Fmt.pf ppf "%a config=%a data=%a>"
+
Fmt.(styled `Cyan string)
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
+
(t.config_dir, t.config_dir_source)
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
+
(t.data_dir, t.data_dir_source)
+
Fmt.(styled `Bold string)
+
("XDG directories for '" ^ t.app_name ^ "':");
+
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "User directories:";
+
Fmt.(styled `Cyan string)
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
+
(t.config_dir, t.config_dir_source);
+
Fmt.(styled `Cyan string)
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
+
(t.data_dir, t.data_dir_source);
+
Fmt.(styled `Cyan string)
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
+
(t.cache_dir, t.cache_dir_source);
+
Fmt.(styled `Cyan string)
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
+
(t.state_dir, t.state_dir_source);
+
Fmt.(styled `Cyan string)
+
(fun ppf (path_opt, source) ->
+
pp_path_opt_with_source ppf path_opt source)
+
(t.runtime_dir, t.runtime_dir_source);
+
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "System directories:";
+
Fmt.pf ppf "%a [@[<hov>%a@]]@,"
+
Fmt.(styled `Cyan string)
+
"config_dirs:" pp_paths t.config_dirs;
+
Fmt.pf ppf "%a [@[<hov>%a@]]@]@]"
+
Fmt.(styled `Cyan string)
+
"data_dirs:" pp_paths t.data_dirs)
+
type 'a with_source = { value : 'a option; source : source }
+
config_dir : string with_source;
+
data_dir : string with_source;
+
cache_dir : string with_source;
+
state_dir : string with_source;
+
runtime_dir : string with_source;
+
type dir = [ `Config | `Cache | `Data | `State | `Runtime ]
+
let term app_name fs ?(dirs = [ `Config; `Data; `Cache; `State; `Runtime ]) ()
+
let app_upper = String.uppercase_ascii app_name in
+
let doc = "Show only the resolved directory paths without formatting" in
+
Arg.(value & flag & info [ "show-paths" ] ~doc)
+
let has_dir d = List.mem d dirs in
+
let make_dir_arg ~enabled name env_suffix xdg_var default_path =
+
(* Return a term that always gives the environment-only result *)
+
let app_env = app_upper ^ "_" ^ env_suffix in
+
match Sys.getenv_opt app_env with
+
| Some v when v <> "" -> { value = Some v; source = Env app_env }
+
match Sys.getenv_opt xdg_var with
+
| Some v -> { value = Some v; source = Env xdg_var }
+
| None -> { value = None; source = Default }))
+
let app_env = app_upper ^ "_" ^ env_suffix in
+
match default_path with
+
"Override %s directory. Can also be set with %s or %s. \
+
name app_env xdg_var path
+
"Override %s directory. Can also be set with %s or %s. No \
+
& opt (some string) None
+
& info [ name ^ "-dir" ] ~docv:"DIR" ~doc)
+
const (fun cmdline_val ->
+
| Some v -> { value = Some v; source = Cmdline }
+
match Sys.getenv_opt app_env with
+
| Some v when v <> "" ->
+
{ value = Some v; source = Env app_env }
+
match Sys.getenv_opt xdg_var with
+
| Some v -> { value = Some v; source = Env xdg_var }
+
| None -> { value = None; source = Default })))
+
let home_prefix = "\\$HOME" in
+
make_dir_arg ~enabled:(has_dir `Config) "config" "CONFIG_DIR"
+
(Some (home_prefix ^ "/.config/" ^ app_name))
+
make_dir_arg ~enabled:(has_dir `Data) "data" "DATA_DIR" "XDG_DATA_HOME"
+
(Some (home_prefix ^ "/.local/share/" ^ app_name))
+
make_dir_arg ~enabled:(has_dir `Cache) "cache" "CACHE_DIR"
+
(Some (home_prefix ^ "/.cache/" ^ app_name))
+
make_dir_arg ~enabled:(has_dir `State) "state" "STATE_DIR"
+
(Some (home_prefix ^ "/.local/state/" ^ app_name))
+
make_dir_arg ~enabled:(has_dir `Runtime) "runtime" "RUNTIME_DIR"
+
config_dir = config_dir_ws;
+
data_dir = data_dir_ws;
+
cache_dir = cache_dir_ws;
+
state_dir = state_dir_ws;
+
runtime_dir = runtime_dir_ws;
+
let home_path = get_home_dir fs in
+
(* First validate all standard XDG environment variables *)
+
validate_standard_xdg_vars ();
+
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
+
(* Helper to resolve directory from config with source tracking *)
+
let resolve_from_config config_ws xdg_getter =
+
match config_ws.value with
+
| Some dir -> (resolve_path fs home_path dir, config_ws.source)
+
let xdg_base = xdg_getter xdg_ctx in
+
let base_path = resolve_path fs home_path xdg_base in
+
(Eio.Path.(base_path / app_name), config_ws.source)
+
let config_dir, config_dir_source =
+
resolve_from_config config.config_dir Xdg.config_dir
+
let data_dir, data_dir_source =
+
resolve_from_config config.data_dir Xdg.data_dir
+
let cache_dir, cache_dir_source =
+
resolve_from_config config.cache_dir Xdg.cache_dir
+
let state_dir, state_dir_source =
+
resolve_from_config config.state_dir Xdg.state_dir
+
(* Runtime directory *)
+
let runtime_dir, runtime_dir_source =
+
match config.runtime_dir.value with
+
(Some (resolve_path fs home_path dir), config.runtime_dir.source)
+
let base_path = resolve_path fs home_path base in
+
Eio.Path.(base_path / app_name))
+
(Xdg.runtime_dir xdg_ctx),
+
config.runtime_dir.source )
+
(* System directories - reuse shared helper *)
+
resolve_system_dirs fs home_path app_name "CONFIG_DIRS"
+
"XDG_CONFIG_DIRS" [ "/etc/xdg" ]
+
resolve_system_dirs fs home_path app_name "DATA_DIRS"
+
[ "/usr/local/share"; "/usr/share" ]
+
Option.iter (ensure_runtime_dir fs) runtime_dir;
+
(* Handle --show-paths option *)
+
if show_paths_flag then (
+
let print_path name path =
+
| None -> Printf.printf "%s: <none>\n" name
+
| Some p -> Printf.printf "%s: %s\n" name (Eio.Path.native_exn p)
+
let print_paths name paths =
+
| [] -> Printf.printf "%s: []\n" name
+
String.concat ":" (List.map Eio.Path.native_exn paths)
+
Printf.printf "%s: %s\n" name paths_str
+
print_path "config_dir" (Some config_dir);
+
print_path "data_dir" (Some data_dir);
+
print_path "cache_dir" (Some cache_dir);
+
print_path "state_dir" (Some state_dir);
+
print_path "runtime_dir" runtime_dir;
+
print_paths "config_dirs" config_dirs;
+
print_paths "data_dirs" data_dirs;
+
$ show_paths $ config_dir $ data_dir $ cache_dir $ state_dir $ runtime_dir)
+
let cache_term app_name =
+
let app_upper = String.uppercase_ascii app_name in
+
let app_env = app_upper ^ "_CACHE_DIR" in
+
let xdg_var = "XDG_CACHE_HOME" in
+
let home = Sys.getenv "HOME" in
+
let default_path = home ^ "/.cache/" ^ app_name in
+
"Override cache directory. Can also be set with %s or %s. Default: %s"
+
app_env xdg_var default_path
+
value & opt string default_path
+
& info [ "cache-dir"; "c" ] ~docv:"DIR" ~doc)
+
const (fun cmdline_val ->
+
(* Check command line first *)
+
if cmdline_val <> default_path then cmdline_val
+
(* Then check app-specific env var *)
+
match Sys.getenv_opt app_env with
+
| Some v when v <> "" -> v
+
(* Then check XDG env var *)
+
match Sys.getenv_opt xdg_var with
+
| Some v when v <> "" -> v ^ "/" ^ app_name
+
let env_docs app_name =
+
let app_upper = String.uppercase_ascii app_name in
+
Configuration Precedence (follows standard Unix conventions):
+
1. Command-line flags (e.g., --config-dir) - highest priority
+
2. Application-specific environment variable (e.g., %s_CONFIG_DIR)
+
3. XDG standard environment variable (e.g., XDG_CONFIG_HOME)
+
4. Default path (e.g., ~/.config/%s) - lowest priority
+
This allows per-application overrides without affecting other XDG-compliant programs.
+
For example, setting %s_CONFIG_DIR only changes the config directory for %s,
+
while XDG_CONFIG_HOME affects all XDG-compliant applications.
+
Application-specific variables:
+
%s_CONFIG_DIR Override config directory for %s only
+
%s_DATA_DIR Override data directory for %s only
+
%s_CACHE_DIR Override cache directory for %s only
+
%s_STATE_DIR Override state directory for %s only
+
%s_RUNTIME_DIR Override runtime directory for %s only
+
XDG standard variables (shared by all XDG applications):
+
XDG_CONFIG_HOME User configuration directory (default: ~/.config/%s)
+
XDG_DATA_HOME User data directory (default: ~/.local/share/%s)
+
XDG_CACHE_HOME User cache directory (default: ~/.cache/%s)
+
XDG_STATE_HOME User state directory (default: ~/.local/state/%s)
+
XDG_RUNTIME_DIR User runtime directory (no default)
+
XDG_CONFIG_DIRS System configuration directories (default: /etc/xdg/%s)
+
XDG_DATA_DIRS System data directories (default: /usr/local/share/%s:/usr/share/%s)
+
app_upper app_name app_upper app_name app_upper app_name app_upper
+
app_name app_upper app_name app_upper app_name app_upper app_name app_name
+
app_name app_name app_name app_name app_name app_name
+
let pp_source ppf = function
+
| Default -> Fmt.(styled `Faint string) ppf "default"
+
Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
+
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
+
let pp_with_source name ppf ws =
+
| None when ws.source = Default -> ()
+
Fmt.pf ppf "@,%a %a %a"
+
Fmt.(styled `Cyan string)
+
Fmt.(styled `Red string)
+
Fmt.(styled `Faint (brackets pp_source))
+
Fmt.pf ppf "@,%a %a %a"
+
Fmt.(styled `Cyan string)
+
Fmt.(styled `Green string)
+
Fmt.(styled `Faint (brackets pp_source))
+
Fmt.pf ppf "@[<v>%a%a%a%a%a%a@]"
+
Fmt.(styled `Bold string)
+
(pp_with_source "config_dir")
+
(pp_with_source "data_dir")
+
(pp_with_source "cache_dir")
+
(pp_with_source "state_dir")
+
(pp_with_source "runtime_dir")
anil.recoil.org