01/05: profiles: Do not import the host's srfi-{19,26}.scm files.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit cdc938daf91f159e082c5b81a44b074f7bf6d991
Author: Ludovic Courtès <address@hidden>
Date:   Sun Dec 3 17:14:41 2017 +0100

    profiles: Do not import the host's srfi-{19,26}.scm files.
    
    Previously the "manual-database" derivation would always import the
    host's srfi-{19,26}.scm files in the build side.  In practice this means
    that different users could get different manual-database.drv depending
    on the Guile version they're using in the host.
    
    For example, the (gnu tests install) tests would fail if the host was
    running Guile 2.2.3 because the guest is running 2.2.2, and thus has
    different srfi-{19,26}.scm files.  The manual-database.drv would need to
    be built from source, which would fail because prerequisites were
    missing.
    
    Reported by Mathieu Othacehe <address@hidden>
    at <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29409#96>.
    
    * guix/profiles.scm (manual-database): Do not pass #:modules to
    'gexp->derivation'.  Wrap 'build' gexp in 'with-imported-modules' form.
---
 guix/profiles.scm | 144 +++++++++++++++++++++++++++---------------------------
 1 file changed, 71 insertions(+), 73 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0eb99f4..5ef84e8 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1117,82 +1117,80 @@ the entries in MANIFEST."
     (module-ref (resolve-interface '(gnu packages man)) 'man-db))
 
   (define build
-    #~(begin
-        (use-modules (guix build utils)
-                     (srfi srfi-1)
-                     (srfi srfi-19)
-                     (srfi srfi-26))
-
-        (define entries
-          (filter-map (lambda (directory)
-                        (let ((man (string-append directory "/share/man")))
-                          (and (directory-exists? man)
-                               man)))
-                      '#$(manifest-inputs manifest)))
-
-        (define manpages-collection-dir
-          (string-append (getenv "PWD") "/manpages-collection"))
-
-        (define man-directory
-          (string-append #$output "/share/man"))
-
-        (define (get-manpage-tail-path manpage-path)
-          (let ((index (string-contains manpage-path "/share/man/")))
-            (unless index
-              (error "Manual path doesn't contain \"/share/man/\":"
-                     manpage-path))
-            (string-drop manpage-path (+ index (string-length 
"/share/man/")))))
-
-        (define (populate-manpages-collection-dir entries)
-          (let ((manpages (append-map (cut find-files <> #:stat stat) 
entries)))
-            (for-each (lambda (manpage)
-                        (let* ((dest-file (string-append
-                                           manpages-collection-dir "/"
-                                           (get-manpage-tail-path manpage))))
-                          (mkdir-p (dirname dest-file))
-                          (catch 'system-error
-                            (lambda ()
-                              (symlink manpage dest-file))
-                            (lambda args
-                              ;; Different packages may contain the same
-                              ;; manpage.  Simply ignore the symlink error.
-                              #t))))
-                      manpages)))
-
-        (mkdir-p manpages-collection-dir)
-        (populate-manpages-collection-dir entries)
-
-        ;; Create a mandb config file which contains a custom made
-        ;; manpath. The associated catpath is the location where the database
-        ;; gets generated.
-        (copy-file #+(file-append man-db "/etc/man_db.conf")
-                   "man_db.conf")
-        (substitute* "man_db.conf"
-          (("MANDB_MAP /usr/man                /var/cache/man/fsstnd")
-           (string-append "MANDB_MAP " manpages-collection-dir " "
-                          man-directory)))
-
-        (mkdir-p man-directory)
-        (setenv "MANPATH" (string-join entries ":"))
-
-        (format #t "Creating manual page database for ~a packages... "
-                (length entries))
-        (force-output)
-        (let* ((start-time (current-time))
-               (exit-status (system* #+(file-append man-db "/bin/mandb")
-                                    "--quiet" "--create"
-                                    "-C" "man_db.conf"))
-               (duration (time-difference (current-time) start-time)))
-          (format #t "done in ~,3f s~%"
-                  (+ (time-second duration)
-                     (* (time-nanosecond duration) (expt 10 -9))))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (srfi srfi-1)
+                       (srfi srfi-19)
+                       (srfi srfi-26))
+
+          (define entries
+            (filter-map (lambda (directory)
+                          (let ((man (string-append directory "/share/man")))
+                            (and (directory-exists? man)
+                                 man)))
+                        '#$(manifest-inputs manifest)))
+
+          (define manpages-collection-dir
+            (string-append (getenv "PWD") "/manpages-collection"))
+
+          (define man-directory
+            (string-append #$output "/share/man"))
+
+          (define (get-manpage-tail-path manpage-path)
+            (let ((index (string-contains manpage-path "/share/man/")))
+              (unless index
+                (error "Manual path doesn't contain \"/share/man/\":"
+                       manpage-path))
+              (string-drop manpage-path (+ index (string-length 
"/share/man/")))))
+
+          (define (populate-manpages-collection-dir entries)
+            (let ((manpages (append-map (cut find-files <> #:stat stat) 
entries)))
+              (for-each (lambda (manpage)
+                          (let* ((dest-file (string-append
+                                             manpages-collection-dir "/"
+                                             (get-manpage-tail-path manpage))))
+                            (mkdir-p (dirname dest-file))
+                            (catch 'system-error
+                              (lambda ()
+                                (symlink manpage dest-file))
+                              (lambda args
+                                ;; Different packages may contain the same
+                                ;; manpage.  Simply ignore the symlink error.
+                                #t))))
+                        manpages)))
+
+          (mkdir-p manpages-collection-dir)
+          (populate-manpages-collection-dir entries)
+
+          ;; Create a mandb config file which contains a custom made
+          ;; manpath. The associated catpath is the location where the database
+          ;; gets generated.
+          (copy-file #+(file-append man-db "/etc/man_db.conf")
+                     "man_db.conf")
+          (substitute* "man_db.conf"
+            (("MANDB_MAP       /usr/man                /var/cache/man/fsstnd")
+             (string-append "MANDB_MAP " manpages-collection-dir " "
+                            man-directory)))
+
+          (mkdir-p man-directory)
+          (setenv "MANPATH" (string-join entries ":"))
+
+          (format #t "Creating manual page database for ~a packages... "
+                  (length entries))
           (force-output)
-          (zero? exit-status))))
+          (let* ((start-time (current-time))
+                 (exit-status (system* #+(file-append man-db "/bin/mandb")
+                                       "--quiet" "--create"
+                                       "-C" "man_db.conf"))
+                 (duration (time-difference (current-time) start-time)))
+            (format #t "done in ~,3f s~%"
+                    (+ (time-second duration)
+                       (* (time-nanosecond duration) (expt 10 -9))))
+            (force-output)
+            (zero? exit-status)))))
 
   (gexp->derivation "manual-database" build
-                    #:modules '((guix build utils)
-                                (srfi srfi-19)
-                                (srfi srfi-26))
                     #:local-build? #t))
 
 (define %default-profile-hooks