diff options
Diffstat (limited to 'guix/profiles.scm')
| -rw-r--r-- | guix/profiles.scm | 87 |
1 files changed, 67 insertions, 20 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 669ebe04e5..89e92ea2ba 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -28,7 +28,8 @@ #:use-module ((guix config) #:select (%state-directory)) #:use-module ((guix utils) #:hide (package-name->name+version)) #:use-module ((guix build utils) - #:select (package-name->name+version)) + #:select (package-name->name+version mkdir-p)) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix derivations) @@ -127,6 +128,7 @@ %user-profile-directory %profile-directory %current-profile + ensure-profile-directory canonicalize-profile user-friendly-profile)) @@ -1249,7 +1251,7 @@ the entries in MANIFEST." (define config.scm (scheme-file "config.scm" #~(begin - (define-module (guix config) + (define-module #$'(guix config) ;placate Geiser #:export (%libz)) (define %libz @@ -1610,28 +1612,73 @@ because the NUMBER is zero.)" ;; coexist with Nix profiles. (string-append %profile-directory "/guix-profile")) -(define (canonicalize-profile profile) - "If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise -return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if -'-p' was omitted." ; see <http://bugs.gnu.org/17939> +(define (ensure-profile-directory) + "Attempt to create /…/profiles/per-user/$USER if needed." + (let ((s (stat %profile-directory #f))) + (unless (and s (eq? 'directory (stat:type s))) + (catch 'system-error + (lambda () + (mkdir-p %profile-directory)) + (lambda args + ;; Often, we cannot create %PROFILE-DIRECTORY because its + ;; parent directory is root-owned and we're running + ;; unprivileged. + (raise (condition + (&message + (message + (format #f + (G_ "while creating directory `~a': ~a") + %profile-directory + (strerror (system-error-errno args))))) + (&fix-hint + (hint + (format #f (G_ "Please create the @file{~a} directory, \ +with you as the owner.") + %profile-directory)))))))) + + ;; Bail out if it's not owned by the user. + (unless (or (not s) (= (stat:uid s) (getuid))) + (raise (condition + (&message + (message + (format #f (G_ "directory `~a' is not owned by you") + %profile-directory))) + (&fix-hint + (hint + (format #f (G_ "Please change the owner of @file{~a} \ +to user ~s.") + %profile-directory (or (getenv "USER") + (getenv "LOGNAME") + (getuid)))))))))) - ;; Trim trailing slashes so that the basename comparison below works as - ;; intended. +(define (canonicalize-profile profile) + "If PROFILE points to a profile in %PROFILE-DIRECTORY, return that. +Otherwise return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' +as if '-p' was omitted." ; see <http://bugs.gnu.org/17939> + ;; Trim trailing slashes so 'readlink' can do its job. (let ((profile (string-trim-right profile #\/))) - (if (and %user-profile-directory - (string=? (canonicalize-path (dirname profile)) - (dirname %user-profile-directory)) - (string=? (basename profile) (basename %user-profile-directory))) - %current-profile - profile))) + (catch 'system-error + (lambda () + (let ((target (readlink profile))) + (if (string=? (dirname target) %profile-directory) + target + profile))) + (const profile)))) + +(define %known-shorthand-profiles + ;; Known shorthand forms for profiles that the user manipulates. + (list (string-append (config-directory #:ensure? #f) "/current") + %user-profile-directory)) (define (user-friendly-profile profile) - "Return either ~/.guix-profile if that's what PROFILE refers to, directly or -indirectly, or PROFILE." - (if (and %user-profile-directory - (false-if-exception - (string=? (readlink %user-profile-directory) profile))) - %user-profile-directory + "Return either ~/.guix-profile or ~/.config/guix/current if that's what +PROFILE refers to, directly or indirectly, or PROFILE." + (or (find (lambda (shorthand) + (and shorthand + (let ((target (false-if-exception + (readlink shorthand)))) + (and target (string=? target profile))))) + %known-shorthand-profiles) profile)) ;;; profiles.scm ends here |