nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
doc/guix.texi
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:

24
guix/scripts/package.scm
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,8 +616,9 @@ 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))
(let ((s (stat %profile-directory #f)))
;; Attempt to create /…/profiles/per-user/$USER if needed. ;; Attempt to create /…/profiles/per-user/$USER if needed.
(unless (directory-exists? %profile-directory) (unless (and s (eq? 'directory (stat:type s)))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(mkdir-p %profile-directory)) (mkdir-p %profile-directory))
@ -625,7 +633,17 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(format (current-error-port) (format (current-error-port)
(_ "Please create the `~a' directory, with you as the owner.~%") (_ "Please create the `~a' directory, with you as the owner.~%")
%profile-directory) %profile-directory)
(exit 1))))) (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.