diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-07-28 14:51:44 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-07-28 18:09:43 +0200 |
commit | f0e492f0a54f184e47c0bd639ad338b1b783d258 (patch) | |
tree | 65725a2b73771c6ba90e96bd2dccb8dbc673160c | |
parent | 6f0f55148d8f70ff5bb7455689a4e78b1807d555 (diff) | |
download | patches-f0e492f0a54f184e47c0bd639ad338b1b783d258.tar patches-f0e492f0a54f184e47c0bd639ad338b1b783d258.tar.gz |
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'.
-rwxr-xr-x | guix/scripts/substitute.scm | 2 | ||||
-rw-r--r-- | guix/ui.scm | 21 | ||||
-rw-r--r-- | guix/utils.scm | 32 |
3 files changed, 25 insertions, 30 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 35282f9027..0d36997bc4 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -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 diff --git a/guix/ui.scm b/guix/ui.scm index 4bad00e8cf..b0108d0705 100644 --- a/guix/ui.scm +++ b/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. diff --git a/guix/utils.scm b/guix/utils.scm index 9bf1cc893f..ab43ed4008 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -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." |