mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
e8a7eab169
commit
77dcfb4c02
3 changed files with 45 additions and 39 deletions
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue