Dune sites plugin with dots

CHANGES.md

@@ -1,6 +1,8 @@
 Unreleased
 ----------
 
+- Fix plugins with dot in the name (#5182, @bobot, review @rgrinberg)
+
 - Fix installation of implementations of virtual libraries (#5150, fix #3636,
   @rgrinberg)
 

otherlibs/site/src/plugins/plugins.ml

@@ -7,6 +7,16 @@ let readdir dirs =
        (fun dir -> Array.to_list (Sys.readdir dir))
        (List.filter Sys.file_exists dirs))
 
+let rec lookup dirs file =
+  match dirs with
+  | [] -> None
+  | dir :: dirs ->
+    let file' = Filename.concat dir file in
+    if Sys.file_exists file' then
+      Some file'
+    else
+      lookup dirs file
+
 module type S = sig
   val paths : string list
 
@@ -57,11 +67,49 @@ let rec get_plugin plugins requires entries =
     get_plugin plugins (value :: requires) entries
   | Rule _ :: entries -> get_plugin plugins requires entries
 
-exception Library_not_found of string
-
 exception Thread_library_required_by_plugin_but_not_required_by_main_executable
 
-let rec find_library ~suffix directory meta =
+exception
+  Library_not_found of
+    { search_paths : string list
+    ; prefix : string list
+    ; name : string
+    }
+
+exception
+  Plugin_not_found of
+    { search_paths : string list
+    ; name : string
+    }
+
+let () =
+  Printexc.register_printer (function
+    | Thread_library_required_by_plugin_but_not_required_by_main_executable ->
+      Some
+        (Format.asprintf "%a" Format.pp_print_text
+           "It is not possible to dynamically link a plugin which uses the \
+            thread library with an executable not already linked with the \
+            thread library.")
+    | Plugin_not_found { search_paths; name } ->
+      Some
+        (Format.sprintf "The plugin %S can't be found in the search paths %S."
+           name
+           (String.concat ":" search_paths))
+    | Library_not_found { search_paths; prefix = []; name } ->
+      Some
+        (Format.sprintf "The library %S can't be found in the search paths %S."
+           name
+           (String.concat ":" search_paths))
+    | Library_not_found { search_paths; prefix; name } ->
+      Some
+        (Format.sprintf
+           "The sub-library %S can't be found in the library %s in the search \
+            paths %S."
+           name (String.concat "." prefix)
+           (String.concat ":" search_paths))
+    | _ -> None)
+
+let rec find_library ~dirs ~prefix ~suffix directory meta =
   let rec find_directory directory = function
     | [] -> directory
     | Meta_parser.Rule
@@ -77,10 +125,13 @@ let rec find_library ~suffix directory meta =
   | pkg :: suffix ->
     let directory = find_directory directory meta in
     let rec aux pkg = function
-      | [] -> raise (Library_not_found pkg)
+      | [] ->
+        raise
+          (Library_not_found
+             { search_paths = dirs; prefix = List.rev prefix; name = pkg })
       | Meta_parser.Package { name = Some name; entries } :: _
         when String.equal name pkg ->
-        find_library ~suffix directory entries
+        find_library ~dirs ~prefix:(pkg :: prefix) ~suffix directory entries
       | _ :: entries -> aux pkg entries
     in
     aux pkg meta
@@ -114,8 +165,11 @@ let extract_comma_space_separated_words s =
 
 let split_all l = List.concat (List.map extract_comma_space_separated_words l)
 
-let find_plugin ~dir ~suffix meta =
-  let directory, meta = find_library ~suffix None meta.Meta_parser.entries in
+let find_plugin ~dirs ~dir ~suffix (meta : Meta_parser.t) =
+  let directory, meta =
+    find_library ~dirs ~prefix:(Option.to_list meta.name) ~suffix None
+      meta.entries
+  in
   let plugins, requires = get_plugin [] [] meta in
   let directory =
     match directory with
@@ -166,26 +220,28 @@ let lookup_and_load_one_dir ~dir ~pkg =
     else
       None
 
-let split name =
+let split ~dirs name =
   match String.split_on_char '.' name with
-  | [] -> raise (Library_not_found name)
+  | [] -> raise (Library_not_found { search_paths = dirs; prefix = []; name })
   | pkg :: rest -> (pkg, rest)
 
-let lookup_and_summarize dirs name =
-  let pkg, suffix = split name in
+let lookup_and_summarize alldirs name =
+  let pkg, suffix = split ~dirs:alldirs name in
   let rec loop dirs =
     match dirs with
     | [] -> (
       List.assoc_opt pkg Data.builtin_library |> function
-      | None -> raise (Library_not_found name)
-      | Some meta -> find_plugin ~dir:(Lazy.force Helpers.stdlib) ~suffix meta)
+      | None ->
+        raise (Library_not_found { search_paths = alldirs; prefix = []; name })
+      | Some meta ->
+        find_plugin ~dirs:alldirs ~dir:(Lazy.force Helpers.stdlib) ~suffix meta)
     | dir :: dirs -> (
       let dir = Filename.concat dir pkg in
       match lookup_and_load_one_dir ~dir ~pkg with
       | None -> loop dirs
-      | Some p -> find_plugin ~dir ~suffix p)
+      | Some p -> find_plugin ~dirs:alldirs ~dir ~suffix p)
   in
-  loop dirs
+  loop alldirs
 
 let loaded_libraries =
   lazy
