diff options
| -rw-r--r-- | guix/profiles.scm | 43 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 40 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 |
3 files changed, 45 insertions, 39 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index de3a044646..6c3b26423e 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)) @@ -1610,6 +1612,45 @@ because the NUMBER is zero.)" ;; coexist with Nix profiles. (string-append %profile-directory "/guix-profile")) +(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)))))))))) + (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 diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 93a77915fe..e588ff81ed 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -68,50 +68,14 @@ (define (ensure-default-profile) "Ensure the default profile symlink and directory exist and are writable." - - (define (rtfm) - (format (current-error-port) - (G_ "Try \"info '(guix) Invoking guix package'\" for \ -more information.~%")) - (exit 1)) + (ensure-profile-directory) ;; Create ~/.guix-profile if it doesn't exist yet. (when (and %user-profile-directory %current-profile (not (false-if-exception (lstat %user-profile-directory)))) - (symlink %current-profile %user-profile-directory)) - - (let ((s (stat %profile-directory #f))) - ;; Attempt to create /…/profiles/per-user/$USER if needed. - (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. - (format (current-error-port) - (G_ "error: while creating directory `~a': ~a~%") - %profile-directory - (strerror (system-error-errno args))) - (format (current-error-port) - (G_ "Please create the `~a' directory, with you as the owner.~%") - %profile-directory) - (rtfm)))) - - ;; Bail out if it's not owned by the user. - (unless (or (not s) (= (stat:uid s) (getuid))) - (format (current-error-port) - (G_ "error: directory `~a' is not owned by you~%") - %profile-directory) - (format (current-error-port) - (G_ "Please change the owner of `~a' to user ~s.~%") - %profile-directory (or (getenv "USER") - (getenv "LOGNAME") - (getuid))) - (rtfm)))) + (symlink %current-profile %user-profile-directory))) (define (delete-generations store profile generations) "Delete GENERATIONS from PROFILE. diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index df2cf12de2..2e37a19407 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -41,4 +41,5 @@ guix/status.scm guix/http-client.scm guix/nar.scm guix/channels.scm +guix/profiles.scm nix/nix-daemon/guix-daemon.cc |