···
1
+
type source = Default | Env of string | Cmdline
5
+
config_dir : Eio.Fs.dir_ty Eio.Path.t;
6
+
config_dir_source : source;
7
+
data_dir : Eio.Fs.dir_ty Eio.Path.t;
8
+
data_dir_source : source;
9
+
cache_dir : Eio.Fs.dir_ty Eio.Path.t;
10
+
cache_dir_source : source;
11
+
state_dir : Eio.Fs.dir_ty Eio.Path.t;
12
+
state_dir_source : source;
13
+
runtime_dir : Eio.Fs.dir_ty Eio.Path.t option;
14
+
runtime_dir_source : source;
15
+
config_dirs : Eio.Fs.dir_ty Eio.Path.t list;
16
+
data_dirs : Eio.Fs.dir_ty Eio.Path.t list;
19
+
let ensure_dir ?(perm = 0o755) path = Eio.Path.mkdirs ~exists_ok:true ~perm path
21
+
let validate_runtime_base_dir base_path =
22
+
(* Validate the base XDG_RUNTIME_DIR has correct permissions per spec *)
24
+
let path_str = Eio.Path.native_exn base_path in
25
+
let stat = Eio.Path.stat ~follow:true base_path in
26
+
let current_perm = stat.perm land 0o777 in
27
+
if current_perm <> 0o700 then
30
+
"XDG_RUNTIME_DIR base directory %s has incorrect permissions: %o \
32
+
path_str current_perm);
33
+
(* Check ownership - directory should be owned by current user *)
34
+
let uid = Unix.getuid () in
35
+
if stat.uid <> Int64.of_int uid then
38
+
"XDG_RUNTIME_DIR base directory %s not owned by current user (uid \
40
+
path_str uid stat.uid)
41
+
(* TODO: Check that directory is on local filesystem (not networked).
42
+
This would require filesystem type detection which is OS-specific. *)
45
+
(Printf.sprintf "Cannot validate XDG_RUNTIME_DIR: %s"
46
+
(Printexc.to_string exn))
48
+
let ensure_runtime_dir _fs app_runtime_path =
49
+
(* Base directory validation is done in resolve_runtime_dir,
50
+
so we just create the app subdirectory *)
51
+
ensure_dir app_runtime_path
53
+
let get_home_dir fs =
55
+
match Sys.getenv_opt "HOME" with
58
+
match Sys.os_type with
59
+
| "Win32" | "Cygwin" -> (
60
+
match Sys.getenv_opt "USERPROFILE" with
61
+
| Some profile -> profile
62
+
| None -> failwith "Cannot determine home directory")
64
+
try Unix.((getpwuid (getuid ())).pw_dir)
65
+
with _ -> failwith "Cannot determine home directory"))
67
+
Eio.Path.(fs / home_str)
69
+
let make_env_var_name app_name suffix =
70
+
String.uppercase_ascii app_name ^ "_" ^ suffix
72
+
exception Invalid_xdg_path of string
74
+
let validate_absolute_path context path =
75
+
if Filename.is_relative path then
78
+
(Printf.sprintf "%s must be an absolute path, got: %s" context path))
80
+
let resolve_path fs home_path base_path =
81
+
if Filename.is_relative base_path then Eio.Path.(home_path / base_path)
82
+
else Eio.Path.(fs / base_path)
84
+
(* Helper to resolve system directories (config_dirs or data_dirs) *)
85
+
let resolve_system_dirs fs home_path app_name override_suffix xdg_var
87
+
let override_var = make_env_var_name app_name override_suffix in
88
+
match Sys.getenv_opt override_var with
89
+
| Some dirs when dirs <> "" ->
90
+
String.split_on_char ':' dirs
91
+
|> List.filter (fun s -> s <> "")
92
+
|> List.filter_map (fun path ->
94
+
validate_absolute_path override_var path;
95
+
Some Eio.Path.(resolve_path fs home_path path / app_name)
96
+
with Invalid_xdg_path _ -> None)
97
+
| Some _ | None -> (
98
+
match Sys.getenv_opt xdg_var with
99
+
| Some dirs when dirs <> "" ->
100
+
String.split_on_char ':' dirs
101
+
|> List.filter (fun s -> s <> "")
102
+
|> List.filter_map (fun path ->
104
+
validate_absolute_path xdg_var path;
105
+
Some Eio.Path.(resolve_path fs home_path path / app_name)
106
+
with Invalid_xdg_path _ -> None)
109
+
(fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
112
+
(* Helper to resolve a user directory with override precedence *)
113
+
let resolve_user_dir fs home_path app_name xdg_ctx xdg_getter override_suffix =
114
+
let override_var = make_env_var_name app_name override_suffix in
115
+
match Sys.getenv_opt override_var with
116
+
| Some dir when dir <> "" ->
117
+
validate_absolute_path override_var dir;
118
+
(Eio.Path.(fs / dir / app_name), Env override_var)
120
+
let xdg_base = xdg_getter xdg_ctx in
121
+
let base_path = resolve_path fs home_path xdg_base in
122
+
(Eio.Path.(base_path / app_name), Default)
124
+
(* Helper to resolve runtime directory (special case since it can be None) *)
125
+
let resolve_runtime_dir fs home_path app_name xdg_ctx =
126
+
let override_var = make_env_var_name app_name "RUNTIME_DIR" in
127
+
match Sys.getenv_opt override_var with
128
+
| Some dir when dir <> "" ->
129
+
validate_absolute_path override_var dir;
130
+
(* Validate the base runtime directory has correct permissions *)
131
+
let base_runtime_dir = resolve_path fs home_path dir in
132
+
validate_runtime_base_dir base_runtime_dir;
133
+
(Some Eio.Path.(base_runtime_dir / app_name), Env override_var)
135
+
( (match Xdg.runtime_dir xdg_ctx with
137
+
(* Validate the base runtime directory has correct permissions *)
138
+
let base_runtime_dir = resolve_path fs home_path base in
139
+
validate_runtime_base_dir base_runtime_dir;
140
+
Some Eio.Path.(base_runtime_dir / app_name)
144
+
let validate_standard_xdg_vars () =
145
+
(* Validate standard XDG environment variables for absolute paths *)
159
+
match Sys.getenv_opt var with
160
+
| Some value when value <> "" ->
161
+
if String.contains value ':' then
162
+
(* Colon-separated list - validate each part *)
163
+
String.split_on_char ':' value
164
+
|> List.filter (fun s -> s <> "")
165
+
|> List.iter (fun path -> validate_absolute_path var path)
168
+
validate_absolute_path var value
172
+
let create fs app_name =
174
+
let home_path = get_home_dir fs in
175
+
(* First validate all standard XDG environment variables *)
176
+
validate_standard_xdg_vars ();
177
+
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
178
+
(* User directories *)
179
+
let config_dir, config_dir_source =
180
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.config_dir "CONFIG_DIR"
182
+
let data_dir, data_dir_source =
183
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.data_dir "DATA_DIR"
185
+
let cache_dir, cache_dir_source =
186
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.cache_dir "CACHE_DIR"
188
+
let state_dir, state_dir_source =
189
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.state_dir "STATE_DIR"
191
+
(* Runtime directory *)
192
+
let runtime_dir, runtime_dir_source =
193
+
resolve_runtime_dir fs home_path app_name xdg_ctx
195
+
(* System directories *)
197
+
resolve_system_dirs fs home_path app_name "CONFIG_DIRS" "XDG_CONFIG_DIRS"
201
+
resolve_system_dirs fs home_path app_name "DATA_DIRS" "XDG_DATA_DIRS"
202
+
[ "/usr/local/share"; "/usr/share" ]
204
+
ensure_dir config_dir;
205
+
ensure_dir data_dir;
206
+
ensure_dir cache_dir;
207
+
ensure_dir state_dir;
208
+
Option.iter (ensure_runtime_dir fs) runtime_dir;
220
+
runtime_dir_source;
225
+
let app_name t = t.app_name
226
+
let config_dir t = t.config_dir
227
+
let data_dir t = t.data_dir
228
+
let cache_dir t = t.cache_dir
229
+
let state_dir t = t.state_dir
230
+
let runtime_dir t = t.runtime_dir
231
+
let config_dirs t = t.config_dirs
232
+
let data_dirs t = t.data_dirs
234
+
(* File search following XDG specification *)
235
+
let find_file_in_dirs dirs filename =
236
+
let rec search_dirs = function
238
+
| dir :: remaining_dirs -> (
239
+
let file_path = Eio.Path.(dir / filename) in
241
+
(* Try to check if file exists and is readable *)
242
+
let _ = Eio.Path.stat ~follow:true file_path in
245
+
(* File is inaccessible (non-existent, permissions, etc.)
246
+
Skip and continue with next directory per XDG spec *)
247
+
search_dirs remaining_dirs)
251
+
let find_config_file t filename =
252
+
(* Search user config dir first, then system config dirs *)
253
+
find_file_in_dirs (t.config_dir :: t.config_dirs) filename
255
+
let find_data_file t filename =
256
+
(* Search user data dir first, then system data dirs *)
257
+
find_file_in_dirs (t.data_dir :: t.data_dirs) filename
259
+
let pp ?(brief = false) ?(sources = false) ppf t =
260
+
let pp_source ppf = function
261
+
| Default -> Fmt.(styled `Faint string) ppf "default"
262
+
| Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
263
+
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
265
+
let pp_path_with_source ppf path source =
268
+
Fmt.(styled `Green Eio.Path.pp)
270
+
Fmt.(styled `Faint (brackets pp_source))
272
+
else Fmt.(styled `Green Eio.Path.pp) ppf path
274
+
let pp_path_opt_with_source ppf path_opt source =
275
+
match path_opt with
279
+
Fmt.(styled `Red string)
281
+
Fmt.(styled `Faint (brackets pp_source))
283
+
else Fmt.(styled `Red string) ppf "<none>"
284
+
| Some path -> pp_path_with_source ppf path source
286
+
let pp_paths ppf paths =
287
+
Fmt.(list ~sep:(any ";@ ") (styled `Green Eio.Path.pp)) ppf paths
290
+
Fmt.pf ppf "%a config=%a data=%a>"
291
+
Fmt.(styled `Cyan string)
292
+
("<xdg:" ^ t.app_name)
293
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
294
+
(t.config_dir, t.config_dir_source)
295
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
296
+
(t.data_dir, t.data_dir_source)
298
+
Fmt.pf ppf "@[<v>%a@,"
299
+
Fmt.(styled `Bold string)
300
+
("XDG directories for '" ^ t.app_name ^ "':");
301
+
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "User directories:";
302
+
Fmt.pf ppf "%a %a@,"
303
+
Fmt.(styled `Cyan string)
305
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
306
+
(t.config_dir, t.config_dir_source);
307
+
Fmt.pf ppf "%a %a@,"
308
+
Fmt.(styled `Cyan string)
310
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
311
+
(t.data_dir, t.data_dir_source);
312
+
Fmt.pf ppf "%a %a@,"
313
+
Fmt.(styled `Cyan string)
315
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
316
+
(t.cache_dir, t.cache_dir_source);
317
+
Fmt.pf ppf "%a %a@,"
318
+
Fmt.(styled `Cyan string)
320
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
321
+
(t.state_dir, t.state_dir_source);
322
+
Fmt.pf ppf "%a %a@]@,"
323
+
Fmt.(styled `Cyan string)
325
+
(fun ppf (path_opt, source) ->
326
+
pp_path_opt_with_source ppf path_opt source)
327
+
(t.runtime_dir, t.runtime_dir_source);
328
+
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "System directories:";
329
+
Fmt.pf ppf "%a [@[<hov>%a@]]@,"
330
+
Fmt.(styled `Cyan string)
331
+
"config_dirs:" pp_paths t.config_dirs;
332
+
Fmt.pf ppf "%a [@[<hov>%a@]]@]@]"
333
+
Fmt.(styled `Cyan string)
334
+
"data_dirs:" pp_paths t.data_dirs)
336
+
module Cmd = struct
338
+
type 'a with_source = { value : 'a option; source : source }
341
+
config_dir : string with_source;
342
+
data_dir : string with_source;
343
+
cache_dir : string with_source;
344
+
state_dir : string with_source;
345
+
runtime_dir : string with_source;
348
+
type dir = [ `Config | `Cache | `Data | `State | `Runtime ]
350
+
let term app_name fs ?(dirs = [ `Config; `Data; `Cache; `State; `Runtime ]) ()
352
+
let open Cmdliner in
353
+
let app_upper = String.uppercase_ascii app_name in
355
+
let doc = "Show only the resolved directory paths without formatting" in
356
+
Arg.(value & flag & info [ "show-paths" ] ~doc)
358
+
let has_dir d = List.mem d dirs in
359
+
let make_dir_arg ~enabled name env_suffix xdg_var default_path =
360
+
if not enabled then
361
+
(* Return a term that always gives the environment-only result *)
364
+
let app_env = app_upper ^ "_" ^ env_suffix in
365
+
match Sys.getenv_opt app_env with
366
+
| Some v when v <> "" -> { value = Some v; source = Env app_env }
367
+
| Some _ | None -> (
368
+
match Sys.getenv_opt xdg_var with
369
+
| Some v -> { value = Some v; source = Env xdg_var }
370
+
| None -> { value = None; source = Default }))
373
+
let app_env = app_upper ^ "_" ^ env_suffix in
375
+
match default_path with
378
+
"Override %s directory. Can also be set with %s or %s. \
380
+
name app_env xdg_var path
383
+
"Override %s directory. Can also be set with %s or %s. No \
385
+
name app_env xdg_var
390
+
& opt (some string) None
391
+
& info [ name ^ "-dir" ] ~docv:"DIR" ~doc)
394
+
const (fun cmdline_val ->
395
+
match cmdline_val with
396
+
| Some v -> { value = Some v; source = Cmdline }
398
+
match Sys.getenv_opt app_env with
399
+
| Some v when v <> "" ->
400
+
{ value = Some v; source = Env app_env }
401
+
| Some _ | None -> (
402
+
match Sys.getenv_opt xdg_var with
403
+
| Some v -> { value = Some v; source = Env xdg_var }
404
+
| None -> { value = None; source = Default })))
407
+
let home_prefix = "\\$HOME" in
409
+
make_dir_arg ~enabled:(has_dir `Config) "config" "CONFIG_DIR"
411
+
(Some (home_prefix ^ "/.config/" ^ app_name))
414
+
make_dir_arg ~enabled:(has_dir `Data) "data" "DATA_DIR" "XDG_DATA_HOME"
415
+
(Some (home_prefix ^ "/.local/share/" ^ app_name))
418
+
make_dir_arg ~enabled:(has_dir `Cache) "cache" "CACHE_DIR"
420
+
(Some (home_prefix ^ "/.cache/" ^ app_name))
423
+
make_dir_arg ~enabled:(has_dir `State) "state" "STATE_DIR"
425
+
(Some (home_prefix ^ "/.local/state/" ^ app_name))
428
+
make_dir_arg ~enabled:(has_dir `Runtime) "runtime" "RUNTIME_DIR"
429
+
"XDG_RUNTIME_DIR" None
443
+
config_dir = config_dir_ws;
444
+
data_dir = data_dir_ws;
445
+
cache_dir = cache_dir_ws;
446
+
state_dir = state_dir_ws;
447
+
runtime_dir = runtime_dir_ws;
450
+
let home_path = get_home_dir fs in
451
+
(* First validate all standard XDG environment variables *)
452
+
validate_standard_xdg_vars ();
453
+
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
454
+
(* Helper to resolve directory from config with source tracking *)
455
+
let resolve_from_config config_ws xdg_getter =
456
+
match config_ws.value with
457
+
| Some dir -> (resolve_path fs home_path dir, config_ws.source)
459
+
let xdg_base = xdg_getter xdg_ctx in
460
+
let base_path = resolve_path fs home_path xdg_base in
461
+
(Eio.Path.(base_path / app_name), config_ws.source)
463
+
(* User directories *)
464
+
let config_dir, config_dir_source =
465
+
resolve_from_config config.config_dir Xdg.config_dir
467
+
let data_dir, data_dir_source =
468
+
resolve_from_config config.data_dir Xdg.data_dir
470
+
let cache_dir, cache_dir_source =
471
+
resolve_from_config config.cache_dir Xdg.cache_dir
473
+
let state_dir, state_dir_source =
474
+
resolve_from_config config.state_dir Xdg.state_dir
476
+
(* Runtime directory *)
477
+
let runtime_dir, runtime_dir_source =
478
+
match config.runtime_dir.value with
480
+
(Some (resolve_path fs home_path dir), config.runtime_dir.source)
484
+
let base_path = resolve_path fs home_path base in
485
+
Eio.Path.(base_path / app_name))
486
+
(Xdg.runtime_dir xdg_ctx),
487
+
config.runtime_dir.source )
489
+
(* System directories - reuse shared helper *)
491
+
resolve_system_dirs fs home_path app_name "CONFIG_DIRS"
492
+
"XDG_CONFIG_DIRS" [ "/etc/xdg" ]
495
+
resolve_system_dirs fs home_path app_name "DATA_DIRS"
497
+
[ "/usr/local/share"; "/usr/share" ]
499
+
ensure_dir config_dir;
500
+
ensure_dir data_dir;
501
+
ensure_dir cache_dir;
502
+
ensure_dir state_dir;
503
+
Option.iter (ensure_runtime_dir fs) runtime_dir;
516
+
runtime_dir_source;
521
+
(* Handle --show-paths option *)
522
+
if show_paths_flag then (
523
+
let print_path name path =
525
+
| None -> Printf.printf "%s: <none>\n" name
526
+
| Some p -> Printf.printf "%s: %s\n" name (Eio.Path.native_exn p)
528
+
let print_paths name paths =
530
+
| [] -> Printf.printf "%s: []\n" name
533
+
String.concat ":" (List.map Eio.Path.native_exn paths)
535
+
Printf.printf "%s: %s\n" name paths_str
537
+
print_path "config_dir" (Some config_dir);
538
+
print_path "data_dir" (Some data_dir);
539
+
print_path "cache_dir" (Some cache_dir);
540
+
print_path "state_dir" (Some state_dir);
541
+
print_path "runtime_dir" runtime_dir;
542
+
print_paths "config_dirs" config_dirs;
543
+
print_paths "data_dirs" data_dirs;
546
+
$ show_paths $ config_dir $ data_dir $ cache_dir $ state_dir $ runtime_dir)
548
+
let cache_term app_name =
549
+
let open Cmdliner in
550
+
let app_upper = String.uppercase_ascii app_name in
551
+
let app_env = app_upper ^ "_CACHE_DIR" in
552
+
let xdg_var = "XDG_CACHE_HOME" in
553
+
let home = Sys.getenv "HOME" in
554
+
let default_path = home ^ "/.cache/" ^ app_name in
558
+
"Override cache directory. Can also be set with %s or %s. Default: %s"
559
+
app_env xdg_var default_path
564
+
value & opt string default_path
565
+
& info [ "cache-dir"; "c" ] ~docv:"DIR" ~doc)
569
+
const (fun cmdline_val ->
570
+
(* Check command line first *)
571
+
if cmdline_val <> default_path then cmdline_val
573
+
(* Then check app-specific env var *)
574
+
match Sys.getenv_opt app_env with
575
+
| Some v when v <> "" -> v
577
+
(* Then check XDG env var *)
578
+
match Sys.getenv_opt xdg_var with
579
+
| Some v when v <> "" -> v ^ "/" ^ app_name
580
+
| _ -> default_path))
583
+
let env_docs app_name =
584
+
let app_upper = String.uppercase_ascii app_name in
587
+
Configuration Precedence (follows standard Unix conventions):
588
+
1. Command-line flags (e.g., --config-dir) - highest priority
589
+
2. Application-specific environment variable (e.g., %s_CONFIG_DIR)
590
+
3. XDG standard environment variable (e.g., XDG_CONFIG_HOME)
591
+
4. Default path (e.g., ~/.config/%s) - lowest priority
593
+
This allows per-application overrides without affecting other XDG-compliant programs.
594
+
For example, setting %s_CONFIG_DIR only changes the config directory for %s,
595
+
while XDG_CONFIG_HOME affects all XDG-compliant applications.
597
+
Application-specific variables:
598
+
%s_CONFIG_DIR Override config directory for %s only
599
+
%s_DATA_DIR Override data directory for %s only
600
+
%s_CACHE_DIR Override cache directory for %s only
601
+
%s_STATE_DIR Override state directory for %s only
602
+
%s_RUNTIME_DIR Override runtime directory for %s only
604
+
XDG standard variables (shared by all XDG applications):
605
+
XDG_CONFIG_HOME User configuration directory (default: ~/.config/%s)
606
+
XDG_DATA_HOME User data directory (default: ~/.local/share/%s)
607
+
XDG_CACHE_HOME User cache directory (default: ~/.cache/%s)
608
+
XDG_STATE_HOME User state directory (default: ~/.local/state/%s)
609
+
XDG_RUNTIME_DIR User runtime directory (no default)
610
+
XDG_CONFIG_DIRS System configuration directories (default: /etc/xdg/%s)
611
+
XDG_DATA_DIRS System data directories (default: /usr/local/share/%s:/usr/share/%s)
613
+
app_upper app_name app_upper app_name app_upper app_name app_upper
614
+
app_name app_upper app_name app_upper app_name app_upper app_name app_name
615
+
app_name app_name app_name app_name app_name app_name
617
+
let pp ppf config =
618
+
let pp_source ppf = function
619
+
| Default -> Fmt.(styled `Faint string) ppf "default"
621
+
Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
622
+
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
624
+
let pp_with_source name ppf ws =
625
+
match ws.value with
626
+
| None when ws.source = Default -> ()
628
+
Fmt.pf ppf "@,%a %a %a"
629
+
Fmt.(styled `Cyan string)
631
+
Fmt.(styled `Red string)
633
+
Fmt.(styled `Faint (brackets pp_source))
636
+
Fmt.pf ppf "@,%a %a %a"
637
+
Fmt.(styled `Cyan string)
639
+
Fmt.(styled `Green string)
641
+
Fmt.(styled `Faint (brackets pp_source))
644
+
Fmt.pf ppf "@[<v>%a%a%a%a%a%a@]"
645
+
Fmt.(styled `Bold string)
647
+
(pp_with_source "config_dir")
649
+
(pp_with_source "data_dir")
651
+
(pp_with_source "cache_dir")
653
+
(pp_with_source "state_dir")
655
+
(pp_with_source "runtime_dir")
anil.recoil.org