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'.
This commit is contained in:
Ludovic Courtès 2018-10-11 18:04:51 +02:00
parent e8a7eab169
commit 77dcfb4c02
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 45 additions and 39 deletions

View file

@ -28,7 +28,8 @@ (define-module (guix profiles)
#:use-module ((guix config) #:select (%state-directory))
#:use-module ((guix utils) #:hide (package-name->name+version))
#:use-module ((guix build utils)
#:select (package-name->name+version))
#:select (package-name->name+version mkdir-p))
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix derivations)
@ -127,6 +128,7 @@ (define-module (guix profiles)
%user-profile-directory
%profile-directory
%current-profile
ensure-profile-directory
canonicalize-profile
user-friendly-profile))
@ -1610,6 +1612,45 @@ (define %current-profile
;; coexist with Nix profiles.
(string-append %profile-directory "/guix-profile"))
(define (ensure-profile-directory)
"Attempt to create /…/profiles/per-user/$USER if needed."
(let ((s (stat %profile-directory #f)))
(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.
(raise (condition
(&message
(message
(format #f
(G_ "while creating directory `~a': ~a")
%profile-directory
(strerror (system-error-errno args)))))
(&fix-hint
(hint
(format #f (G_ "Please create the @file{~a} directory, \
with you as the owner.")
%profile-directory))))))))
;; Bail out if it's not owned by the user.
(unless (or (not s) (= (stat:uid s) (getuid)))
(raise (condition
(&message
(message
(format #f (G_ "directory `~a' is not owned by you")
%profile-directory)))
(&fix-hint
(hint
(format #f (G_ "Please change the owner of @file{~a} \
to user ~s.")
%profile-directory (or (getenv "USER")
(getenv "LOGNAME")
(getuid))))))))))
(define (canonicalize-profile profile)
"If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise
return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if

View file

@ -68,50 +68,14 @@ (define %store
(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.

View file

@ -41,4 +41,5 @@ guix/status.scm
guix/http-client.scm
guix/nar.scm
guix/channels.scm
guix/profiles.scm
nix/nix-daemon/guix-daemon.cc