[PATCH] load-foreign-library: perform substring match on library files

[soeren@soeren-tempel.net]

From: Sören Tempel <soeren@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 <soeren@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?