summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-07-28 14:51:44 +0200
committerLudovic Courtès <ludo@gnu.org>2017-07-28 18:09:43 +0200
commitf0e492f0a54f184e47c0bd639ad338b1b783d258 (patch)
tree65725a2b73771c6ba90e96bd2dccb8dbc673160c
parent6f0f55148d8f70ff5bb7455689a4e78b1807d555 (diff)
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-xguix/scripts/substitute.scm2
-rw-r--r--guix/ui.scm21
-rw-r--r--guix/utils.scm32
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."