diff options
-rw-r--r-- | shroud/ui.scm | 3 | ||||
-rw-r--r-- | shroud/utils.scm | 29 |
2 files changed, 30 insertions, 2 deletions
diff --git a/shroud/ui.scm b/shroud/ui.scm index 2fb3708..3cceac3 100644 --- a/shroud/ui.scm +++ b/shroud/ui.scm @@ -115,7 +115,7 @@ ARGS is the list of arguments received by the 'throw' handler." (report-load-error file args)))) (define %default-config - `((database-file . ,(string-append (getenv "HOME") "/.shroud-db")) + `((database-file . ,(string-append (getenv "HOME") "/.config/shroud/db.gpg")) (gpg-binary . "gpg"))) (define (load-config) @@ -175,4 +175,5 @@ ARGS is the list of arguments received by the 'throw' handler." command))) (apply proc config db args)))) (unless (eq? db result) + (mkdir-p (dirname db-file)) (save-secrets result db-file user-id)))))))) diff --git a/shroud/utils.scm b/shroud/utils.scm index 59dbbc2..3f28840 100644 --- a/shroud/utils.scm +++ b/shroud/utils.scm @@ -27,7 +27,8 @@ alist-pick gpg-binary call-with-encrypted-output-file - call-with-decrypted-input-file)) + call-with-decrypted-input-file + mkdir-p)) (define (vhash-ref vhash key) "Return the value associated with KEY in VHASH or #f if there is no @@ -113,3 +114,29 @@ FILE." "--no-tty" "--batch" "--yes" "--decrypt" ,file) proc))))) + +;; Written by Ludovic Courtès for GNU Guix. +(define (mkdir-p dir) + "Create directory DIR and all its ancestors." + (define absolute? + (string-prefix? "/" dir)) + + (define not-slash + (char-set-complement (char-set #\/))) + + (let loop ((components (string-tokenize dir not-slash)) + (root (if absolute? + "" + "."))) + (match components + ((head tail ...) + (let ((path (string-append root "/" head))) + (catch 'system-error + (lambda () + (mkdir path) + (loop tail path)) + (lambda args + (if (= EEXIST (system-error-errno args)) + (loop tail path) + (apply throw args)))))) + (() #t)))) |