me
/
guix
Archived
1
0
Fork 0

substitute-binary: Let the user know when the cache is being updated.

* guix/scripts/substitute-binary.scm (open-cache*): New macro.
  (guix-substitute-binary): Use it instead of (delay (open-cache ...)).
master
Ludovic Courtès 2015-01-26 21:57:06 +01:00
parent 19a454448b
commit 3bcfe23cfc
1 changed files with 12 additions and 3 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -213,6 +213,15 @@ failure."
(cut %make-cache url <...>) (cut %make-cache url <...>)
'("StoreDir" "WantMassQuery"))))) '("StoreDir" "WantMassQuery")))))
(define-syntax-rule (open-cache* url)
"Delayed variant of 'open-cache' that also lets the user know that they're
gonna have to wait."
(delay (begin
(format (current-error-port)
(_ "updating list of substitutes from '~a'...~%")
url)
(open-cache url))))
(define-record-type <narinfo> (define-record-type <narinfo>
(%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size (%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size
references deriver system signature contents) references deriver system signature contents)
@ -668,7 +677,7 @@ substituter disabled~%")
(with-error-handling ; for signature errors (with-error-handling ; for signature errors
(match args (match args
(("--query") (("--query")
(let ((cache (delay (open-cache %cache-url))) (let ((cache (open-cache* %cache-url))
(acl (current-acl))) (acl (current-acl)))
(define (valid? obj) (define (valid? obj)
(and (narinfo? obj) (valid-narinfo? obj acl))) (and (narinfo? obj) (valid-narinfo? obj acl)))
@ -719,7 +728,7 @@ substituter disabled~%")
(loop (read-line))))))) (loop (read-line)))))))
(("--substitute" store-path destination) (("--substitute" store-path destination)
;; Download STORE-PATH and add store it as a Nar in file DESTINATION. ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
(let* ((cache (delay (open-cache %cache-url))) (let* ((cache (open-cache* %cache-url))
(narinfo (lookup-narinfo cache store-path)) (narinfo (lookup-narinfo cache store-path))
(uri (narinfo-uri narinfo))) (uri (narinfo-uri narinfo)))
;; Make sure it is signed and everything. ;; Make sure it is signed and everything.