~ruther/guix-local

795d430d90e41eb172315bfccf79c9f13fc0ebfa — Ludovic Courtès 7 years ago 50c72ec
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".
3 files changed, 52 insertions(+), 6 deletions(-)

M doc/guix.texi
M guix/scripts.scm
M guix/scripts/pull.scm
M doc/guix.texi => doc/guix.texi +1 -1
@@ 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,

M guix/scripts.scm => guix/scripts.scm +2 -2
@@ 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)))))

M guix/scripts/pull.scm => guix/scripts/pull.scm +49 -3
@@ 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?)