>From ef71a89cbd1c0d1c7663d40c4770204179100da4 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <address@hidden>
Date: Mon, 5 Jun 2017 01:34:28 -0500
Subject: [PATCH 6/7] Honor environment variables in guix-register

Added environment variable handling to guix-register. Additionally,
interpretation of parameters state-directory and prefix now more closely
follows the way the old implementation did it.
---
 guix/store.scm | 56 ++++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 44 insertions(+), 12 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index a62fcf3f1..e78cfbe41 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1251,10 +1251,16 @@ makes a wrapper around a port which implements GET-POSITION."
 ;; Figuring out how the C++ stuff currently does it sounds like a lot of
 ;; grepping for global variables...)
 
+;; As far as I can tell there are a couple of anticipated use cases for some
+;; of these parameters: prefix is set if you want to "simulate a chroot", as
+;; far as the database is concerned. For example, you could register paths in
+;; /mnt/gnu/store using #:prefix "/mnt"
+
 (define* (register-path path
-                        #:key (references '()) deriver (prefix "")
-                        (state-directory
-                         (string-append prefix %state-directory)))
+                        #:key (references '()) deriver prefix
+                        state-directory)
+  ;; Priority for options: first what is given, then environment variables,
+  ;; then defaults.
   "Register PATH as a valid store file, with REFERENCES as its list of
 references, and DERIVER as its deriver (.drv that led to it.)  If PREFIX is
 given, it must be the name of the directory containing the new store to
@@ -1264,16 +1270,42 @@ Return #t on success.
 
 Use with care as it directly modifies the store!  This is primarily meant to
 be used internally by the daemon's build hook."
-  (let* ((to-register (string-append %store-directory "/" (basename path))))
+  (let* ((db-dir (cond
+                  (state-directory
+                   (string-append state-directory "/db"))
+                  (prefix
+                   (string-append prefix %state-directory "/db"))
+                  ((getenv "NIX_DB_DIR")
+                   (getenv "NIX_DB_DIR"))
+                  ((getenv "NIX_STATE_DIR")
+                   (string-append (getenv "NIX_STATE_DIR") "/db"))
+                  (else
+                   (string-append %state-directory "/db"))))
+         (store-dir (if prefix
+                        (string-append prefix %store-directory)
+                        (or
+                         (getenv "NIX_STORE_DIR")
+                         (getenv "NIX_STORE")
+                         %store-directory)))
+         (to-register (if prefix
+                          ;; note: we assume here that if path is, for example,
+                          ;; /foo/bar/gnu/store/thing.txt, then an environment
+                          ;; variable has been used to change the store
+                          ;; directory to /foo/bar/gnu/store.
+                          (string-append %store-directory "/" (basename path))
+                          path))
+         (real-path (string-append store-dir "/"
+                                   (basename path))))
     (let-values (((hash nar-size)
-                  (nar-sha256 (string-append prefix "/" to-register))))
-      (sqlite-register #:dbpath (string-append state-directory "/db/db.sqlite")
-                       #:path to-register
-                       #:references references
-                       #:deriver deriver
-                       #:hash (string-append "sha256:"
-                                             (bytevector->base16-string hash))
-                       #:nar-size nar-size))))
+                  (nar-sha256 real-path)))
+      (sqlite-register
+       #:dbpath (string-append db-dir "/db.sqlite")
+       #:path to-register
+       #:references references
+       #:deriver deriver
+       #:hash (string-append "sha256:"
+                             (bytevector->base16-string hash))
+       #:nar-size nar-size))))
 
 
 ;;;
-- 
2.13.0