derivations: Introduce 'read-derivation-from-file'.

This avoids the open/fstat/close syscalls upon a cache hit that we had
with the previous idiom:

  (call-with-input-file file read-derivation)

where caching happened in 'read-derivation' itself.

* guix/derivations.scm (%read-derivation): Rename to...
(read-derivation): ... this.
(read-derivation-from-file): New procedure.
(derivation-prerequisites, substitution-oracle)
(derivation-prerequisites-to-build):
(derivation-path->output-path, derivation-path->output-paths):
(derivation-path->base16-hash, map-derivation): Use
'read-derivation-from-file' instead of (call-with-input-file …
read-derivation).
* guix/grafts.scm (item->deriver): Likewise.
* guix/scripts/build.scm (log-url, options->things-to-build): Likewise.
* guix/scripts/graph.scm (file->derivation): Remove.
(derivation-dependencies, %derivation-node-type): Use
'read-derivation-from-file' instead.
* guix/scripts/offload.scm (guix-offload): Likewise.
* guix/scripts/perform-download.scm (guix-perform-download): Likewise.
* guix/scripts/publish.scm (load-derivation): Remove.
(narinfo-string): Use 'read-derivation-from-file'.

5 files changed, 9 insertions, 18 deletions

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 558e8e7719..0571b874f1 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -87,7 +87,7 @@ found.  Return #f if no build log was found."
              ;; Usually we'll have more luck with the output file name since
              ;; the deriver that was used by the server could be different, so
              ;; try one of the output file names.
-             (let ((drv (call-with-input-file file read-derivation)))
+             (let ((drv (read-derivation-from-file file)))
                (or (find-url (derivation->output-path drv))
                    (find-url file))))
            (lambda args
@@ -599,7 +599,7 @@ build---packages, gexps, derivations, and so on."
   (append-map (match-lambda
                 (('argument . (? string? spec))
                  (cond ((derivation-path? spec)
-                        (list (call-with-input-file spec read-derivation)))
+                        (list (read-derivation-from-file spec)))
                        ((store-path? spec)
                         ;; Nothing to do; maybe for --log-file.
                         '())
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 0af1fa3ad3..d5be442884 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -221,15 +221,11 @@ GNU-BUILD-SYSTEM have zero dependencies."
 ;;; Derivation DAG.
 ;;;
 
-(define (file->derivation file)
-  "Read the derivation from FILE and return it."
-  (call-with-input-file file read-derivation))
-
 (define (derivation-dependencies obj)
   "Return the <derivation> objects and store items corresponding to the
 dependencies of OBJ, a <derivation> or store item."
   (if (derivation? obj)
-      (append (map (compose file->derivation derivation-input-path)
+      (append (map (compose read-derivation-from-file derivation-input-path)
                    (derivation-inputs obj))
               (derivation-sources obj))
       '()))
@@ -263,7 +259,7 @@ a plain store file."
               ((? derivation-path? item)
                (mbegin %store-monad
                  ((store-lift add-temp-root) item)
-                 (return (list (file->derivation item)))))
+                 (return (list (read-derivation-from-file item)))))
               (x
                (raise
                 (condition (&message (message "unsupported argument for \
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 77b340cff6..566d117b02 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -652,9 +652,8 @@ machine."
                       (with-error-handling
                        (process-request (equal? (match:substring match 1) "1")
                                         (match:substring match 2) ; system
-                                        (call-with-input-file
-                                            (match:substring match 3)
-                                          read-derivation)
+                                        (read-derivation-from-file
+                                         (match:substring match 3))
                                         (string-tokenize
                                          (match:substring match 4) not-coma)
                                         #:print-build-trace? print-build-trace?
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index aee506af46..18e2fc92f2 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -106,11 +106,11 @@ of GnuTLS over HTTPS, before we have built GnuTLS.  See
     (match args
       (((? derivation-path? drv) (? store-path? output))
        (assert-low-privileges)
-       (perform-download (call-with-input-file drv read-derivation)
+       (perform-download (read-derivation-from-file drv)
                          output))
       (((? derivation-path? drv))                 ;backward compatibility
        (assert-low-privileges)
-       (perform-download (call-with-input-file drv read-derivation)))
+       (perform-download (read-derivation-from-file drv)))
       (("--version")
        (show-version-and-exit))
       (x
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c49c0c3e20..a7e3e6d629 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -225,10 +225,6 @@ compression disabled~%"))
     ("WantMassQuery" . 0)
     ("Priority" . 100)))
 
-(define (load-derivation file)
-  "Read the derivation from FILE."
-  (call-with-input-file file read-derivation))
-
 (define (signed-string s)
   "Sign the hash of the string S with the daemon's key."
   (let* ((public-key (%public-key))
@@ -286,7 +282,7 @@ References: ~a~%~a"
                          base-info
                          (catch 'system-error
                            (lambda ()
-                             (let ((drv (load-derivation deriver)))
+                             (let ((drv (read-derivation-from-file deriver)))
                                (format #f "~aSystem: ~a~%Deriver: ~a~%"
                                        base-info (derivation-system drv)
                                        (basename deriver))))