diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-01-14 23:44:58 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-01-14 23:44:58 +0100 |
commit | 0ec1af59e564c00fb48359fec84d049138589dee (patch) | |
tree | 9fa48723892f3aa8f944c7c6f7f2fc688151e3ed /guix-package.in | |
parent | 2a5ab9dceba14b14170d87d180e9422299ac713e (diff) | |
download | guix-0ec1af59e564c00fb48359fec84d049138589dee.tar.gz |
guix-package: Create or diagnose missing profile directory.
Reported by Andreas Enge. * guix-package.in (%profile-directory): Honor $NIX_STATE_DIR. (guix-package)[ensure-default-profile]: Use it. [process-actions]: Call it when the `profile' option is %CURRENT-PROFILE. * tests/guix-package.sh: Add installation test with $HOME set, using the default profile.
Diffstat (limited to 'guix-package.in')
-rw-r--r-- | guix-package.in | 44 |
1 files changed, 34 insertions, 10 deletions
diff --git a/guix-package.in b/guix-package.in index 3b8615cb72..3e98239e28 100644 --- a/guix-package.in +++ b/guix-package.in @@ -36,6 +36,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ #:use-module (guix packages) #:use-module (guix utils) #:use-module (guix config) + #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module (ice-9 ftw) #:use-module (ice-9 format) #:use-module (ice-9 match) @@ -63,7 +64,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ (cut string-append <> "/.guix-profile"))) (define %profile-directory - (string-append %state-directory "/profiles/" + (string-append (or (getenv "NIX_STATE_DIR") %state-directory) "/profiles/" (or (and=> (getenv "USER") (cut string-append "per-user/" <>)) "default"))) @@ -330,6 +331,34 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (() (leave (_ "~a: package not found~%") request))))) + (define (ensure-default-profile) + ;; Ensure the default profile symlink and directory exist. + + ;; Create ~/.guix-profile if it doesn't exist yet. + (when (and %user-environment-directory + %current-profile + (not (false-if-exception + (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))))) + (define (process-actions opts) ;; Process any install/remove/upgrade action from OPTS. (let* ((dry-run? (assoc-ref opts 'dry-run?)) @@ -355,7 +384,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (package-name->name+version (store-path-package-name path)))) - `(,name ,version #f ,path))) + `(,name ,version #f ,path))) (_ #f)) opts) (map (lambda (tuple drv) @@ -382,6 +411,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) remove) install*)))) + (when (equal? (assoc-ref opts 'profile) %current-profile) + (ensure-default-profile)) + (show-what-to-build drv dry-run?) (or dry-run? @@ -458,14 +490,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (setvbuf (current-error-port) _IOLBF) (let ((opts (parse-options))) - - ;; Create ~/.guix-profile if it doesn't exist yet. - (when (and %user-environment-directory - %current-profile - (not (false-if-exception - (lstat %user-environment-directory)))) - (symlink %current-profile %user-environment-directory)) - (with-error-handling (or (process-query opts) (parameterize ((%guile-for-build |