mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
50c72ecd9e
commit
795d430d90
3 changed files with 52 additions and 6 deletions
|
@ -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,
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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?)
|
||||
|
|
Loading…
Reference in a new issue