@@ -212,7 +268,15 @@ let load_gen ~load_requires dirs name =
 let rec load_requires name =
   load_gen ~load_requires (Lazy.force Helpers.ocamlpath) name
 
-let load_plugin plugin_paths name = load_gen ~load_requires plugin_paths name
+let load_plugin plugin_paths name =
+  match lookup plugin_paths (Filename.concat name meta_fn) with
+  | None -> raise (Plugin_not_found { search_paths = plugin_paths; name })
+  | Some meta_file ->
+    let meta = load meta_file ~pkg:name in
+    let plugins, requires = get_plugin [] [] meta.entries in
+    assert (plugins = []);
+    let requires = split_all requires in
+    List.iter load_requires requires
 
 module Make (X : sig
   val paths : string list

otherlibs/site/test/plugin_require_thread.t/run.t

@@ -2,7 +2,9 @@
   $ dune build ./app.exe @install
   $ dune exec ./app.exe
   The library is being used by two plugins finished initialization
-  Error during dynamic linking: Dune_site_plugins__Plugins.Thread_library_required_by_plugin_but_not_required_by_main_executableMain app starts...
+  Error during dynamic linking: It is not possible to dynamically link a plugin which uses the thread library
+  with an executable not already linked with the thread
+  library.Main app starts...
 
   $ sed -e "s/;TOREMOVE//" dune > dune.tmp
   $ mv -f dune.tmp dune

otherlibs/site/test/plugin_with_dot.t

@@ -0,0 +1,106 @@
+  $ mkdir -p b c
+
+  $ for i in b; do
+  > mkdir -p $i
+  > cat >$i/dune-project <<EOF
+  > (lang dune 3.0)
+  > (using dune_site 0.1)
+  > (name $i)
+  > (package (name $i) (depends c))
+  > EOF
+  > done
+
+  $ for i in c; do
+  >   mkdir -p $i
+  >   cat >$i/dune-project <<EOF
+  > (lang dune 3.0)
+  > (using dune_site 0.1)
+  > (name $i)
+  > (package (name $i) (sites (share data) (lib plugins)))
+  > EOF
+  > done
+
+  $ cat >b/dune <<EOF
+  > (library
+  >  (public_name b.b.b)
+  >  (name b)
+  >  (libraries c.register dune-site))
+  > (generate_sites_module (module sites) (sites b))
+  > (plugin (name c-plugins-b.b) (libraries b.b.b) (site (c plugins)))
+  > EOF
+
+  $ cat >b/b.ml <<EOF
+  > let v = "b"
+  > let () = Printf.printf "run b\n%!"
+  > let () = C_register.registered := "b"::!C_register.registered
+  > EOF
+
+  $ cat >c/dune <<EOF
+  > (executable
+  >  (public_name c)
+  >  (promote (until-clean))
+  >  (modules c sites)
+  >  (libraries c.register dune-site dune-site.plugins))
+  > (library
+  >  (public_name c.register)
+  >  (name c_register)
+  >  (modules c_register))
+  > (generate_sites_module (module sites) (plugins (c plugins)))
+  > (rule
+  >  (targets out.log)
+  >  (deps (package c))
+  >  (action (with-stdout-to out.log (run %{bin:c} "c-plugins-b.b"))))
+  > EOF
+
+  $ cat >c/c_register.ml <<EOF
+  > let registered : string list ref = ref []
+  > EOF
+
+  $ cat >c/c.ml <<EOF
+  > let () = try Sites.Plugins.Plugins.load Sys.argv.(1)
+  >          with exn -> print_endline (Printexc.to_string exn)
+  > let () = Printf.printf "run c: registered:%s.\n%!" (String.concat "," !C_register.registered)
+  > EOF
+
+  $ cat > dune-project << EOF
+  > (lang dune 2.2)
+  > EOF
+
+Build everything
+----------------
+
+  $ dune build
+
+Test with dune exec
+--------------------------------
+  $ dune exec -- c/c.exe "c-plugins-b.b"
+  run b
+  run c: registered:b.
+
+Test error messages
+--------------------------------
+  $ dune exec -- c/c.exe "inexistent"
+  The plugin "inexistent" can't be found in the search paths "$TESTCASE_ROOT/_build/install/default/lib/c/plugins".
+  run c: registered:.
+
+  $ cat >c/c.ml <<EOF
+  > let l = Lazy.force Dune_site.Private_.Helpers.ocamlpath
+  > let l = List.map (Printf.sprintf "OCAMLPATH=%s") l
+  > let () = print_string (String.concat ":" l)
+  > EOF
+
+  $ export BUILD_PATH_PREFIX_MAP="$(dune exe -- c/c.exe):$BUILD_PATH_PREFIX_MAP"
+
+  $ cat >c/c.ml <<EOF
+  > let () = try Dune_site_plugins.V1.load Sys.argv.(1)
+  >          with exn -> print_endline (Printexc.to_string exn)
+  > EOF
+
+  $ dune exec -- c/c.exe "inexistent" 2>&1 | sed -e 's&default/lib:.*&default/lib:..."&g'
+  The library "inexistent" can't be found in the search paths "$TESTCASE_ROOT/_build/install/default/lib:..."
+
+  $ dune exec -- c/c.exe "b.b.b"
+  run b
+
+  $ dune exec -- c/c.exe "b.b.inexistent" 2>&1  | sed -e 's&default/lib:.*&default/lib:..."&g'
+  The sub-library "inexistent" can't be found in the library b.b in the search paths "$TESTCASE_ROOT/_build/install/default/lib:..."