pull: Turn ~/.config/guix/current into a symlink to /var/guix/profiles.

This is more consistent with what 'guix package' does, more pleasant for
users (we no longer clobber ~/.config/guix), and more
cluster-friendly (since /var/guix/profiles is usually an NFS share
already.)

* guix/scripts/pull.scm (%current-profile, %user-profile-directory): New
variables.
(migrate-generations, ensure-default-profile): New procedures.
(guix-pull): Use %CURRENT-PROFILE by default.  Call
'ensure-default-profile'.
* doc/guix.texi (Invoking guix pull): Adjust 'guix package -p
~/.config/guix/current' example.
* guix/scripts.scm (warn-about-old-distro): Check %PROFILE-DIRECTORY
"/current-guix".
This commit is contained in:
Ludovic Courtès 2018-10-09 11:51:44 +02:00
parent 50c72ecd9e
commit 795d430d90
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 52 additions and 6 deletions

View file

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

View file

@ -26,6 +26,7 @@ (define-module (guix scripts)
#: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 @@ (define (seconds->days seconds)
(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)))))

View file

@ -225,6 +225,53 @@ (define-syntax-rule (with-git-error-handling body ...)
(lambda (key err)
(report-git-error err))))
;;;
;;; 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 @@ (define (guix-pull . args)
(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?)