diff options
| -rw-r--r-- | doc/guix.texi | 2 | ||||
| -rw-r--r-- | guix/scripts.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 52 |
3 files changed, 52 insertions, 6 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 9b37270a83..5ae80917a9 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2831,7 +2831,7 @@ generation---i.e., the previous Guix---and so on: $ guix package -p ~/.config/guix/current --roll-back switched from generation 3 to 2 $ guix package -p ~/.config/guix/current --delete-generations=1 -deleting /home/charlie/.config/guix/current-1-link +deleting /var/guix/profiles/per-user/charlie/current-guix-1-link @end example The @command{guix pull} command is usually invoked with no arguments, diff --git a/guix/scripts.scm b/guix/scripts.scm index 4cbbbeb96f..98751bc812 100644 --- a/guix/scripts.scm +++ b/guix/scripts.scm @@ -26,6 +26,7 @@ #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module ((guix profiles) #:select (%profile-directory)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-37) @@ -169,8 +170,7 @@ Show what and how will/would be built." (define age (match (false-if-not-found - (lstat (string-append (config-directory #:ensure? #f) - "/current"))) + (lstat (string-append %profile-directory "/current-guix"))) (#f #f) (stat (- (time-second (current-time time-utc)) (stat:mtime stat))))) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 0d65857beb..5fecc11de3 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -227,6 +227,53 @@ Download and deploy the latest version of Guix.\n")) ;;; +;;; Profile. +;;; + +(define %current-profile + ;; The "real" profile under /var/guix. + (string-append %profile-directory "/current-guix")) + +(define %user-profile-directory + ;; The user-friendly name of %CURRENT-PROFILE. + (string-append (config-directory #:ensure? #f) "/current")) + +(define (migrate-generations profile directory) + "Migration the generations of PROFILE to DIRECTORY." + (format (current-error-port) + (G_ "Migrating profile generations to '~a'...~%") + %profile-directory) + (for-each (lambda (generation) + (let ((source (generation-file-name profile generation)) + (target (string-append directory "/current-guix-" + (number->string generation) + "-link"))) + (rename-file source target))) + (profile-generations profile))) + +(define (ensure-default-profile) + (ensure-profile-directory) + + ;; In 0.15.0+ we'd create ~/.config/guix/current-[0-9]*-link symlinks. Move + ;; them to %PROFILE-DIRECTORY. + (unless (string=? %profile-directory + (dirname (canonicalize-profile %user-profile-directory))) + (migrate-generations %user-profile-directory %profile-directory)) + + ;; Make sure ~/.config/guix/current points to /var/guix/profiles/…. + (let ((link %user-profile-directory)) + (unless (equal? (false-if-exception (readlink link)) + %current-profile) + (catch 'system-error + (lambda () + (false-if-exception (delete-file link)) + (symlink %current-profile link)) + (lambda args + (leave (G_ "while creating symlink '~a': ~a~%") + link (strerror (system-error-errno args)))))))) + + +;;; ;;; Queries. ;;; @@ -438,9 +485,8 @@ Use '~/.config/guix/channels.scm' instead.")) (list %default-options))) (cache (string-append (cache-directory) "/pull")) (channels (channel-list opts)) - (profile (or (assoc-ref opts 'profile) - (string-append (config-directory) "/current")))) - + (profile (or (assoc-ref opts 'profile) %current-profile))) + (ensure-default-profile) (cond ((assoc-ref opts 'query) (process-query opts profile)) ((assoc-ref opts 'dry-run?) |