scripts: Do not create the config directory.

This fixes runs of 'guix package' and 'guix system' tests in
environments where $HOME is read-only.

* guix/ui.scm (config-directory): Add #:ensure? parameter and honor it.
* guix/scripts.scm (warn-about-old-distro): Pass #:ensure? #f to
'config-directory'.
This commit is contained in:
Ludovic Courtès 2017-05-12 22:39:33 +02:00
parent 0be9b4a9c1
commit e06ca952ed
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 6 additions and 4 deletions

View File

@ -165,7 +165,8 @@ Show what and how will/would be built."
(define age (define age
(match (false-if-not-found (match (false-if-not-found
(lstat (string-append (config-directory) "/latest"))) (lstat (string-append (config-directory #:ensure? #f)
"/latest")))
(#f #f) (#f #f)
(stat (- (time-second (current-time time-utc)) (stat (- (time-second (current-time time-utc))
(stat:mtime stat))))) (stat:mtime stat)))))

View File

@ -775,9 +775,9 @@ replacement if PORT is not Unicode-capable."
(($ <location> file line column) (($ <location> file line column)
(format #f "~a:~a:~a" file line column)))) (format #f "~a:~a:~a" file line column))))
(define (config-directory) (define* (config-directory #:key (ensure? #t))
"Return the name of the configuration directory, after making sure that it "Return the name of the configuration directory, after making sure that it
exists. Honor the XDG specs, exists if ENSURE? is true. Honor the XDG specs,
<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>." <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
(let ((dir (and=> (or (getenv "XDG_CONFIG_HOME") (let ((dir (and=> (or (getenv "XDG_CONFIG_HOME")
(and=> (getenv "HOME") (and=> (getenv "HOME")
@ -785,7 +785,8 @@ exists. Honor the XDG specs,
(cut string-append <> "/guix")))) (cut string-append <> "/guix"))))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(mkdir-p dir) (when ensure?
(mkdir-p dir))
dir) dir)
(lambda args (lambda args
(let ((err (system-error-errno args))) (let ((err (system-error-errno args)))