guix: home: Ensure symlink is properly created.

Julien LepillerSat Jul 25 23:21:31+0200 2020

fcc8156

guix: home: Ensure symlink is properly created. Ensure the $HOME symlink to the profile is created at the right time, after the profile is built. When creating the symlink if it does not exist yet, allow overriding an existing symlink and error out only when $HOME is a directory and the data directory already exist. * guix/scripts/home.scm (ensure-home-profile): Allow overriding existing symlink. (perform-action): Ensure home profile only after the derivation is built.

guix/scripts/home.scm

162162 
163163 
  (when %home %current-home
164164 
    (let ((home (false-if-exception (lstat %home))))
165-
      (if home
166-
	  (unless (equal? (readlink %home) %current-home)
167-
            (if (false-if-exception (lstat data-directory))
168-
              (leave (G_ "Your $HOME directory (~a) is not a symlink to the home profile,
169-
and it cannot be moved as ~a already exists on the filesystem.~%")
170-
                    %home data-directory)
171-
              (rename-file %home data-directory)))
172-
          (symlink %current-home %home)))))
165+
      (cond
166+
        ((equal? (stat:type home) 'symlink)
167+
         (symlink %current-home %home))
168+
        ((false-if-exception (lstat data-directory))
169+
         (leave (G_ "Your $HOME directory (~a) is not a symlink to the home
170+
profile, and it cannot be moved as ~a already exists on the filesystem.~%")
171+
                %home data-directory))
172+
        ((not home)
173+
         (symlink %current-home %home))
174+
        (else
175+
         (rename-file %home data-directory)
176+
         (symlink %current-home %home))))))
173177 
174178 
(define (list-generations pattern)
175179 
  "Display in a human-readable format all the home generations matching
…
201205 
  (define println
202206 
    (cut format #t "~a~%" <>))
203207 
204-
  (when (eq? action 'reconfigure)
205-
    (ensure-home-profile (home-data-directory home)))
206-
207208 
  (with-store store
208209 
    (let* ((drv      (run-with-store store (home->derivation home)))
209210 
           (profile  (derivation->output-path drv)))
…
218219 
              ((reconfigure)
219220 
               (newline)
220221 
               (format #t (G_ "Activating home...~%"))
222+
               (ensure-home-profile (home-data-directory home))
221223 
               (let* ((number (generation-number %current-home))
222224 
                      (generation (generation-file-name %current-home (+ 1 number))))
223225 
                 (switch-symlinks generation profile)