ENHANCED: allow user:exception for missing shlibs, save dependencies

This patch allows the user to load a shared library from the
network or from the saved state by means of writing the
user:exception hook.

It also provides qsave_foreign_libraries/4 to retrieve
foreign libraries (for a compatible architecture) from
the saved state. This makes it easier to implement the
user:exception hook, while abstracting from the internal
naming of the shared libraries in the saved state.

Accordingly qsave_program/2 is also enhanced to store
dependencies for the main shared library.

Test cases are also provided.

library/qsave.pl

@@ -38,10 +38,13 @@
           [ qsave_program/1,                    % +File
             qsave_program/2                     % +File, +Options
           ]).
+:- use_module(library(shlib)).
 :- use_module(library(lists)).
 :- use_module(library(option)).
 :- use_module(library(error)).
 :- use_module(library(apply)).
+:- use_module(library(zip)).
+:- use_module(library(prolog_autoload)).
 
 /** <module> Save current program as a state or executable
 
@@ -927,11 +930,17 @@
 
 save_foreign_libraries1(Arch, RC, _Options) :-
     forall(current_foreign_library(FileSpec, _Predicates),
-           ( find_foreign_library(Arch, FileSpec, EntryName, File, Time),
-             term_to_atom(EntryName, Name),
-             zipper_append_file(RC, Name, File, [time(Time)])
+           ( find_foreign_library(Arch, FileSpec, Entries),
+             add_shlibs_to_zip(RC, Entries)
            )).
 
+add_shlibs_to_zip(RC, [_{entry: Entry, sofile: File, time: Time}|Entries]) :-
+    term_to_atom(Entry, Name),
+    zipper_append_file(RC, Name, File, [time(Time)]),
+    add_shlibs_to_zip(RC, Entries).
+add_shlibs_to_zip(_, []).
+
+
 %!  find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time)
 %!								is det.
 %
@@ -944,17 +953,36 @@
 %
 %   @bug    Should perform OS search on failure
 
-find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :-
-    FileSpec = foreign(Name),
-    (   catch(arch_find_shlib(Arch, FileSpec, File),
+find_foreign_library(Arch, FileSpec, [MainEntry|Entries]) :-
+    (   catch(arch_find_shlib(Arch, FileSpec, File, DepFiles),
               E,
               print_message(error, E)),
-        exists_file(File)
+        exists_files([File|DepFiles])
     ->  true
     ;   throw(error(existence_error(architecture_shlib(Arch), FileSpec),_))
     ),
+    time_and_strip_entries(Arch, FileSpec, main, [File], [MainEntry]),
+    time_and_strip_entries(Arch, FileSpec, dep, DepFiles, Entries).
+
+time_and_strip_entries(Arch, FileSpec, Type, [File|Files],
+                       [ _{ entry:  '$shlib'(Arch, FileSpec, BaseName, Type),
+                            sofile: SharedObject,
+                            time:   Time}
+                       |Entries]) :-
+    file_base_name(File, BaseName),
     time_file(File, Time),
-    strip_file(File, SharedObject).
+    strip_file(File, SharedObject),
+    time_and_strip_entries(Arch, FileSpec, Type, Files, Entries).
+time_and_strip_entries(_, _, _, [], []).
+
+exists_files([File|Files]) :-
+    (   exists_file(File)
+    ->  true
+    ;   print_message(error, existence_error(file, File)),
+        fail
+    ),
+    exists_files(Files).
+exists_files([]).
 
 %!  strip_file(+File, -Stripped) is det.
 %
@@ -982,24 +1010,29 @@
     shell(Cmd),
     exists_file(Stripped).
 
-%!  qsave:arch_shlib(+Architecture, +FileSpec, -File) is det.
+%!  qsave:arch_shlib(+Architecture, +FileSpec, -File, -DepFiles) is det.
 %
-%   This is a user defined hook called by qsave_program/2. It is used to
-%   find a shared library  for  the   specified  Architecture,  named by
-%   FileSpec. FileSpec is of  the   form  foreign(Name), a specification
-%   usable by absolute_file_name/2. The predicate should unify File with
-%   the absolute path for the  shared   library  that corresponds to the
-%   specified Architecture.
+%   This  is  a  user  defined  hook called  by  qsave_program/2.  It  is
+%   used  to  find  a  shared   library  and  its  dependencies  for  the
+%   specified  Architecture,  named  by  FileSpec.  FileSpec  is  of  the
+%   form foreign(Name),  a specification usable  by absolute_file_name/2.
+%   The  predicate should  unify  File  with the  absolute  path for  the
+%   shared library  that corresponds  to the specified  Architecture, and
+%   DepFiles with  a list of shared  libraries that need to  be loaded as
+%   dependencies. If there are no dependencies the DepFiles should be
+%   bound to [].
 %
 %   If  this  predicate  fails  to  find    a  file  for  the  specified
 %   architecture an `existence_error` is thrown.
 
-:- multifile arch_shlib/3.
+:- multifile arch_shlib/4.
 
-arch_find_shlib(Arch, FileSpec, File) :-
-    arch_shlib(Arch, FileSpec, File),
+arch_find_shlib(Arch, FileSpec, File, DepFiles) :-
+    arch_shlib(Arch, FileSpec, File, DepFiles),
+    must_be(list, DepFiles),
+    must_be(atom, File),
     !.
-arch_find_shlib(Arch, FileSpec, File) :-
+arch_find_shlib(Arch, FileSpec, File, []) :-
     current_prolog_flag(arch, Arch),
     absolute_file_name(FileSpec,
                        [ file_type(executable),

library/shlib.pl

@@ -45,9 +45,15 @@
             use_foreign_library/1,      % :LibFile
             use_foreign_library/2,      % :LibFile, +InstallFunc
 
+            qsave_foreign_libraries/4,  % ?Arch, +Spec, -Resources, +Options
+
             win_add_dll_directory/1     % +Dir
           ]).
-:- use_module(library(lists), [reverse/2]).
+:- use_module(library(lists), [member/2, reverse/2]).
+:- use_module(library(error), [must_be/2]).
+:- use_module(library(zip)).
+:- use_module(library(apply)).
+:- use_module(library(option)).
 :- set_prolog_flag(generate_debug_info, false).
 
 /** <module> Utility library for loading foreign objects (DLLs, shared objects)
@@ -148,11 +154,10 @@
 
 find_library(Spec, TmpFile, true) :-
     '$rc_handle'(Zipper),
-    term_to_atom(Spec, Name),
     setup_call_cleanup(
         zip_lock(Zipper),
         setup_call_cleanup(
-            open_foreign_in_resources(Zipper, Name, In),
+            open_foreign_in_resources(Zipper, Spec, In),
             setup_call_cleanup(
                 tmp_file_stream(binary, TmpFile, Out),
                 copy_stream_data(In, Out),
@@ -174,8 +179,31 @@
 find_library(foreign(Spec), Spec, false) :-
     atom(Spec),
     !.                  % use machines finding schema
-find_library(Spec, _, _) :-
-    throw(error(existence_error(source_sink, Spec), _)).
+find_library(Spec, Path, Delete) :-
+    current_prolog_flag(arch, Arch),
+    try_user_exception(error(existence_error(source_sink, Spec), _),
+                       find_library(Spec, Path, Delete),
+                       _{arch: Arch, file: Spec}).
+
+:- dynamic '$user_exception_called'/2.
+try_user_exception(Throw, _RetryGoal, Context) :-
+    '$user_exception_called'(missing_shared_object, Context),
+    retractall('$user_exception_called'(missing_shared_object, Context)),
+    throw(Throw),
+    !.  % Allow only one retry
+
+try_user_exception(Throw, RetryGoal, _{arch: Arch, file: Spec}) :-
+    (   user:exception(missing_shared_object,
+                       _{arch: Arch, file: Spec},
+                       Action)
+    ->  (   Action == retry
+        ->  asserta('$user_exception_called'(missing_shared_object,
+                                             _{arch: Arch, file: Spec})),
+            call(RetryGoal)
+        ;   throw(Throw)
+        )
+    ;   throw(Throw)
+    ).
 
 %!  lib_to_file(+Lib0, -Lib, -Copy) is det.
 %
@@ -208,18 +236,77 @@
 lib_to_file(Lib, Lib, false).
 
 
-open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :-
-    term_to_atom(foreign(Name), ForeignSpecAtom),
-    zipper_members(Zipper, Entries),
-    entries_for_name(Name, Entries, Entries1),
-    compatible_architecture_lib(Entries1, Name, CompatibleLib),
-    zipper_goto(Zipper, file(CompatibleLib)),
+open_foreign_in_resources(Zipper, Spec, Stream) :-
+    current_prolog_flag(arch, Arch),
+    qsave_foreign_libraries(Arch, Spec, [CompatLib],
+                                 [main, plain]),
+    zipper_goto(Zipper, file(CompatLib.entry)),
     zipper_open_current(Zipper, Stream,
                         [ type(binary),
                           release(true)
                         ]).
 
-%!  compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det.
+%!  qsave_foreign_libraries(+Arch, +FileSpec, -Resources, +Options).
+%
+%   Get list of foreign libraries compatible with Arch in the
+%   current saved state.
+%
+%   Multi-architecture foreign  libraries can  be stored in  the saved
+%   state by  qsave_program/2. See the `foreign`  option. Resources is
+%   unified with  a list of  file paths (in  the saved state)  for the
+%   foreign  library  named  by  FileSpec. FileSpec  is  of  the  form
+%   `foreign(Name)`.  Each resource  starts  with `res://`  so it  can
+%   be  used with  most  file predicates,  including copy_file/2.  The
+%   predicate  can  return the  main  foreign  library (which  defines
+%   prolog  predicates  in  a   foreign  language)  and  possibly  its
+%   dependencies according to the options.
+%
+%   See  qsave_program/2   to  find  out   about  how  to   store  the
+%   dependencies of  a shared  object.
+%
+%   This predicate  also calls the qsave:compat_arch/2  hook to obtain
+%   files compatible with Arch, see qsave_program/2.
+%
+%   The possible options are:
+%   * main
+%   Return only the main foreign library compatible with Arch.
+%   Resources is a list with one element.
+%   * main_and_deps
+%   Return the main foreign lirary and any dependencies that
+%   were stored in the saved state. Resources is a list in this
+%   case. This is the default option.
+%   * plain
+%   Do not return entries with the `res://` prefix, but
+%   just the plain entry name in the saved state. This can
+%   be used if you want to access the object directly using
+%   `library(zip)`, but this should be rare.
+%
+%   @see qsave_program/2.
+qsave_foreign_libraries(Arch, FileSpec, Resources, Options) :-
+    must_be(list(oneof([main,main_and_deps,deps,plain])), Options),
+    '$rc_handle'(Zipper),
+    zipper_members(Zipper, Entries),
+    entries_for_name(FileSpec, Entries, Entries1),
+    (   option(main, Options)
+    ->  Type = main
+    ;   option(main_and_deps, Options)
+    ->  Type = _
+    ;   option(deps, Options)
+    ->  Type = dep
+    ;   Type = _
+    ),
+    libs_for_compat_arch(FileSpec, Entries1, Type, Arch,  Es),
+    (   option(plain, Options)
+    ->  Resources = Es
+    ;   maplist(entry_resource, Es, Resources)
+    ).
+
+entry_resource(EntryDict, ResDict) :-
+    format(atom(Res), 'res://~w', [EntryDict.entry]),
+    ResDict = EntryDict.put(entry, Res).
+
+
+%!  lib_for_compat_arch(+Entries, +FileSpec, -CompatibleLib) is det.
 %
 %   Entries is a list of entries  in   the  zip  file, which are already
 %   filtered to match the  shared  library   identified  by  `Name`. The
@@ -230,17 +317,21 @@
 %   determined according to the description in qsave_program/2 using the
 %   qsave:compat_arch/2 hook.
 %
-%   The entries are of the form 'shlib(Arch, Name)'
-
-compatible_architecture_lib([], _, _) :- !, fail.
-compatible_architecture_lib(Entries, Name, CompatibleLib) :-
-    current_prolog_flag(arch, HostArch),
-    (   member(shlib(EntryArch, Name), Entries),
-        qsave_compat_arch1(HostArch, EntryArch)
-    ->  term_to_atom(shlib(EntryArch, Name), CompatibleLib)
-    ;   existence_error(arch_compatible_with(Name), HostArch)
-    ).
+%   The entries are of the form ''$shlib'(Arch, Name, BaseSoName)'
+
+libs_for_compat_arch(FileSpec, Entries, Type, Arch, Libs) :-
+    findall(Lib,
+            lib_for_compat_arch(Arch, Type, Entries, FileSpec, Lib),
+            Libs).
+
+lib_for_compat_arch(Arch, Type, Entries, FileSpec,
+                    _{entry: Entry, basename: BaseName, type: Type}) :-
+    LibTerm = '$shlib'(EntryArch, FileSpec, BaseName, Type),
+    member(LibTerm, Entries),
+    qsave_compat_arch1(Arch, EntryArch),
+    term_to_atom(LibTerm, Entry).
 
+:- multifile qsave:compat_arch/2.
 qsave_compat_arch1(Arch1, Arch2) :-
     qsave:compat_arch(Arch1, Arch2), !.
 qsave_compat_arch1(Arch1, Arch2) :-
@@ -258,17 +349,18 @@
 
 qsave:compat_arch(A,A).
 
-shlib_atom_to_term(Atom, shlib(Arch, Name)) :-
-    sub_atom(Atom, 0, _, _, 'shlib('),
+shlib_atom_to_term(Atom, Term) :-
+    Term = '$shlib'(_Arch, _FileSpec, _BaseSoName, _Type),
+    sub_atom(Atom, 0, _, _, '''$shlib''('),
     !,
-    term_to_atom(shlib(Arch,Name), Atom).
+    term_to_atom(Term, Atom).
 shlib_atom_to_term(Atom, Atom).
 
-match_filespec(Name, shlib(_,Name)).
+match_filespec(FileSpec, '$shlib'(_, FileSpec, _, _)).
 
-entries_for_name(Name, Entries, Filtered) :-
+entries_for_name(FileSpec, Entries, Filtered) :-
     maplist(shlib_atom_to_term, Entries, Entries1),
-    include(match_filespec(Name), Entries1, Filtered).
+    include(match_filespec(FileSpec), Entries1, Filtered).
 
 base(Path, Base) :-
     atomic(Path),
@@ -355,12 +447,17 @@
                                     install(Path, Entries)),
                     _))
     ).
-load_foreign_library(LibFile, _, _) :-
+load_foreign_library(LibFile, Module, Entry) :-
+    current_prolog_flag(arch, Arch),
     retractall(loading(LibFile)),
     (   error(_Path, E)
     ->  retractall(error(_, _)),
-        throw(E)
-    ;   throw(error(existence_error(foreign_library, LibFile), _))
+        try_user_exception(E,
+                           load_foreign_library(LibFile, Module, Entry),
+                           _{arch: Arch, file: LibFile})
+    ;   try_user_exception(error(existence_error(foreign_library, LibFile), _),
+                           load_foreign_library(LibFile, Module, Entry),
+                           _{arch: Arch, file: LibFile})
     ).
 
 delete_foreign_lib(true, Path) :-
@@ -557,3 +654,5 @@
     [ 'No install function in ~q'-[Lib], nl,
       '\tTried: ~q'-[List]
     ].
+
+% vim: set sw=4 ft=prolog :

man/hack.doc

@@ -471,6 +471,38 @@ predicates.  See also \prologflag{unknown} and \secref{autoload}.
 \arg{Context} is instantiated to the name of the missing global
 variable. The hook must call nb_setval/2 or b_setval/2 before returning
 with the action \const{retry}.
+
+    \termitem{missing_shared_object}{}
+\arg{Context} is instantiated to _{ arch: Arch, file: FileSpec },
+which points to the required architecture and `FileSpec` for the
+missing shared library. \arg{Action} can be unified with error, to
+throw an exception or with retry, in order to try to reload the
+missing library Normally the hook will obtain the missing library
+from the network, or a required dependency from the saved state (see
+qsave_foreign_libraries/4), and put them in a directory where the
+system dynamic linker can find it. The following example loads a
+required depdency from the saved state:
+
+\begin{code}
+:- use_foreign_library('input/shlib_with_dep.so').
+
+:- assertz((
+    user:exception(missing_shared_object,
+                   _{ arch: _, file: Spec },
+                   retry) :-
+        handle_missing_shlib(Spec)
+
+   )).
+
+handle_missing_shlib(Spec) :-
+        Spec = 'input/shlib_with_dep.so',
+        qsave_foreign_libraries(Arch, 'input/shlib_with_dep.so', [Dep], [deps]),
+        copy_file(Dep.entry,'libdep.so'). % linker finds it in current dir
+
+% here put some code that calls predicates in shlib_with_dep.so
+
+\end{code}
+
 \end{description}
 \end{description}