From: Sören Tempel <soe...@soeren-tempel.net> This patch is a fix for bug #49232 [1]. To summarize this bug, the current load-foreign-library implementation does not load versioned sonames (e.g. libfoo.so.5) which are common on Linux. This is an issue for us at Alpine Linux since we ship unversioned sonames (e.g. libfoo.so) separately. Please refer to the original bug report for details.
This patch attempts to fix this issue by performing a substring match on library files in load-foreign-library. That is, when loading the library file for `libfoo` the new algorithm will perform a substring prefix match and return the first file which starts with `libfoo.so`. Therefore, the new algorithm will match both `libfoo.so.5` and `libfoo.so` while the current algorithm only matched the latter. In order to implement this, the new algorithm has to perform a readdir(2) syscall on directories in $LD_LIBRARY_PATH instead of just checking for the presence of a single file in each directory. Discussion: It may be desirable to make the prefix substring check more strict, presently `libzstd.something` would also match. While I believe it to be unlikely that such files exist in $LD_LIBRARY_PATH we could also perform a substring match against `basename + ext + #\.`, i.e. libzstd.so., libstzstd.so.1, libzstd.so.1.5.2 etc would match but libzstd.something wouldn't. Furthermore, if both libzstd.so.1 and libzstd.so exist in $LD_LIBRARY_PATH then the algorithm proposed here may prefer the former (depending on the readdir(2) file order). * module/system/foreign-library.scm (file-exists-in-path-with-extension): perform a substring match on library files to also match versioned .so files. * modules/system/foreign-library.scm (load-foreign-library): Perform a fuzzy substring search even if the library file contains a path-separator. [1]: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=49232 Signed-off-by: Sören Tempel <soe...@soeren-tempel.net> --- This is my first patch for guile, if I missed anything please let me know. Also, I am not subscribed to the list so please CC me. module/system/foreign-library.scm | 63 +++++++++++++++++-------------- 1 file changed, 34 insertions(+), 29 deletions(-) diff --git a/module/system/foreign-library.scm b/module/system/foreign-library.scm index dc426385f..87e5a3afc 100644 --- a/module/system/foreign-library.scm +++ b/module/system/foreign-library.scm @@ -57,30 +57,33 @@ (else '(".so")))) -(define (has-extension? head exts) - (match exts - (() #f) - ((ext . exts) - (or (string-contains head ext) - (has-extension? head exts))))) - -(define (file-exists-with-extension head exts) - (if (has-extension? head exts) - (and (file-exists? head) head) - (let lp ((exts exts)) - (match exts - (() #f) - ((ext . exts) - (let ((head (string-append head ext))) - (if (file-exists? head) - head - (lp exts)))))))) +(define (filename-matches-with-extension? filename basename exts) + (let lp ((exts exts)) + (match exts + (() #f) + ((ext . exts) + ;; Fuzzy comparison of filename with basename + ext. If the + ;; latter is a prefix of the former, consider it a match. This + ;; allows matching .so files with versions, e.g. libfoo.so.5. + (let ((prefix (string-append basename ext))) + (or (string-prefix? prefix filename) + (lp exts))))))) + +(define (file-exists-in-dir-with-extension dir basename exts) + (let* ((dir-stream (opendir dir)) + (ret (let loop ((fn (readdir dir-stream))) + (and (not (eof-object? fn)) + (if (filename-matches-with-extension? fn basename exts) + (in-vicinity dir fn) + (loop (readdir dir-stream))))))) + (closedir dir-stream) + ret)) (define (file-exists-in-path-with-extension basename path exts) (match path (() #f) ((dir . path) - (or (file-exists-with-extension (in-vicinity dir basename) exts) + (or (file-exists-in-dir-with-extension dir basename exts) (file-exists-in-path-with-extension basename path exts))))) (define path-separator @@ -198,16 +201,18 @@ name." (dlopen* #f)) ((or (absolute-file-name? filename) (string-any file-name-separator? filename)) - (cond - ((or (file-exists-with-extension filename extensions) - (and search-ltdl-library-path? - (file-exists-with-extension - (in-vicinity (in-vicinity (dirname filename) ".libs") - (basename filename)) - extensions))) - => dlopen*) - (else - (error-not-found)))) + (let ((dirname (dirname filename)) + (basename (basename filename))) + (cond + ((or (file-exists-in-dir-with-extension dirname basename extensions) + (and search-ltdl-library-path? + (file-exists-in-dir-with-extension + (in-vicinity dirname ".libs") + basename + extensions))) + => dlopen*) + (else + (error-not-found))))) ((file-exists-in-path-with-extension filename search-path extensions) => dlopen*) (search-system-paths?
