7 files changed, 32 insertions(+), 44 deletions(-)

M guix/derivations.scm
M guix/grafts.scm
M guix/scripts/build.scm
M guix/scripts/graph.scm
M guix/scripts/offload.scm
M guix/scripts/perform-download.scm
M guix/scripts/publish.scm

@@ 82,6 82,7 @@
             derivation-hash
 
             read-derivation
+            read-derivation-from-file
             write-derivation
             derivation->output-path
             derivation->output-paths


@@ 241,8 242,7 @@ result is the set of prerequisites of DRV not already in valid."
              (append inputs result)
              (fold set-insert input-set inputs)
              (map (lambda (i)
-                    (call-with-input-file (derivation-input-path i)
-                      read-derivation))
+                    (read-derivation-from-file (derivation-input-path i)))
                   inputs)))))
 
 (define (offloadable-derivation? drv)


@@ 295,9 295,8 @@ substituter many times."
     ;; info is not already in cache.
     ;; Also, skip derivations marked as non-substitutable.
     (append-map (lambda (input)
-                  (let ((drv (call-with-input-file
-                                 (derivation-input-path input)
-                               read-derivation)))
+                  (let ((drv (read-derivation-from-file
+                              (derivation-input-path input))))
                     (if (substitutable-derivation? drv)
                         (derivation-input-output-paths input)
                         '())))


@@ 400,13 399,15 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
                                         (derivation-inputs drv))
                             substitute)
                     (map (lambda (i)
-                           (call-with-input-file (derivation-input-path i)
-                             read-derivation))
+                           (read-derivation-from-file
+                            (derivation-input-path i)))
                          inputs)
                     (map derivation-input-sub-derivations inputs)))))))
 
-(define (%read-derivation drv-port)
-  ;; Actually read derivation from DRV-PORT.
+(define (read-derivation drv-port)
+  "Read the derivation from DRV-PORT and return the corresponding <derivation>
+object.  Most of the time you'll want to use 'read-derivation-from-file',
+which caches things as appropriate and is thus more efficient."
 
   (define comma (string->symbol ","))
 


@@ 482,17 483,16 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
   ;; XXX: This is redundant with 'atts-cache' in the store.
   (make-weak-value-hash-table 200))
 
-(define (read-derivation drv-port)
-  "Read the derivation from DRV-PORT and return the corresponding
+(define (read-derivation-from-file file)
+  "Read the derivation in FILE, a '.drv' file, and return the corresponding
 <derivation> object."
-  ;; Memoize that operation because `%read-derivation' is quite expensive,
+  ;; Memoize that operation because 'read-derivation' is quite expensive,
   ;; and because the same argument is read more than 15 times on average
   ;; during something like (package-derivation s gdb).
-  (let ((file (port-filename drv-port)))
-    (or (and file (hash-ref %derivation-cache file))
-        (let ((drv (%read-derivation drv-port)))
-          (hash-set! %derivation-cache file drv)
-          drv))))
+  (or (and file (hash-ref %derivation-cache file))
+      (let ((drv (call-with-input-file file read-derivation)))
+        (hash-set! %derivation-cache file drv)
+        drv)))
 
 (define-inlinable (write-sequence lst write-item port)
   ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a


@@ 608,8 608,7 @@ DRV."
 (define derivation-path->output-path
   ;; This procedure is called frequently, so memoize it.
   (let ((memoized (mlambda (path output)
-                    (derivation->output-path (call-with-input-file path
-                                               read-derivation)
+                    (derivation->output-path (read-derivation-from-file path)
                                              output))))
     (lambda* (path #:optional (output "out"))
       "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store


@@ 619,7 618,7 @@ path of its output OUTPUT."
 (define (derivation-path->output-paths path)
   "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
 list of name/path pairs of its outputs."
-  (derivation->output-paths (call-with-input-file path read-derivation)))
+  (derivation->output-paths (read-derivation-from-file path)))
 
 
 ;;;


@@ 630,10 629,8 @@ list of name/path pairs of its outputs."
   (mlambda (file)
     "Return a string containing the base16 representation of the hash of the
 derivation at FILE."
-    (call-with-input-file file
-      (compose bytevector->base16-string
-               derivation-hash
-               read-derivation))))
+    (bytevector->base16-string
+     (derivation-hash (read-derivation-from-file file)))))
 
 (define derivation-hash            ; `hashDerivationModulo' in derivations.cc
   (mlambda (drv)


@@ 896,7 893,7 @@ recursively."
              ((_ . replacement)
               (list replacement))
              (#f
-              (let* ((drv (loop (call-with-input-file path read-derivation))))
+              (let* ((drv (loop (read-derivation-from-file path))))
                 (cons drv sub-drvs))))))))
 
     (let loop ((drv drv))

@@ 156,7 156,7 @@ name of the output of that derivation ITEM corresponds to (for example
     (()                                           ;ITEM is a plain file
      (values #f #f))
     ((drv-file _ ...)
-     (let ((drv (call-with-input-file drv-file read-derivation)))
+     (let ((drv (read-derivation-from-file drv-file)))
        (values drv
                (any (match-lambda
                       ((name . path)

@@ 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.
                         '())

@@ 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 \

@@ 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?

@@ 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

@@ 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))))