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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 795d430d90e41eb172315bfccf79c9f13fc0ebfa
Author: Ludovic Courtès <address@hidden>
Date:   Tue Oct 9 11:51:44 2018 +0200

    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".
---
 doc/guix.texi         |  2 +-
 guix/scripts.scm      |  4 ++--
 guix/scripts/pull.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 9b37270..5ae8091 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 4cbbbeb..98751bc 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 0d65857..5fecc11 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?)