diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-07-26 21:43:43 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-07-26 22:56:59 +0200 |
commit | 48704e5b5c9a18a3f381ec5a266d0375219ae122 (patch) | |
tree | 93853c28c9fa5aca639d7ba1c55740dbfbc36e30 /guix/scripts | |
parent | f280cdb1bafefee42d0c573ecabb0d9bd0659e64 (diff) | |
download | gnu-guix-48704e5b5c9a18a3f381ec5a266d0375219ae122.tar gnu-guix-48704e5b5c9a18a3f381ec5a266d0375219ae122.tar.gz |
profiles: Do away with 'manifest=?'.
* guix/profiles.scm (manifest=?): Remove.
* guix/scripts/package.scm (readlink*): New procedure.
(guix-package)[process-actions]: Use 'readlink*' and compare the
profile to be built, PROF, with PROFILE to determine whether there's
nothing to be done.
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/package.scm | 74 |
1 files changed, 44 insertions, 30 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 0d17414b4f..36e025d479 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -750,6 +750,16 @@ removed from MANIFEST." (unless (string=? profile %current-profile) (add-indirect-root store (canonicalize-path profile)))) +(define (readlink* file) + "Call 'readlink' until the result is not a symlink." + (catch 'system-error + (lambda () + (readlink* (readlink file))) + (lambda args + (if (= EINVAL (system-error-errno args)) + file + (apply throw args))))) + ;;; ;;; Entry point. @@ -921,36 +931,40 @@ more information.~%")) (when (equal? profile %current-profile) (ensure-default-profile)) - (if (manifest=? new manifest) - (format (current-error-port) (_ "nothing to be done~%")) - (let ((prof-drv (profile-derivation (%store) new)) - (remove (manifest-matching-entries manifest remove))) - (show-what-to-remove/install remove install dry-run?) - (show-what-to-build (%store) (list prof-drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - - (or dry-run? - (let* ((prof (derivation->output-path prof-drv)) - (number (generation-number profile)) - - ;; Always use NUMBER + 1 for the new profile, - ;; possibly overwriting a "previous future - ;; generation". - (name (generation-file-name profile - (+ 1 number)))) - (and (build-derivations (%store) (list prof-drv)) - (let ((count (length entries))) - (switch-symlinks name prof) - (switch-symlinks profile name) - (maybe-register-gc-root (%store) profile) - (format #t (N_ "~a package in profile~%" - "~a packages in profile~%" - count) - count) - (display-search-paths entries - profile))))))))))) + (unless (and (null? install) (null? remove)) + (let* ((prof-drv (profile-derivation (%store) new)) + (prof (derivation->output-path prof-drv)) + (remove (manifest-matching-entries manifest remove))) + (show-what-to-remove/install remove install dry-run?) + (show-what-to-build (%store) (list prof-drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?) + + (cond + (dry-run? #t) + ((and (file-exists? profile) + (and=> (readlink* profile) (cut string=? prof <>))) + (format (current-error-port) (_ "nothing to be done~%"))) + (else + (let* ((number (generation-number profile)) + + ;; Always use NUMBER + 1 for the new profile, + ;; possibly overwriting a "previous future + ;; generation". + (name (generation-file-name profile + (+ 1 number)))) + (and (build-derivations (%store) (list prof-drv)) + (let ((count (length entries))) + (switch-symlinks name prof) + (switch-symlinks profile name) + (maybe-register-gc-root (%store) profile) + (format #t (N_ "~a package in profile~%" + "~a packages in profile~%" + count) + count) + (display-search-paths entries + profile)))))))))))) (define (process-query opts) ;; Process any query specified by OPTS. Return #t when a query was |