summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-10-11 18:04:51 +0200
committerLudovic Courtès <ludo@gnu.org>2018-10-11 18:29:11 +0200
commit77dcfb4c028417bed53c523dbb8c314e9556f85b (patch)
tree5563a7cdb8801c4aa97cbcd58ecd8dcaf2888838 /guix
parente8a7eab169b84ef66c0fb39b3f20ec8af047d5c0 (diff)
profiles: Add 'ensure-profile-directory'.
* guix/scripts/package.scm (ensure-default-profile): Move /var/guix/profiles/per-user handling to... * guix/profiles.scm (ensure-profile-directory): ... here. New procedure. * po/guix/POTFILES.in: Add 'guix/profiles.scm'.
Diffstat (limited to 'guix')
-rw-r--r--guix/profiles.scm43
-rw-r--r--guix/scripts/package.scm40
2 files changed, 44 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.