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
|
@ -28,7 +28,8 @@
|
||||||
#:use-module ((guix config) #:select (%state-directory))
|
#:use-module ((guix config) #:select (%state-directory))
|
||||||
#:use-module ((guix utils) #:hide (package-name->name+version))
|
#:use-module ((guix utils) #:hide (package-name->name+version))
|
||||||
#:use-module ((guix build utils)
|
#: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 records)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
|
@ -127,6 +128,7 @@
|
||||||
%user-profile-directory
|
%user-profile-directory
|
||||||
%profile-directory
|
%profile-directory
|
||||||
%current-profile
|
%current-profile
|
||||||
|
ensure-profile-directory
|
||||||
canonicalize-profile
|
canonicalize-profile
|
||||||
user-friendly-profile))
|
user-friendly-profile))
|
||||||
|
|
||||||
|
@ -1610,6 +1612,45 @@ because the NUMBER is zero.)"
|
||||||
;; coexist with Nix profiles.
|
;; coexist with Nix profiles.
|
||||||
(string-append %profile-directory "/guix-profile"))
|
(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)
|
(define (canonicalize-profile profile)
|
||||||
"If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise
|
"If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise
|
||||||
return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
|
return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
|
||||||
|
|
|
@ -68,50 +68,14 @@
|
||||||
|
|
||||||
(define (ensure-default-profile)
|
(define (ensure-default-profile)
|
||||||
"Ensure the default profile symlink and directory exist and are writable."
|
"Ensure the default profile symlink and directory exist and are writable."
|
||||||
|
(ensure-profile-directory)
|
||||||
(define (rtfm)
|
|
||||||
(format (current-error-port)
|
|
||||||
(G_ "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-profile-directory
|
(when (and %user-profile-directory
|
||||||
%current-profile
|
%current-profile
|
||||||
(not (false-if-exception
|
(not (false-if-exception
|
||||||
(lstat %user-profile-directory))))
|
(lstat %user-profile-directory))))
|
||||||
(symlink %current-profile %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))))
|
|
||||||
|
|
||||||
(define (delete-generations store profile generations)
|
(define (delete-generations store profile generations)
|
||||||
"Delete GENERATIONS from PROFILE.
|
"Delete GENERATIONS from PROFILE.
|
||||||
|
|
|
@ -41,4 +41,5 @@ guix/status.scm
|
||||||
guix/http-client.scm
|
guix/http-client.scm
|
||||||
guix/nar.scm
|
guix/nar.scm
|
||||||
guix/channels.scm
|
guix/channels.scm
|
||||||
|
guix/profiles.scm
|
||||||
nix/nix-daemon/guix-daemon.cc
|
nix/nix-daemon/guix-daemon.cc
|
||||||
|
|
Loading…
Reference in New Issue