From e5735a08567e370b60cc1570f04f9a76019541f5 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 17 Aug 2015 21:51:16 -0400
Subject: Move default database file to ~/.config/shroud/db.gpg.

* shroud/utils.scm (mkdir-p): New procedure.
* shroud/ui.scm (%default-config): Change default value of
  'database-file'.
  (shroud-main): Ensure database directory has been created before
  saving.
---
 shroud/ui.scm    |  3 ++-
 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))))
-- 
cgit v1.2.3