ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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 <m.othacehe@gmail.com>
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.
This commit is contained in:
Ludovic Courtès 2017-12-03 17:14:41 +01:00
parent d112e5a8c2
commit cdc938daf9
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 62 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

126
guix/profiles.scm
View file

@ -1117,82 +1117,80 @@ (define man-db ;lazy reference
(module-ref (resolve-interface '(gnu packages man)) 'man-db)) (module-ref (resolve-interface '(gnu packages man)) 'man-db))
(define build (define build
#~(begin (with-imported-modules '((guix build utils))
(use-modules (guix build utils) #~(begin
(srfi srfi-1) (use-modules (guix build utils)
(srfi srfi-19) (srfi srfi-1)
(srfi srfi-26)) (srfi srfi-19)
(srfi srfi-26))
(define entries (define entries
(filter-map (lambda (directory) (filter-map (lambda (directory)
(let ((man (string-append directory "/share/man"))) (let ((man (string-append directory "/share/man")))
(and (directory-exists? man) (and (directory-exists? man)
man))) man)))
'#$(manifest-inputs manifest))) '#$(manifest-inputs manifest)))
(define manpages-collection-dir (define manpages-collection-dir
(string-append (getenv "PWD") "/manpages-collection")) (string-append (getenv "PWD") "/manpages-collection"))
(define man-directory (define man-directory
(string-append #$output "/share/man")) (string-append #$output "/share/man"))
(define (get-manpage-tail-path manpage-path) (define (get-manpage-tail-path manpage-path)
(let ((index (string-contains manpage-path "/share/man/"))) (let ((index (string-contains manpage-path "/share/man/")))
(unless index (unless index
(error "Manual path doesn't contain \"/share/man/\":" (error "Manual path doesn't contain \"/share/man/\":"
manpage-path)) manpage-path))
(string-drop manpage-path (+ index (string-length "/share/man/"))))) (string-drop manpage-path (+ index (string-length "/share/man/")))))
(define (populate-manpages-collection-dir entries) (define (populate-manpages-collection-dir entries)
(let ((manpages (append-map (cut find-files <> #:stat stat) entries))) (let ((manpages (append-map (cut find-files <> #:stat stat) entries)))
(for-each (lambda (manpage) (for-each (lambda (manpage)
(let* ((dest-file (string-append (let* ((dest-file (string-append
manpages-collection-dir "/" manpages-collection-dir "/"
(get-manpage-tail-path manpage)))) (get-manpage-tail-path manpage))))
(mkdir-p (dirname dest-file)) (mkdir-p (dirname dest-file))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(symlink manpage dest-file)) (symlink manpage dest-file))
(lambda args (lambda args
;; Different packages may contain the same ;; Different packages may contain the same
;; manpage. Simply ignore the symlink error. ;; manpage. Simply ignore the symlink error.
#t)))) #t))))
manpages))) manpages)))
(mkdir-p manpages-collection-dir) (mkdir-p manpages-collection-dir)
(populate-manpages-collection-dir entries) (populate-manpages-collection-dir entries)
;; Create a mandb config file which contains a custom made ;; Create a mandb config file which contains a custom made
;; manpath. The associated catpath is the location where the database ;; manpath. The associated catpath is the location where the database
;; gets generated. ;; gets generated.
(copy-file #+(file-append man-db "/etc/man_db.conf") (copy-file #+(file-append man-db "/etc/man_db.conf")
"man_db.conf") "man_db.conf")
(substitute* "man_db.conf" (substitute* "man_db.conf"
(("MANDB_MAP /usr/man /var/cache/man/fsstnd") (("MANDB_MAP /usr/man /var/cache/man/fsstnd")
(string-append "MANDB_MAP " manpages-collection-dir " " (string-append "MANDB_MAP " manpages-collection-dir " "
man-directory))) man-directory)))
(mkdir-p man-directory) (mkdir-p man-directory)
(setenv "MANPATH" (string-join entries ":")) (setenv "MANPATH" (string-join entries ":"))
(format #t "Creating manual page database for ~a packages... " (format #t "Creating manual page database for ~a packages... "
(length entries)) (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))))
(force-output) (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 (gexp->derivation "manual-database" build
#:modules '((guix build utils)
(srfi srfi-19)
(srfi srfi-26))
#:local-build? #t)) #:local-build? #t))
(define %default-profile-hooks (define %default-profile-hooks