this repo has no description
more
+303
-65
+123
-24
xdg-eio/lib/xdge.ml
+123
-24
xdg-eio/lib/xdge.ml
···
19
19
; data_dirs : Eio.Fs.dir_ty Eio.Path.t list
20
20
}
21
21
22
-
let ensure_dir path = Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path
22
+
let ensure_dir ?(perm = 0o755) path = Eio.Path.mkdirs ~exists_ok:true ~perm path
23
+
24
+
let validate_runtime_base_dir base_path =
25
+
(* Validate the base XDG_RUNTIME_DIR has correct permissions per spec *)
26
+
try
27
+
let path_str = Eio.Path.native_exn base_path in
28
+
let stat = Eio.Path.stat ~follow:true base_path in
29
+
let current_perm = stat.perm land 0o777 in
30
+
if current_perm <> 0o700 then
31
+
failwith
32
+
(Printf.sprintf
33
+
"XDG_RUNTIME_DIR base directory %s has incorrect permissions: %o (must be 0700)"
34
+
path_str
35
+
current_perm);
36
+
(* Check ownership - directory should be owned by current user *)
37
+
let uid = Unix.getuid () in
38
+
if stat.uid <> Int64.of_int uid then
39
+
failwith
40
+
(Printf.sprintf
41
+
"XDG_RUNTIME_DIR base directory %s not owned by current user (uid %d, owner %Ld)"
42
+
path_str
43
+
uid
44
+
stat.uid);
45
+
(* TODO: Check that directory is on local filesystem (not networked).
46
+
This would require filesystem type detection which is OS-specific. *)
47
+
with
48
+
| exn -> failwith (Printf.sprintf "Cannot validate XDG_RUNTIME_DIR: %s" (Printexc.to_string exn))
49
+
50
+
let ensure_runtime_dir _fs app_runtime_path =
51
+
(* Base directory validation is done in resolve_runtime_dir,
52
+
so we just create the app subdirectory *)
53
+
ensure_dir app_runtime_path
23
54
24
55
let get_home_dir fs =
25
56
let home_str =
···
36
67
| _ -> failwith "Cannot determine home directory"))
37
68
in
38
69
Eio.Path.(fs / home_str)
39
-
;;
40
70
41
71
let make_env_var_name app_name suffix = String.uppercase_ascii app_name ^ "_" ^ suffix
42
72
73
+
exception Invalid_xdg_path of string
74
+
75
+
let validate_absolute_path context path =
76
+
if Filename.is_relative path then
77
+
raise (Invalid_xdg_path
78
+
(Printf.sprintf "%s must be an absolute path, got: %s" context path))
79
+
43
80
let resolve_path fs home_path base_path =
44
81
if Filename.is_relative base_path
45
82
then Eio.Path.(home_path / base_path)
46
83
else Eio.Path.(fs / base_path)
47
-
;;
48
84
49
85
(* Helper to resolve system directories (config_dirs or data_dirs) *)
50
-
let resolve_system_dirs fs home_path app_name override_suffix xdg_var default_paths =
86
+
let resolve_system_dirs fs _home_path app_name override_suffix xdg_var default_paths =
51
87
let override_var = make_env_var_name app_name override_suffix in
52
88
match Sys.getenv_opt override_var with
53
89
| Some dirs when dirs <> "" ->
54
90
String.split_on_char ':' dirs
55
91
|> List.filter (fun s -> s <> "")
56
-
|> List.map (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
92
+
|> List.filter_map (fun path ->
93
+
try
94
+
validate_absolute_path override_var path;
95
+
Some (Eio.Path.(fs / path / app_name))
96
+
with Invalid_xdg_path _ -> None)
57
97
| Some _ | None ->
58
98
(match Sys.getenv_opt xdg_var with
59
99
| Some dirs when dirs <> "" ->
60
100
String.split_on_char ':' dirs
61
101
|> List.filter (fun s -> s <> "")
62
-
|> List.map (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
102
+
|> List.filter_map (fun path ->
103
+
try
104
+
validate_absolute_path xdg_var path;
105
+
Some (Eio.Path.(fs / path / app_name))
106
+
with Invalid_xdg_path _ -> None)
63
107
| Some _ | None ->
64
108
List.map (fun path -> Eio.Path.(fs / path / app_name)) default_paths)
65
-
;;
66
109
67
110
(* Helper to resolve a user directory with override precedence *)
68
-
let resolve_user_dir fs home_path app_name xdg_ctx xdg_getter override_suffix =
111
+
let resolve_user_dir fs _home_path app_name xdg_ctx xdg_getter override_suffix =
69
112
let override_var = make_env_var_name app_name override_suffix in
70
113
match Sys.getenv_opt override_var with
71
-
| Some dir when dir <> "" -> resolve_path fs home_path dir, Env override_var
114
+
| Some dir when dir <> "" ->
115
+
validate_absolute_path override_var dir;
116
+
Eio.Path.(fs / dir / app_name), Env override_var
72
117
| Some _ | None -> Eio.Path.(fs / xdg_getter xdg_ctx / app_name), Default
73
-
;;
74
118
75
119
(* Helper to resolve runtime directory (special case since it can be None) *)
76
-
let resolve_runtime_dir fs home_path app_name xdg_ctx =
120
+
let resolve_runtime_dir fs _home_path app_name xdg_ctx =
77
121
let override_var = make_env_var_name app_name "RUNTIME_DIR" in
78
122
match Sys.getenv_opt override_var with
79
-
| Some dir when dir <> "" -> Some (resolve_path fs home_path dir), Env override_var
123
+
| Some dir when dir <> "" ->
124
+
validate_absolute_path override_var dir;
125
+
(* Validate the base runtime directory has correct permissions *)
126
+
let base_runtime_dir = Eio.Path.(fs / dir) in
127
+
validate_runtime_base_dir base_runtime_dir;
128
+
Some (Eio.Path.(fs / dir / app_name)), Env override_var
80
129
| Some _ | None ->
81
-
( Option.map (fun base -> Eio.Path.(fs / base / app_name)) (Xdg.runtime_dir xdg_ctx)
82
-
, Default )
83
-
;;
130
+
(match Xdg.runtime_dir xdg_ctx with
131
+
| Some base ->
132
+
(* Validate the base runtime directory has correct permissions *)
133
+
let base_runtime_dir = Eio.Path.(fs / base) in
134
+
validate_runtime_base_dir base_runtime_dir;
135
+
Some (Eio.Path.(fs / base / app_name))
136
+
| None -> None), Default
137
+
138
+
let validate_standard_xdg_vars () =
139
+
(* Validate standard XDG environment variables for absolute paths *)
140
+
let xdg_vars = [
141
+
"XDG_CONFIG_HOME";
142
+
"XDG_DATA_HOME";
143
+
"XDG_CACHE_HOME";
144
+
"XDG_STATE_HOME";
145
+
"XDG_RUNTIME_DIR";
146
+
"XDG_CONFIG_DIRS";
147
+
"XDG_DATA_DIRS";
148
+
] in
149
+
List.iter (fun var ->
150
+
match Sys.getenv_opt var with
151
+
| Some value when value <> "" ->
152
+
if String.contains value ':' then
153
+
(* Colon-separated list - validate each part *)
154
+
String.split_on_char ':' value
155
+
|> List.filter (fun s -> s <> "")
156
+
|> List.iter (fun path -> validate_absolute_path var path)
157
+
else
158
+
(* Single path *)
159
+
validate_absolute_path var value
160
+
| _ -> ()
161
+
) xdg_vars
84
162
85
163
let create fs app_name =
86
164
let fs = fs in
87
165
let home_path = get_home_dir fs in
166
+
(* First validate all standard XDG environment variables *)
167
+
validate_standard_xdg_vars ();
88
168
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
89
169
(* User directories *)
90
170
let config_dir, config_dir_source =
···
126
206
ensure_dir data_dir;
127
207
ensure_dir cache_dir;
128
208
ensure_dir state_dir;
129
-
Option.iter ensure_dir runtime_dir;
209
+
Option.iter (ensure_runtime_dir fs) runtime_dir;
130
210
{ app_name
131
211
; config_dir
132
212
; config_dir_source
···
141
221
; config_dirs
142
222
; data_dirs
143
223
}
144
-
;;
145
224
146
225
let app_name t = t.app_name
147
226
let config_dir t = t.config_dir
···
152
231
let config_dirs t = t.config_dirs
153
232
let data_dirs t = t.data_dirs
154
233
234
+
(* File search following XDG specification *)
235
+
let find_file_in_dirs dirs filename =
236
+
let rec search_dirs = function
237
+
| [] -> None
238
+
| dir :: remaining_dirs ->
239
+
let file_path = Eio.Path.(dir / filename) in
240
+
(try
241
+
(* Try to check if file exists and is readable *)
242
+
let _ = Eio.Path.stat ~follow:true file_path in
243
+
Some file_path
244
+
with
245
+
| _ ->
246
+
(* File is inaccessible (non-existent, permissions, etc.)
247
+
Skip and continue with next directory per XDG spec *)
248
+
search_dirs remaining_dirs)
249
+
in
250
+
search_dirs dirs
251
+
252
+
let find_config_file t filename =
253
+
(* Search user config dir first, then system config dirs *)
254
+
find_file_in_dirs (t.config_dir :: t.config_dirs) filename
255
+
256
+
let find_data_file t filename =
257
+
(* Search user data dir first, then system data dirs *)
258
+
find_file_in_dirs (t.data_dir :: t.data_dirs) filename
155
259
156
260
let pp ?(brief = false) ?(sources = false) ppf t =
157
261
let pp_source ppf = function
···
257
361
"data_dirs:"
258
362
pp_paths
259
363
t.data_dirs)
260
-
;;
261
364
262
365
module Cmd = struct
263
366
type xdg_t = t
···
399
502
ensure_dir data_dir;
400
503
ensure_dir cache_dir;
401
504
ensure_dir state_dir;
402
-
Option.iter ensure_dir runtime_dir;
505
+
Option.iter (ensure_runtime_dir fs) runtime_dir;
403
506
{ app_name
404
507
; config_dir
405
508
; config_dir_source
···
419
522
$ cache_dir
420
523
$ state_dir
421
524
$ runtime_dir)
422
-
;;
423
-
424
525
425
526
let env_docs app_name =
426
527
let app_upper = String.uppercase_ascii app_name in
···
473
574
app_name
474
575
app_name
475
576
app_name
476
-
;;
477
577
478
578
let pp ppf config =
479
579
let pp_source ppf = function
···
520
620
config.state_dir
521
621
(pp_with_source "runtime_dir")
522
622
config.runtime_dir
523
-
;;
524
-
end
623
+
end
+66
-7
xdg-eio/lib/xdge.mli
+66
-7
xdg-eio/lib/xdge.mli
···
42
42
Eio filesystem. *)
43
43
type t
44
44
45
+
(** {1 Exceptions} *)
46
+
47
+
(** Exception raised when XDG environment variables contain invalid paths.
48
+
49
+
The XDG specification requires all paths in environment variables to be
50
+
absolute. This exception is raised when a relative path is found. *)
51
+
exception Invalid_xdg_path of string
52
+
45
53
(** {1 Construction} *)
46
54
47
55
(** [create fs app_name] creates an XDG context for the given application.
···
62
70
63
71
{b Example:}
64
72
{[
65
-
let xdg = Xdg_eio.create env#fs "myapp" in
66
-
let config = Xdg_eio.config_dir xdg in
73
+
let xdg = Xdge.create env#fs "myapp" in
74
+
let config = Xdge.config_dir xdg in
67
75
(* config is now <fs:$HOME/.config/myapp> or the overridden path *)
68
76
]}
69
77
70
78
{b Note:} All directories are created with permissions 0o755 if they don't exist,
71
-
except for runtime directories which follow stricter requirements. *)
79
+
except for runtime directories which are created with 0o700 permissions and
80
+
validated according to the XDG specification.
81
+
82
+
@raise Invalid_xdg_path if any environment variable contains a relative path *)
72
83
val create : Eio.Fs.dir_ty Eio.Path.t -> string -> t
73
84
74
85
(** {1 Accessors} *)
···
250
261
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_DATA_DIRS specification *)
251
262
val data_dirs : t -> Eio.Fs.dir_ty Eio.Path.t list
252
263
264
+
(** {1 File Search} *)
265
+
266
+
(** [find_config_file t filename] searches for a configuration file following XDG precedence.
267
+
268
+
This function searches for the given filename in the user configuration directory
269
+
first, then in system configuration directories in order of preference.
270
+
Files that are inaccessible (due to permissions, non-existence, etc.) are
271
+
silently skipped as per the XDG specification.
272
+
273
+
@param t The XDG context
274
+
@param filename The name of the file to search for
275
+
@return [Some path] if found, [None] if not found in any directory
276
+
277
+
{b Search Order:}
278
+
1. User config directory ({!config_dir})
279
+
2. System config directories ({!config_dirs}) in preference order
280
+
281
+
{b Example:}
282
+
{[
283
+
match Xdge.find_config_file xdg "myapp.conf" with
284
+
| Some path -> Printf.printf "Found config at: %s\n" (Eio.Path.native_exn path)
285
+
| None -> Printf.printf "No config file found\n"
286
+
]} *)
287
+
val find_config_file : t -> string -> Eio.Fs.dir_ty Eio.Path.t option
288
+
289
+
(** [find_data_file t filename] searches for a data file following XDG precedence.
290
+
291
+
This function searches for the given filename in the user data directory
292
+
first, then in system data directories in order of preference.
293
+
Files that are inaccessible (due to permissions, non-existence, etc.) are
294
+
silently skipped as per the XDG specification.
295
+
296
+
@param t The XDG context
297
+
@param filename The name of the file to search for
298
+
@return [Some path] if found, [None] if not found in any directory
299
+
300
+
{b Search Order:}
301
+
1. User data directory ({!data_dir})
302
+
2. System data directories ({!data_dirs}) in preference order
303
+
304
+
{b Example:}
305
+
{[
306
+
match Xdge.find_data_file xdg "templates/default.txt" with
307
+
| Some path -> (* read from path *)
308
+
| None -> (* use built-in default *)
309
+
]} *)
310
+
val find_data_file : t -> string -> Eio.Fs.dir_ty Eio.Path.t option
311
+
253
312
(** {1 Pretty Printing} *)
254
313
255
314
(** [pp ?brief ?sources ppf t] pretty prints the XDG directory configuration.
···
269
328
{b Example:}
270
329
{[
271
330
(* Normal output *)
272
-
Format.printf "%a" Xdg_eio.pp xdg
331
+
Format.printf "%a" Xdge.pp xdg
273
332
274
333
(* Brief output *)
275
-
Format.printf "%a" (Xdg_eio.pp ~brief:true) xdg
334
+
Format.printf "%a" (Xdge.pp ~brief:true) xdg
276
335
277
336
(* Show sources *)
278
-
Format.printf "%a" (Xdg_eio.pp ~sources:true) xdg
337
+
Format.printf "%a" (Xdge.pp ~sources:true) xdg
279
338
]} *)
280
339
val pp : ?brief:bool -> ?sources:bool -> Format.formatter -> t -> unit
281
340
···
328
387
{b Example:}
329
388
{[
330
389
let open Cmdliner in
331
-
let main xdg =
390
+
let main (xdg, _config) =
332
391
(* use xdg directly *)
333
392
in
334
393
let xdg_term = Cmd.term "myapp" env#fs in
+114
-34
xdg-eio/test/test_paths.ml
+114
-34
xdg-eio/test/test_paths.ml
···
1
-
let () =
1
+
let test_path_validation () =
2
+
Printf.printf "Testing XDG path validation...\n";
3
+
4
+
(* Test absolute path validation for environment variables *)
5
+
let test_relative_path_rejection env_var relative_path =
6
+
Printf.printf "Testing rejection of relative path in %s...\n" env_var;
7
+
Unix.putenv env_var relative_path;
8
+
try
9
+
Eio_main.run @@ fun env ->
10
+
let _ = Xdge.create env#fs "test_validation" in
11
+
Printf.printf "ERROR: Should have rejected relative path\n";
12
+
false
13
+
with
14
+
| Xdge.Invalid_xdg_path msg ->
15
+
Printf.printf "SUCCESS: Correctly rejected relative path: %s\n" msg;
16
+
true
17
+
| exn ->
18
+
Printf.printf "ERROR: Wrong exception: %s\n" (Printexc.to_string exn);
19
+
false
20
+
in
21
+
22
+
let old_config_home = Sys.getenv_opt "XDG_CONFIG_HOME" in
23
+
let old_data_dirs = Sys.getenv_opt "XDG_DATA_DIRS" in
24
+
25
+
let success1 = test_relative_path_rejection "XDG_CONFIG_HOME" "relative/path" in
26
+
let success2 = test_relative_path_rejection "XDG_DATA_DIRS" "rel1:rel2:/abs/path" in
27
+
28
+
(* Restore original env vars *)
29
+
(match old_config_home with
30
+
| Some v -> Unix.putenv "XDG_CONFIG_HOME" v
31
+
| None -> (try Unix.putenv "XDG_CONFIG_HOME" ""; with _ -> ()));
32
+
(match old_data_dirs with
33
+
| Some v -> Unix.putenv "XDG_DATA_DIRS" v
34
+
| None -> (try Unix.putenv "XDG_DATA_DIRS" ""; with _ -> ()));
35
+
36
+
success1 && success2
37
+
38
+
let test_file_search () =
39
+
Printf.printf "\nTesting XDG file search...\n";
40
+
2
41
Eio_main.run @@ fun env ->
3
-
let xdg = Xdge.create env#fs "path_test" in
42
+
let xdg = Xdge.create env#fs "search_test" in
4
43
5
-
(* Test config subdirectory *)
6
-
let profiles_path = Eio.Path.(Xdge.config_dir xdg / "profiles") in
7
-
let profile_file = Eio.Path.(profiles_path / "default.json") in
8
-
(try
9
-
let content = Eio.Path.load profile_file in
10
-
Printf.printf "config file content: %s" (String.trim content)
11
-
with
12
-
| exn -> Printf.printf "config file error: %s" (Printexc.to_string exn));
44
+
(* Create test files *)
45
+
let config_file = Eio.Path.(Xdge.config_dir xdg / "test.conf") in
46
+
let data_file = Eio.Path.(Xdge.data_dir xdg / "test.dat") in
13
47
14
-
(* Test data subdirectory *)
15
-
let db_path = Eio.Path.(Xdge.data_dir xdg / "databases") in
16
-
let db_file = Eio.Path.(db_path / "main.db") in
17
-
(try
18
-
let content = Eio.Path.load db_file in
19
-
Printf.printf "\ndata file content: %s" (String.trim content)
20
-
with
21
-
| exn -> Printf.printf "\ndata file error: %s" (Printexc.to_string exn));
48
+
Eio.Path.save ~create:(`Or_truncate 0o644) config_file "config content";
49
+
Eio.Path.save ~create:(`Or_truncate 0o644) data_file "data content";
22
50
23
-
(* Test cache subdirectory *)
24
-
let cache_path = Eio.Path.(Xdge.cache_dir xdg / "thumbnails") in
25
-
let cache_file = Eio.Path.(cache_path / "thumb1.png") in
26
-
(try
27
-
let content = Eio.Path.load cache_file in
28
-
Printf.printf "\ncache file content: %s" (String.trim content)
29
-
with
30
-
| exn -> Printf.printf "\ncache file error: %s" (Printexc.to_string exn));
51
+
(* Test finding existing files *)
52
+
(match Xdge.find_config_file xdg "test.conf" with
53
+
| Some path ->
54
+
let content = Eio.Path.load path in
55
+
Printf.printf "Found config file: %s\n" (String.trim content)
56
+
| None -> Printf.printf "ERROR: Config file not found\n");
31
57
32
-
(* Test state subdirectory *)
33
-
let logs_path = Eio.Path.(Xdge.state_dir xdg / "logs") in
34
-
let log_file = Eio.Path.(logs_path / "app.log") in
35
-
(try
36
-
let content = Eio.Path.load log_file in
37
-
Printf.printf "\nstate file content: %s\n" (String.trim content)
38
-
with
39
-
| exn -> Printf.printf "\nstate file error: %s\n" (Printexc.to_string exn))
58
+
(match Xdge.find_data_file xdg "test.dat" with
59
+
| Some path ->
60
+
let content = Eio.Path.load path in
61
+
Printf.printf "Found data file: %s\n" (String.trim content)
62
+
| None -> Printf.printf "ERROR: Data file not found\n");
63
+
64
+
(* Test non-existent file *)
65
+
(match Xdge.find_config_file xdg "nonexistent.conf" with
66
+
| Some _ -> Printf.printf "ERROR: Should not have found nonexistent file\n"
67
+
| None -> Printf.printf "Correctly handled nonexistent file\n")
68
+
69
+
let () =
70
+
(* Check if we should run validation tests *)
71
+
if Array.length Sys.argv > 1 && Sys.argv.(1) = "--validate" then (
72
+
let validation_success = test_path_validation () in
73
+
test_file_search ();
74
+
75
+
if validation_success then
76
+
Printf.printf "\nAll path validation tests passed!\n"
77
+
else
78
+
Printf.printf "\nSome validation tests failed!\n"
79
+
) else (
80
+
(* Run original simple functionality test *)
81
+
Eio_main.run @@ fun env ->
82
+
let xdg = Xdge.create env#fs "path_test" in
83
+
84
+
(* Test config subdirectory *)
85
+
let profiles_path = Eio.Path.(Xdge.config_dir xdg / "profiles") in
86
+
let profile_file = Eio.Path.(profiles_path / "default.json") in
87
+
(try
88
+
let content = Eio.Path.load profile_file in
89
+
Printf.printf "config file content: %s" (String.trim content)
90
+
with
91
+
| exn -> Printf.printf "config file error: %s" (Printexc.to_string exn));
92
+
93
+
(* Test data subdirectory *)
94
+
let db_path = Eio.Path.(Xdge.data_dir xdg / "databases") in
95
+
let db_file = Eio.Path.(db_path / "main.db") in
96
+
(try
97
+
let content = Eio.Path.load db_file in
98
+
Printf.printf "\ndata file content: %s" (String.trim content)
99
+
with
100
+
| exn -> Printf.printf "\ndata file error: %s" (Printexc.to_string exn));
101
+
102
+
(* Test cache subdirectory *)
103
+
let cache_path = Eio.Path.(Xdge.cache_dir xdg / "thumbnails") in
104
+
let cache_file = Eio.Path.(cache_path / "thumb1.png") in
105
+
(try
106
+
let content = Eio.Path.load cache_file in
107
+
Printf.printf "\ncache file content: %s" (String.trim content)
108
+
with
109
+
| exn -> Printf.printf "\ncache file error: %s" (Printexc.to_string exn));
110
+
111
+
(* Test state subdirectory *)
112
+
let logs_path = Eio.Path.(Xdge.state_dir xdg / "logs") in
113
+
let log_file = Eio.Path.(logs_path / "app.log") in
114
+
(try
115
+
let content = Eio.Path.load log_file in
116
+
Printf.printf "\nstate file content: %s\n" (String.trim content)
117
+
with
118
+
| exn -> Printf.printf "\nstate file error: %s\n" (Printexc.to_string exn))
119
+
)