futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

package: Make sure the profile directory is owned by the user.

Browse Source 
* 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
@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
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:

54
guix/scripts/package.scm
View File

@ -600,7 +600,14 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(#f #f)))
(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.
(when (and %user-environment-directory
@ -609,23 +616,34 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(lstat %user-environment-directory))))
(symlink %current-profile %user-environment-directory))
;; Attempt to create /…/profiles/per-user/$USER if needed.
(unless (directory-exists? %profile-directory)
(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)
(_ "error: while creating directory `~a': ~a~%")
%profile-directory
(strerror (system-error-errno args)))
(format (current-error-port)
(_ "Please create the `~a' directory, with you as the owner.~%")
%profile-directory)
(exit 1)))))
(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)
(_ "error: while creating directory `~a': ~a~%")
%profile-directory
(strerror (system-error-errno args)))
(format (current-error-port)
(_ "Please create the `~a' directory, with you as the owner.~%")
%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)
;; Process any install/remove/upgrade action from OPTS.