me/guix
Archived
1
0
Fork 0
Code Activity

guix build, archive, graph: Disable absolute file port name canonicalization.

Browse source 
This avoids an 'lstat' storm.  Specifically:

  ./pre-inst-env strace -c guix build -nd libreoffice

goes from 1,711 to 214 'lstat' calls.

* guix/scripts/build.scm (options->things-to-build): When SPEC matches
'derivation-path?', call 'canonicalize-path'.
(guix-build): Remove 'with-fluids' for %FILE-PORT-NAME-CANONICALIZATION.
* guix/scripts/archive.scm (guix-archive): Remove 'with-fluids' for
%FILE-PORT-NAME-CANONICALIZATION.
* guix/scripts/graph.scm (guix-graph): Likewise.
This commit is contained in:
Ludovic Courtès 2020-01-24 18:13:38 +01:00
parent a07d5e558b
commit 09238d618a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 106 additions and 111 deletions

7
guix/scripts/archive.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -371,9 +371,6 @@ output port."
(cons line result))))) (cons line result)))))
(with-error-handling (with-error-handling
;; Ask for absolute file names so that .drv file names passed from the
;; user to 'read-derivation' are absolute when it returns.
(with-fluids ((%file-port-name-canonicalization 'absolute))
(let ((opts (parse-command-line args %options (list %default-options)))) (let ((opts (parse-command-line args %options (list %default-options))))
(parameterize ((%graft? (assoc-ref opts 'graft?))) (parameterize ((%graft? (assoc-ref opts 'graft?)))
(cond ((assoc-ref opts 'generate-key) (cond ((assoc-ref opts 'generate-key)
@ -403,4 +400,4 @@ output port."
(else (else
(leave (leave
(G_ "either '--export' or '--import' \ (G_ "either '--export' or '--import' \
must be specified~%"))))))))))))) must be specified~%"))))))))))))

11
guix/scripts/build.scm
View file

@ -809,7 +809,11 @@ build---packages, gexps, derivations, and so on."
(cond ((derivation-path? spec) (cond ((derivation-path? spec)
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(list (read-derivation-from-file spec))) ;; Ask for absolute file names so that .drv file
;; names passed from the user to 'read-derivation'
;; are absolute when it returns.
(let ((spec (canonicalize-path spec)))
(list (read-derivation-from-file spec))))
(lambda args (lambda args
;; Non-existent .drv files can be substituted down ;; Non-existent .drv files can be substituted down
;; the road, so don't error out. ;; the road, so don't error out.
@ -927,9 +931,6 @@ needed."
(list %default-options))) (list %default-options)))
(with-error-handling (with-error-handling
;; Ask for absolute file names so that .drv file names passed from the
;; user to 'read-derivation' are absolute when it returns.
(with-fluids ((%file-port-name-canonicalization 'absolute))
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store (with-store store
;; Set the build options before we do anything else. ;; Set the build options before we do anything else.
@ -990,4 +991,4 @@ needed."
(map cdr (map cdr
(derivation->output-paths drv))) (derivation->output-paths drv)))
drv) drv)
roots))))))))))) roots))))))))))

7
guix/scripts/graph.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -552,9 +552,6 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
(read/eval-package-expression exp))) (read/eval-package-expression exp)))
(_ #f)) (_ #f))
opts))) opts)))
;; Ask for absolute file names so that .drv file names passed from the
;; user to 'read-derivation' are absolute when it returns.
(with-fluids ((%file-port-name-canonicalization 'absolute))
(run-with-store store (run-with-store store
;; XXX: Since grafting can trigger unsolicited builds, disable it. ;; XXX: Since grafting can trigger unsolicited builds, disable it.
(mlet %store-monad ((_ (set-grafting #f)) (mlet %store-monad ((_ (set-grafting #f))
@ -565,7 +562,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
(current-output-port) (current-output-port)
#:node-type type #:node-type type
#:backend backend)) #:backend backend))
#:system (assq-ref opts 'system)))))) #:system (assq-ref opts 'system)))))
#t) #t)
;;; graph.scm ends here ;;; graph.scm ends here