diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/package.scm | 28 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 6 | ||||
| -rwxr-xr-x | guix/scripts/substitute-binary.scm | 39 |
3 files changed, 55 insertions, 18 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 5c3947dd63..1393ca3180 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -95,7 +95,7 @@ (make-regexp (string-append "^" (regexp-quote (basename profile)) "-([0-9]+)"))) -(define (profile-numbers profile) +(define (generation-numbers profile) "Return the list of generation numbers of PROFILE, or '(0) if no former profiles were found." (define* (scandir name #:optional (select? (const #t)) @@ -144,7 +144,7 @@ former profiles were found." (cute regexp-exec (profile-regexp profile) <>)) profiles)))) -(define (previous-profile-number profile number) +(define (previous-generation-number profile number) "Return the number of the generation before generation NUMBER of PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the case when generations have been deleted (there are \"holes\")." @@ -153,7 +153,7 @@ case when generations have been deleted (there are \"holes\")." candidate highest)) 0 - (profile-numbers profile))) + (generation-numbers profile))) (define (profile-derivation store packages) "Return a derivation that builds a profile (a user environment) with @@ -205,7 +205,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." packages) #:modules '((guix build union)))) -(define (profile-number profile) +(define (generation-number profile) "Return PROFILE's number or 0. An absolute file name must be used." (or (and=> (false-if-exception (regexp-exec (profile-regexp profile) (basename (readlink profile)))) @@ -214,17 +214,17 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (define (roll-back profile) "Roll back to the previous generation of PROFILE." - (let* ((number (profile-number profile)) - (previous-number (previous-profile-number profile number)) - (previous-profile (format #f "~a-~a-link" - profile previous-number)) - (manifest (string-append previous-profile "/manifest"))) + (let* ((number (generation-number profile)) + (previous-number (previous-generation-number profile number)) + (previous-generation (format #f "~a-~a-link" + profile previous-number)) + (manifest (string-append previous-generation "/manifest"))) (define (switch-link) - ;; Atomically switch PROFILE to the previous profile. + ;; Atomically switch PROFILE to the previous generation. (format #t (_ "switching from generation ~a to ~a~%") number previous-number) - (switch-symlinks profile previous-profile)) + (switch-symlinks profile previous-generation)) (cond ((not (file-exists? profile)) ; invalid profile (leave (_ "profile `~a' does not exist~%") @@ -233,7 +233,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (format (current-error-port) (_ "nothing to do: already at the empty profile~%"))) ((or (zero? previous-number) ; going to emptiness - (not (file-exists? previous-profile))) + (not (file-exists? previous-generation))) (let*-values (((drv-path drv) (profile-derivation (%store) '())) ((prof) @@ -242,7 +242,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (when (not (build-derivations (%store) (list drv-path))) (leave (_ "failed to build the empty profile~%"))) - (switch-symlinks previous-profile prof) + (switch-symlinks previous-generation prof) (switch-link))) (else (switch-link))))) ; anything else @@ -846,7 +846,7 @@ more information.~%")) (%store) (manifest-packages (profile-manifest profile)))) (old-prof (derivation-path->output-path old-drv)) - (number (profile-number profile)) + (number (generation-number profile)) ;; Always use NUMBER + 1 for the new profile, ;; possibly overwriting a "previous future diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index f4135efc99..f3d87a63c0 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -106,6 +106,8 @@ files." (when (string-suffix? ".scm" file) (let ((go (string-append (string-drop-right file 4) ".go"))) + (format (current-error-port) + "compiling '~a'...~%" file) (compile-file file #:output-file go #:opts %auto-compilation-options)))) @@ -114,7 +116,9 @@ files." ;; download), we must build it first to avoid errors since ;; (gnutls) is unavailable. (cons (string-append out "/guix/build/download.scm") - (find-files out "\\.scm"))) + + ;; Sort the file names to get deterministic results. + (sort (find-files out "\\.scm") string<?))) ;; Remove the "fake" (guix config). (delete-file (string-append out "/guix/config.scm")) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 97bbfcbce8..1afc93bbc9 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -446,6 +446,30 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by ;;; +;;; Help. +;;; + +(define (show-help) + (display (_ "Usage: guix substitute-binary [OPTION]... +Internal tool to substitute a pre-built binary to a local build.\n")) + (display (_ " + --query report on the availability of substitutes for the + store file names passed on the standard input")) + (display (_ " + --substitute STORE-FILE DESTINATION + download STORE-FILE and store it as a Nar in file + DESTINATION")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + + + +;;; ;;; Entry point. ;;; @@ -508,8 +532,13 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) - (format (current-error-port) "downloading `~a' from `~a'...~%" - store-path (uri->string uri)) + (format (current-error-port) "downloading `~a' from `~a'~:[~*~; (~,1f MiB installed)~]...~%" + store-path (uri->string uri) + + ;; Use the Nar size as an estimate of the installed size. + (narinfo-size narinfo) + (and=> (narinfo-size narinfo) + (cute / <> (expt 2. 20)))) (let*-values (((raw download-size) ;; Note that Hydra currently generates Nars on the fly ;; and doesn't specify a Content-Length, so @@ -531,7 +560,11 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by (restore-file input destination) (every (compose zero? cdr waitpid) pids)))) (("--version") - (show-version-and-exit "guix substitute-binary"))))) + (show-version-and-exit "guix substitute-binary")) + (("--help") + (show-help)) + (opts + (leave (_ "~a: unrecognized options~%") opts))))) ;;; Local Variables: |