deduplicate: Use 'sendfile' for small file copies.

* guix/store/deduplication.scm (dump-file/deduplicate): Use 'sendfile'
instead of 'dump-port'.
* tests/store-deduplication.scm ("copy-file/deduplicate, below %deduplication-minimum-size"):
New test.
This commit is contained in:
Ludovic Courtès 2022-12-10 10:56:48 +01:00
parent 591af24ade
commit b129026e2e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 18 additions and 3 deletions

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org> ;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
;;; Copyright © 2018-2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -262,7 +262,7 @@ (define (dump-and-compute-hash)
(deduplicate file (dump-and-compute-hash) #:store store) (deduplicate file (dump-and-compute-hash) #:store store)
(call-with-output-file file (call-with-output-file file
(lambda (output) (lambda (output)
(dump-port input output size))))) (sendfile output input size 0)))))
(define* (copy-file/deduplicate source target (define* (copy-file/deduplicate source target
#:key (store (%store-directory))) #:key (store (%store-directory)))

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020-2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -136,6 +136,21 @@ (define-module (test-store-deduplication)
(cons (apply = (map (compose stat:ino stat) identical)) (cons (apply = (map (compose stat:ino stat) identical))
(map (compose stat:nlink stat) identical)))))) (map (compose stat:nlink stat) identical))))))
(test-assert "copy-file/deduplicate, below %deduplication-minimum-size"
(call-with-temporary-directory
(lambda (store)
(let ((source (string-append store "/input")))
(call-with-output-file source
(lambda (port)
(display "Hello!\n" port)))
(copy-file/deduplicate source
(string-append store "/a")
#:store store)
(and (not (directory-exists? (string-append store "/.links")))
(file=? source (string-append store "/a"))
(not (= (stat:ino (stat (string-append store "/a")))
(stat:ino (stat source)))))))))
(test-assert "copy-file/deduplicate" (test-assert "copy-file/deduplicate"
(call-with-temporary-directory (call-with-temporary-directory
(lambda (store) (lambda (store)