summaryrefslogtreecommitdiff
path: root/guix/scripts/package.scm
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/scripts/package.scm
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/scripts/package.scm')
-rw-r--r--guix/scripts/package.scm40
1 files changed, 2 insertions, 38 deletions
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.