all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 44899@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#44899] [PATCH v2 4/4] build-system/gnu: Add 'make-dynamic-linker-cache' phase.
Date: Sat, 28 Nov 2020 11:24:09 +0100	[thread overview]
Message-ID: <20201128102409.3157-6-ludo@gnu.org> (raw)
In-Reply-To: <20201128102409.3157-1-ludo@gnu.org>

* guix/build/gnu-build-system.scm (make-dynamic-linker-cache): New
procedure.
(%standard-phases): Add it.
* guix/build-system/gnu.scm (gnu-build, gnu-cross-build): Add
 #:make-dynamic-linker-cache? and honor it.
---
 guix/build-system/gnu.scm       |  4 ++
 guix/build/gnu-build-system.scm | 68 +++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 2c23197e77..d6c4dc9bbc 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -342,6 +342,7 @@ standard packages used as implicit inputs of the GNU build system."
                     (strip-directories ''("lib" "lib64" "libexec"
                                           "bin" "sbin"))
                     (validate-runpath? #t)
+                    (make-dynamic-linker-cache? #t)
                     (license-file-regexp %license-file-regexp)
                     (phases '%standard-phases)
                     (locale "en_US.utf8")
@@ -410,6 +411,7 @@ packages that must not be referenced."
                   #:patch-shebangs? ,patch-shebangs?
                   #:strip-binaries? ,strip-binaries?
                   #:validate-runpath? ,validate-runpath?
+                  #:make-dynamic-linker-cache? ,make-dynamic-linker-cache?
                   #:license-file-regexp ,license-file-regexp
                   #:strip-flags ,strip-flags
                   #:strip-directories ,strip-directories)))
@@ -497,6 +499,7 @@ is one of `host' or `target'."
                           (strip-directories ''("lib" "lib64" "libexec"
                                                 "bin" "sbin"))
                           (validate-runpath? #t)
+                          (make-dynamic-linker-cache? #t)
                           (license-file-regexp %license-file-regexp)
                           (phases '%standard-phases)
                           (locale "en_US.utf8")
@@ -577,6 +580,7 @@ platform."
                     #:patch-shebangs? ,patch-shebangs?
                     #:strip-binaries? ,strip-binaries?
                     #:validate-runpath? ,validate-runpath?
+                    #:make-dynamic-linker-cache? ,make-dynamic-linker-cache?
                     #:license-file-regexp ,license-file-regexp
                     #:strip-flags ,strip-flags
                     #:strip-directories ,strip-directories))))
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 8fa11f4ea9..5f08b9d6ac 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -712,6 +712,73 @@ which cannot be found~%"
                                          (which binary) rest)))))))))
             outputs))
 
+(define* (make-dynamic-linker-cache #:key outputs
+                                    (make-dynamic-linker-cache? #t)
+                                    #:allow-other-keys)
+  "Create a dynamic linker cache under 'etc/ld.so.cache' in each of the
+OUTPUTS.  This reduces application startup time by avoiding the 'stat' storm
+that traversing all the RUNPATH entries entails."
+  (define (make-cache-for-output directory)
+    (define bin-directories
+      (filter-map (lambda (sub-directory)
+                    (let ((directory (string-append directory "/"
+                                                    sub-directory)))
+                      (and (directory-exists? directory)
+                           directory)))
+                  '("bin" "sbin" "libexec")))
+
+    (define programs
+      ;; Programs that can benefit from the ld.so cache.
+      (append-map (lambda (directory)
+                    (if (directory-exists? directory)
+                        (find-files directory
+                                    (lambda (file stat)
+                                      (and (executable-file? file)
+                                           (elf-file? file))))
+                        '()))
+                  bin-directories))
+
+    (define library-path
+      ;; Directories containing libraries that PROGRAMS depend on,
+      ;; recursively.
+      (delete-duplicates
+       (append-map (lambda (program)
+                     (map dirname (file-needed/recursive program)))
+                   programs)))
+
+    (define cache-file
+      (string-append directory "/etc/ld.so.cache"))
+
+    (define ld.so.conf
+      (string-append (or (getenv "TMPDIR") "/tmp")
+                     "/ld.so.conf"))
+
+    (unless (null? library-path)
+      (mkdir-p (dirname cache-file))
+      (guard (c ((invoke-error? c)
+                 ;; Do not treat 'ldconfig' failure as an error.
+                 (format (current-error-port)
+                         "warning: 'ldconfig' failed:~%")
+                 (report-invoke-error c (current-error-port))))
+        ;; Create a config file to tell 'ldconfig' where to look for the
+        ;; libraries that PROGRAMS need.
+        (call-with-output-file ld.so.conf
+          (lambda (port)
+            (for-each (lambda (directory)
+                        (display directory port)
+                        (newline port))
+                      library-path)))
+
+        (invoke "ldconfig" "-f" ld.so.conf "-C" cache-file)
+        (format #t "created '~a' from ~a library search path entries~%"
+                cache-file (length library-path)))))
+
+  (if make-dynamic-linker-cache?
+      (match outputs
+        (((_ . directories) ...)
+         (for-each make-cache-for-output directories)))
+      (format #t "ld.so cache not built~%")))
+
 (define %license-file-regexp
   ;; Regexp matching license files.
   "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
@@ -791,6 +858,7 @@ which cannot be found~%"
             validate-documentation-location
             delete-info-dir-file
             patch-dot-desktop-files
+            make-dynamic-linker-cache
             install-license-files
             reset-gzip-timestamps
             compress-documentation)))
-- 
2.29.2





  parent reply	other threads:[~2020-11-28 10:25 UTC|newest]

Thread overview: 11+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-11-27  8:33 [bug#44899] [PATCH 0/3] Using 'ld.so.cache' to speed up application startup Ludovic Courtès
2020-11-27  9:05 ` [bug#44899] [PATCH 1/3] gnu: glibc: Load ${ORIGIN}/../etc/ld.so.cache when available Ludovic Courtès
2020-11-27  9:05   ` [bug#44899] [PATCH 2/3] gremlin: Fix typo in docstring Ludovic Courtès
2020-11-27  9:05   ` [bug#44899] [PATCH 3/3] build-system/gnu: Add 'make-dynamic-linker-cache' phase Ludovic Courtès
2020-11-28 10:24 ` [bug#44899] [PATCH v2 0/4] Using 'ld.so.cache' to speed up application startup Ludovic Courtès
2020-11-28 10:24   ` [bug#44899] [PATCH v2 1/4] gremlin: Fix typo in docstring Ludovic Courtès
2020-11-28 10:24   ` [bug#44899] [PATCH v2 2/4] gremlin: Add 'file-needed/recursive' Ludovic Courtès
2020-11-28 10:24   ` [bug#44899] [PATCH v2 3/4] gnu: glibc: Load 'etc/ld.so.cache' in $ORIGIN's store item when available Ludovic Courtès
2020-11-28 10:24   ` [bug#44899] [PATCH v2 3/4] gnu: glibc: Load ${ORIGIN}/../etc/ld.so.cache " Ludovic Courtès
2020-11-28 10:24   ` Ludovic Courtès [this message]
2020-12-01 20:45   ` bug#44899: [PATCH v2 0/4] Using 'ld.so.cache' to speed up application startup Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20201128102409.3157-6-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=44899@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.