nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
master
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
guix/scripts.scm
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)))))

7
guix/ui.scm
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)))