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:
Ludovic Courtès 2013-05-16 20:04:13 +02:00
parent 101d9f3fd4
commit 70c4329172
2 changed files with 38 additions and 19 deletions

View File

@ -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:

View File

@ -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.