utils: Factorize XDG directory handling.
* guix/ui.scm (config-directory): Remove. * guix/utils.scm (xdg-directory, config-directory): New procedures. (cache-directory): Rewrite in terms of 'xdg-directory'. * guix/scripts/substitute.scm (%narinfo-cache-directory): Pass #:ensure? #f to 'cache-directory'.master
parent
6f0f55148d
commit
f0e492f0a5
|
@ -113,7 +113,7 @@
|
|||
(or (and=> (getenv "XDG_CACHE_HOME")
|
||||
(cut string-append <> "/guix/substitute"))
|
||||
(string-append %state-directory "/substitute/cache"))
|
||||
(string-append (cache-directory) "/substitute")))
|
||||
(string-append (cache-directory #:ensure? #f) "/substitute")))
|
||||
|
||||
(define %allow-unauthenticated-substitutes?
|
||||
;; Whether to allow unchecked substitutes. This is useful for testing
|
||||
|
|
21
guix/ui.scm
21
guix/ui.scm
|
@ -36,7 +36,6 @@
|
|||
#:use-module (guix combinators)
|
||||
#:use-module (guix build-system)
|
||||
#:use-module (guix serialization)
|
||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
||||
#:use-module ((guix licenses) #:select (license? license-name))
|
||||
#:use-module ((guix build syscalls)
|
||||
#:select (free-disk-space terminal-columns))
|
||||
|
@ -79,7 +78,6 @@
|
|||
read/eval
|
||||
read/eval-package-expression
|
||||
location->string
|
||||
config-directory
|
||||
fill-paragraph
|
||||
texi->plain-text
|
||||
package-description-string
|
||||
|
@ -856,25 +854,6 @@ replacement if PORT is not Unicode-capable."
|
|||
(($ <location> file line column)
|
||||
(format #f "~a:~a:~a" file line column))))
|
||||
|
||||
(define* (config-directory #:key (ensure? #t))
|
||||
"Return the name of the configuration directory, after making sure that it
|
||||
exists if ENSURE? is true. Honor the XDG specs,
|
||||
<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
|
||||
(let ((dir (and=> (or (getenv "XDG_CONFIG_HOME")
|
||||
(and=> (getenv "HOME")
|
||||
(cut string-append <> "/.config")))
|
||||
(cut string-append <> "/guix"))))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(when ensure?
|
||||
(mkdir-p dir))
|
||||
dir)
|
||||
(lambda args
|
||||
(let ((err (system-error-errno args)))
|
||||
;; ERR is necessarily different from EEXIST.
|
||||
(leave (G_ "failed to create configuration directory `~a': ~a~%")
|
||||
dir (strerror err)))))))
|
||||
|
||||
(define* (fill-paragraph str width #:optional (column 0))
|
||||
"Fill STR such that each line contains at most WIDTH characters, assuming
|
||||
that the first character is at COLUMN.
|
||||
|
|
|
@ -33,7 +33,7 @@
|
|||
#:autoload (rnrs io ports) (make-custom-binary-input-port)
|
||||
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
|
||||
#:use-module (guix memoization)
|
||||
#:use-module ((guix build utils) #:select (dump-port))
|
||||
#:use-module ((guix build utils) #:select (dump-port mkdir-p))
|
||||
#:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
|
||||
#:use-module (ice-9 format)
|
||||
#:autoload (ice-9 popen) (open-pipe*)
|
||||
|
@ -81,7 +81,10 @@
|
|||
call-with-temporary-output-file
|
||||
call-with-temporary-directory
|
||||
with-atomic-file-output
|
||||
|
||||
config-directory
|
||||
cache-directory
|
||||
|
||||
readlink*
|
||||
edit-expression
|
||||
|
||||
|
@ -598,13 +601,26 @@ output port, and PROC's result is returned."
|
|||
(false-if-exception (delete-file template))
|
||||
(close-port out)))))
|
||||
|
||||
(define (cache-directory)
|
||||
"Return the cache directory for Guix, by default ~/.cache/guix."
|
||||
(string-append (or (getenv "XDG_CACHE_HOME")
|
||||
(and=> (or (getenv "HOME")
|
||||
(passwd:dir (getpwuid (getuid))))
|
||||
(cut string-append <> "/.cache")))
|
||||
"/guix"))
|
||||
(define* (xdg-directory variable suffix #:key (ensure? #t))
|
||||
"Return the name of the XDG directory that matches VARIABLE and SUFFIX,
|
||||
after making sure that it exists if ENSURE? is true. VARIABLE is an
|
||||
environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like
|
||||
\"/.config\". Honor the XDG specs,
|
||||
<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
|
||||
(let ((dir (and=> (or (getenv variable)
|
||||
(and=> (or (getenv "HOME")
|
||||
(passwd:dir (getpwuid (getuid))))
|
||||
(cut string-append <> suffix)))
|
||||
(cut string-append <> "/guix"))))
|
||||
(when ensure?
|
||||
(mkdir-p dir))
|
||||
dir))
|
||||
|
||||
(define config-directory
|
||||
(cut xdg-directory "XDG_CONFIG_HOME" "/.config" <...>))
|
||||
|
||||
(define cache-directory
|
||||
(cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>))
|
||||
|
||||
(define (readlink* file)
|
||||
"Call 'readlink' until the result is not a symlink."
|
||||
|
|
Reference in New Issue