all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 31755@debbugs.gnu.org
Subject: [bug#31755] [PATCH 07/19] deduplicate: Fix a couple of thinkos.
Date: Fri,  8 Jun 2018 11:34:39 +0200	[thread overview]
Message-ID: <20180608093451.27760-7-ludo@gnu.org> (raw)
In-Reply-To: <20180608093451.27760-1-ludo@gnu.org>

* guix/store/deduplication.scm (get-temp-link): Turn 'args' in the 'catch'
handler into a rest argument.
(deduplicate): Use 'lstat' instead of 'file-is-directory?' to properly
handle symlinks.  When iterating over the result of 'scandir', exclude
the ".links" sub-directory.
* tests/store-deduplication.scm ("deduplicate"): Create sub-directories
and call 'deduplicate' directly on STORE.
---
 guix/store/deduplication.scm  | 13 ++++++++-----
 tests/store-deduplication.scm |  9 ++++-----
 2 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 4b4ac01f6..d3139eb90 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -85,7 +85,7 @@ LINK-PREFIX."
       (lambda ()
         (link target tempname)
         tempname)
-      (lambda (args)
+      (lambda args
         (if (= (system-error-errno args) EEXIST)
             (try (tempname-in link-prefix))
             (throw 'system-error args))))))
@@ -120,12 +120,15 @@ under STORE."
          (link-file       (string-append links-directory "/"
                                          (bytevector->base16-string hash))))
     (mkdir-p links-directory)
-    (if (file-is-directory? path)
+    (if (eq? 'directory (stat:type (lstat path)))
         ;; Can't hardlink directories, so hardlink their atoms.
         (for-each (lambda (file)
-                    (unless (member file '("." ".."))
-                      (deduplicate file (nar-sha256 file)
-                                   #:store store)))
+                    (unless (or (member file '("." ".."))
+                                (and (string=? path store)
+                                     (string=? file ".links")))
+                      (let ((file (string-append path "/" file)))
+                        (deduplicate file (nar-sha256 file)
+                                     #:store store))))
                   (scandir path))
         (if (file-exists? link-file)
             (false-if-system-error (EMLINK)
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 04817a193..236172319 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -37,10 +37,12 @@
    (lambda (store)
      (let ((data      (string->utf8 "Hello, world!"))
            (identical (map (lambda (n)
-                             (string-append store "/" (number->string n)))
+                             (string-append store "/" (number->string n)
+                                            "/a/b/c"))
                            (iota 5)))
            (unique    (string-append store "/unique")))
        (for-each (lambda (file)
+                   (mkdir-p (dirname file))
                    (call-with-output-file file
                      (lambda (port)
                        (put-bytevector port data))))
@@ -49,10 +51,7 @@
          (lambda (port)
            (put-bytevector port (string->utf8 "This is unique."))))
 
-       (for-each (lambda (file)
-                   (deduplicate file (sha256 data) #:store store))
-                 identical)
-       (deduplicate unique (nar-sha256 unique) #:store store)
+       (deduplicate store (nar-sha256 store) #:store store)
 
        ;; (system (string-append "ls -lRia " store))
        (cons* (apply = (map (compose stat:ino stat) identical))
-- 
2.17.1

  parent reply	other threads:[~2018-06-08  9:36 UTC|newest]

Thread overview: 22+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2018-06-08  9:30 [bug#31755] [PATCH 00/19] Use (guix store database) instead of 'guix-register' Ludovic Courtès
2018-06-08  9:34 ` [bug#31755] [PATCH 01/19] database: 'with-database' can now initialize new databases Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 02/19] database: Fail registration when encountering unregistered references Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 03/19] store-copy: 'read-reference-graph' returns a list of records Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 04/19] build: Require Guile-SQLite3 Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 05/19] database: Provide a way to specify the schema location Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 06/19] database: 'register-path' creates the database directory if needed Ludovic Courtès
2018-06-08  9:34   ` Ludovic Courtès [this message]
2018-06-08  9:34   ` [bug#31755] [PATCH 08/19] database: Remove extra SQL parameter in 'update-or-insert' Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 09/19] database: Add #:reset-timestamps? to 'register-path' Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 10/19] database: Replace existing entries in Refs Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 11/19] database: 'reset-timestamps' sets file permissions as well Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 12/19] vm: 'expression->derivation-in-linux-vm' code can now use dlopen Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 13/19] install: Use (guix store database) instead of 'guix-register' Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 14/19] database: 'sqlite-register' takes a database, not a file name Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 15/19] database: Add 'register-items' Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 16/19] install: Use 'reset-timestamps' from (guix store database) Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 17/19] database: Allow for deterministic database construction Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 18/19] store: Remove 'register-path' Ludovic Courtès
2018-06-08  9:34   ` [bug#31755] [PATCH 19/19] Remove 'guix-register' and its traces Ludovic Courtès
2018-06-14  9:17 ` bug#31755: [PATCH 00/19] Use (guix store database) instead of 'guix-register' Ludovic Courtès
     [not found] ` <handler.31755.D31755.15289678758292.notifdone@debbugs.gnu.org>
2018-06-14  9:30   ` [bug#31755] closed (Re: [bug#31755] [PATCH 00/19] Use (guix store database) instead of 'guix-register') Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20180608093451.27760-7-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=31755@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.