package: Make sure the profile directory is owned by the user.
* guix/scripts/package.scm (guix-package)[ensure-default-profile]: Check the owner of %PROFILE-DIRECTORY. Report an error when the owner is not the current user. Add `rtfm' procedure. * doc/guix.texi (Invoking guix package): Mention the ownership test.
This commit is contained in:
parent
101d9f3fd4
commit
70c4329172
|
@ -490,7 +490,8 @@ directory is normally
|
||||||
@var{localstatedir} is the value passed to @code{configure} as
|
@var{localstatedir} is the value passed to @code{configure} as
|
||||||
@code{--localstatedir}, and @var{user} is the user name. It must be
|
@code{--localstatedir}, and @var{user} is the user name. It must be
|
||||||
created by @code{root}, with @var{user} as the owner. When it does not
|
created by @code{root}, with @var{user} as the owner. When it does not
|
||||||
exist, @command{guix package} emits an error about it.
|
exist, or is not owned by @var{user}, @command{guix package} emits an
|
||||||
|
error about it.
|
||||||
|
|
||||||
The @var{options} can be among the following:
|
The @var{options} can be among the following:
|
||||||
|
|
||||||
|
|
|
@ -600,7 +600,14 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(#f #f)))
|
(#f #f)))
|
||||||
|
|
||||||
(define (ensure-default-profile)
|
(define (ensure-default-profile)
|
||||||
;; Ensure the default profile symlink and directory exist.
|
;; Ensure the default profile symlink and directory exist and are
|
||||||
|
;; writable.
|
||||||
|
|
||||||
|
(define (rtfm)
|
||||||
|
(format (current-error-port)
|
||||||
|
(_ "Try \"info '(guix) Invoking guix package'\" for \
|
||||||
|
more information.~%"))
|
||||||
|
(exit 1))
|
||||||
|
|
||||||
;; Create ~/.guix-profile if it doesn't exist yet.
|
;; Create ~/.guix-profile if it doesn't exist yet.
|
||||||
(when (and %user-environment-directory
|
(when (and %user-environment-directory
|
||||||
|
@ -609,23 +616,34 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(lstat %user-environment-directory))))
|
(lstat %user-environment-directory))))
|
||||||
(symlink %current-profile %user-environment-directory))
|
(symlink %current-profile %user-environment-directory))
|
||||||
|
|
||||||
;; Attempt to create /…/profiles/per-user/$USER if needed.
|
(let ((s (stat %profile-directory #f)))
|
||||||
(unless (directory-exists? %profile-directory)
|
;; Attempt to create /…/profiles/per-user/$USER if needed.
|
||||||
(catch 'system-error
|
(unless (and s (eq? 'directory (stat:type s)))
|
||||||
(lambda ()
|
(catch 'system-error
|
||||||
(mkdir-p %profile-directory))
|
(lambda ()
|
||||||
(lambda args
|
(mkdir-p %profile-directory))
|
||||||
;; Often, we cannot create %PROFILE-DIRECTORY because its
|
(lambda args
|
||||||
;; parent directory is root-owned and we're running
|
;; Often, we cannot create %PROFILE-DIRECTORY because its
|
||||||
;; unprivileged.
|
;; parent directory is root-owned and we're running
|
||||||
(format (current-error-port)
|
;; unprivileged.
|
||||||
(_ "error: while creating directory `~a': ~a~%")
|
(format (current-error-port)
|
||||||
%profile-directory
|
(_ "error: while creating directory `~a': ~a~%")
|
||||||
(strerror (system-error-errno args)))
|
%profile-directory
|
||||||
(format (current-error-port)
|
(strerror (system-error-errno args)))
|
||||||
(_ "Please create the `~a' directory, with you as the owner.~%")
|
(format (current-error-port)
|
||||||
%profile-directory)
|
(_ "Please create the `~a' directory, with you as the owner.~%")
|
||||||
(exit 1)))))
|
%profile-directory)
|
||||||
|
(rtfm))))
|
||||||
|
|
||||||
|
;; Bail out if it's not owned by the user.
|
||||||
|
(unless (= (stat:uid s) (getuid))
|
||||||
|
(format (current-error-port)
|
||||||
|
(_ "error: directory `~a' is not owned by you~%")
|
||||||
|
%profile-directory)
|
||||||
|
(format (current-error-port)
|
||||||
|
(_ "Please change the owner of `~a' to user ~s.~%")
|
||||||
|
%profile-directory (or (getenv "USER") (getuid)))
|
||||||
|
(rtfm))))
|
||||||
|
|
||||||
(define (process-actions opts)
|
(define (process-actions opts)
|
||||||
;; Process any install/remove/upgrade action from OPTS.
|
;; Process any install/remove/upgrade action from OPTS.
|
||||||
|
|
Loading…
Reference in New Issue