this repo has no description
Fix path relativization for packages in different directory trees
When running under dune exec, packages may be installed in different
directory trees (dune install vs opam). Fpath.relativize produces paths
with ".." in these cases, which breaks the output directory structure.
The fix detects ".." in relativized paths and falls back to extracting
path components after the "lib" directory.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+30
-7
+30
-7
bin/jtw.ml
+30
-7
bin/jtw.ml
···
1
+
(** Try to relativize a path against findlib_dir. If the result contains
2
+
".." (indicating the path is in a different tree), fall back to extracting
3
+
the path components after "lib" directory. *)
4
+
let relativize_or_fallback ~findlib_dir path =
5
+
(* First try standard relativize *)
6
+
let rel = match Fpath.relativize ~root:findlib_dir path with
7
+
| Some rel -> rel
8
+
| None -> path (* shouldn't happen for absolute paths, but fallback *)
9
+
in
10
+
(* If the result contains "..", use fallback instead *)
11
+
let segs = Fpath.segs rel in
12
+
if List.mem ".." segs then begin
13
+
(* Fallback: use path components after "lib" directory *)
14
+
let path_segs = Fpath.segs path in
15
+
let rec find_after_lib = function
16
+
| [] -> Fpath.v (Fpath.basename path)
17
+
| "lib" :: rest -> Fpath.v (String.concat Fpath.dir_sep rest)
18
+
| _ :: rest -> find_after_lib rest
19
+
in
20
+
find_after_lib path_segs
21
+
end else
22
+
rel
23
+
1
24
let cmi_files dir =
2
25
Bos.OS.Dir.fold_contents ~traverse:`None ~elements:`Files
3
26
(fun path acc ->
···
22
45
in
23
46
let prefixes = Util.StringSet.(of_list prefixes |> to_list) in
24
47
let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
25
-
let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in
48
+
let d = relativize_or_fallback ~findlib_dir dir in
26
49
(* Include path_prefix in dcs_url so it's correct relative to HTTP root *)
27
50
let dcs_url_path = match path_prefix with
28
51
| Some prefix -> Fpath.(v prefix / "lib" // d)
···
154
177
155
178
List.iter
156
179
(fun (dir, files) ->
157
-
let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in
180
+
let d = relativize_or_fallback ~findlib_dir dir in
158
181
List.iter
159
182
(fun f ->
160
183
let dest_dir = Fpath.(output_dir / "lib" // d) in
···
215
238
| Ok dir ->
216
239
let archives = Ocamlfind.archives sub_lib in
217
240
let archives = List.map (fun x -> Fpath.(dir / x)) archives in
218
-
let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in
241
+
let d = relativize_or_fallback ~findlib_dir dir in
219
242
let dest = Fpath.(output_dir / "lib" // d) in
220
243
let (_ : (bool, _) result) = Bos.OS.Dir.create dest in
221
244
let compile_archive archive =
···
303
326
List.iter (fun dir ->
304
327
match cmi_files dir with
305
328
| Ok files ->
306
-
let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in
329
+
let d = relativize_or_fallback ~findlib_dir dir in
307
330
List.iter (fun f ->
308
331
let dest_dir = Fpath.(pkg_output_dir / "lib" // d) in
309
332
let dest = Fpath.(dest_dir / f) in
···
318
341
319
342
(* Copy META file *)
320
343
let meta_file = Fpath.v (Ocamlfind.meta_file pkg) in
321
-
let meta_rel = Fpath.relativize ~root:findlib_dir meta_file |> Option.get |> Fpath.parent in
344
+
let meta_rel = relativize_or_fallback ~findlib_dir meta_file |> Fpath.parent in
322
345
let meta_dest = Fpath.(pkg_output_dir / "lib" // meta_rel) in
323
346
let _ = Bos.OS.Dir.create ~path:true meta_dest in
324
347
Util.cp meta_file meta_dest;
···
332
355
| Ok lib_dir ->
333
356
let archives = Ocamlfind.archives lib in
334
357
let archives = List.map (fun x -> Fpath.(lib_dir / x)) archives in
335
-
let d = Fpath.relativize ~root:findlib_dir lib_dir |> Option.get in
358
+
let d = relativize_or_fallback ~findlib_dir lib_dir in
336
359
let dest = Fpath.(pkg_output_dir / "lib" // d) in
337
360
let _ = Bos.OS.Dir.create ~path:true dest in
338
361
List.iter (fun archive ->
···
361
384
| x :: _ -> Some (x ^ "__")
362
385
| _ -> None) hidden in
363
386
let prefixes = Util.StringSet.(of_list prefixes |> to_list) in
364
-
let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in
387
+
let d = relativize_or_fallback ~findlib_dir dir in
365
388
(* Include pkg_path in dcs_url so it's correct relative to the HTTP root *)
366
389
let dcs = {
367
390
Js_top_worker_rpc.Toplevel_api_gen.dcs_url = Fpath.(v pkg_path / "lib" // d |> to_string);