From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 06:28:15 2018 Received: (at submit) by debbugs.gnu.org; 28 May 2018 10:28:16 +0000 Received: from localhost ([127.0.0.1]:51625 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFNv-00018V-L3 for submit@debbugs.gnu.org; Mon, 28 May 2018 06:28:15 -0400 Received: from eggs.gnu.org ([208.118.235.92]:50947) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFNs-00018H-Nv for submit@debbugs.gnu.org; Mon, 28 May 2018 06:28:13 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNFNj-00025M-L8 for submit@debbugs.gnu.org; Mon, 28 May 2018 06:28:07 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-0.0 required=5.0 tests=BAYES_20 autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:52508) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fNFNj-00025I-Hn for submit@debbugs.gnu.org; Mon, 28 May 2018 06:28:03 -0400 Received: from eggs.gnu.org ([2001:4830:134:3::10]:41872) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNFNe-0007Jm-Cy for guix-patches@gnu.org; Mon, 28 May 2018 06:28:03 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNFNa-0001zs-KJ for guix-patches@gnu.org; Mon, 28 May 2018 06:27:58 -0400 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35402) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNFNT-0001vs-3G; Mon, 28 May 2018 06:27:47 -0400 Received: from [193.50.110.236] (port=51602 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fNFNS-00005i-4X; Mon, 28 May 2018 06:27:46 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: guix-patches@gnu.org Subject: [PATCH 0/4] Merge the beginning of the 'guile-daemon' branch Date: Mon, 28 May 2018 12:27:36 +0200 Message-Id: <20180528102736.8738-1-ludo@gnu.org> X-Mailer: git-send-email 2.17.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: submit Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) Hello Guix! These patches merge the beginning of reepca’s work on the Guile implementation of the build daemon from last year’s GSoC. It is based on these commits by reepca: a647f6e74 deduplication: new module. b418ff86b guix: register-path: return #t on success. 6b979a819 guix: register-path: do deduplication. 374281f52 guix: register-path: reset timestamps after registering. b6d9b2675 guix: register-path: use new %store-database-directory 4d945be54 guix: sql.scm: split into generic and store-specific parts. 70cbb8c81 .dir-locals.el: properly indent sql macros. bcacbdfd2 guix: register-path: Honor environment variables. 654c8a776 guix: register-path: Implement prototype in scheme. I modified things in several ways: • Added configury to detect Guile-SQLite3 and make it an optional dependency. • Moved all the sqlite3-dependent code to (guix store database) so that it can really be optional; in reepca’s branch part of it was directly in (guix store). • Removed (guix sql). Most of what it provided is now available in guile-sqlite3 proper, so I adjusted (guix store database) to take advantage of that. • Added tests for (guix store database) and (guix store deduplication), which allowed me to fix a couple of bugs. The next step is to start using this internally in lieu of the ‘guix-register’ command. At some point, we’ll have to make Guile-SQLite3 a mandatory dependency. It would be nice if someone would take care of making proper releases of it. :-) Any takers? Danny? BTW, kudos to you reepca for the nice code! Thanks, Ludo’. Caleb Ristvedt (2): Add (gnu store database). Add (guix store deduplication). Ludovic Courtès (2): build: Check for Guile-SQLite3. database: 'register-path' resets timestamps. .dir-locals.el | 2 + Makefile.am | 19 +++ configure.ac | 5 + guix/config.scm.in | 6 + guix/self.scm | 9 +- guix/store/database.scm | 234 ++++++++++++++++++++++++++++++++++ guix/store/deduplication.scm | 148 +++++++++++++++++++++ m4/guix.m4 | 18 +++ tests/store-database.scm | 54 ++++++++ tests/store-deduplication.scm | 64 ++++++++++ 10 files changed, 558 insertions(+), 1 deletion(-) create mode 100644 guix/store/database.scm create mode 100644 guix/store/deduplication.scm create mode 100644 tests/store-database.scm create mode 100644 tests/store-deduplication.scm -- 2.17.0 From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 06:36:44 2018 Received: (at 31618) by debbugs.gnu.org; 28 May 2018 10:36:45 +0000 Received: from localhost ([127.0.0.1]:51633 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFW3-0001LL-In for submit@debbugs.gnu.org; Mon, 28 May 2018 06:36:44 -0400 Received: from eggs.gnu.org ([208.118.235.92]:52378) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFW1-0001L1-ON for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:38 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNFVt-00007q-MO for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:32 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35485) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNFVt-00007e-IK; Mon, 28 May 2018 06:36:29 -0400 Received: from [193.50.110.236] (port=51834 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fNFVr-0005Wb-GF; Mon, 28 May 2018 06:36:28 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 31618@debbugs.gnu.org Subject: [PATCH 2/4] Add (gnu store database). Date: Mon, 28 May 2018 12:36:13 +0200 Message-Id: <20180528103615.8995-2-ludo@gnu.org> X-Mailer: git-send-email 2.17.0 In-Reply-To: <20180528103615.8995-1-ludo@gnu.org> References: <20180528103615.8995-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 31618 Cc: Caleb Ristvedt X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) From: Caleb Ristvedt * guix/config.scm.in (%store-database-directory): New variable. * guix/store/database.scm: New file. * tests/store-database.scm: New file. * Makefile.am (STORE_MODULES): New variable. (MODULES, MODULES_NOT_COMPILED): Adjust accordingly. (SCM_TESTS) [HAVE_GUILE_SQLITE3]: Add tests/store-database.scm. Co-authored-by: Ludovic Courtès --- .dir-locals.el | 2 + Makefile.am | 17 +++ guix/config.scm.in | 6 + guix/store/database.scm | 234 +++++++++++++++++++++++++++++++++++++++ tests/store-database.scm | 54 +++++++++ 5 files changed, 313 insertions(+) create mode 100644 guix/store/database.scm create mode 100644 tests/store-database.scm diff --git a/.dir-locals.el b/.dir-locals.el index dac6cb145..a993cbcf8 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -74,6 +74,8 @@ (eval . (put 'wrap-program 'scheme-indent-function 1)) (eval . (put 'with-imported-modules 'scheme-indent-function 1)) + (eval . (put 'with-database 'scheme-indent-function 2)) + (eval . (put 'call-with-container 'scheme-indent-function 1)) (eval . (put 'container-excursion 'scheme-indent-function 1)) (eval . (put 'eventually 'scheme-indent-function 1)) diff --git a/Makefile.am b/Makefile.am index 2a0a85842..d81fce558 100644 --- a/Makefile.am +++ b/Makefile.am @@ -257,6 +257,16 @@ MODULES += \ endif BUILD_DAEMON_OFFLOAD +# Scheme implementation of the build daemon and related functionality. +STORE_MODULES = \ + guix/store/database.scm + +if HAVE_GUILE_SQLITE3 +MODULES += $(STORE_MODULES) +else +MODULES_NOT_COMPILED += $(STORE_MODULES) +endif !HAVE_GUILE_SQLITE3 + # Internal modules with test suite support. dist_noinst_DATA = guix/tests.scm guix/tests/http.scm @@ -379,6 +389,13 @@ SCM_TESTS += \ endif +if HAVE_GUILE_SQLITE3 + +SCM_TESTS += \ + tests/store-database.scm + +endif + SH_TESTS = \ tests/guix-build.sh \ tests/guix-download.sh \ diff --git a/guix/config.scm.in b/guix/config.scm.in index 8f2c4abd8..dfe5fe0db 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2017 Caleb Ristvedt ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +30,7 @@ %store-directory %state-directory + %store-database-directory %config-directory %guix-register-program @@ -80,6 +82,10 @@ (or (getenv "NIX_STATE_DIR") (string-append %localstatedir "/guix"))) +(define %store-database-directory + (or (and=> (getenv "NIX_DB_DIR") canonicalize-path) + (string-append %state-directory "/db"))) + (define %config-directory ;; This must match `GUIX_CONFIGURATION_DIRECTORY' as defined in `nix/local.mk'. (or (getenv "GUIX_CONFIGURATION_DIRECTORY") diff --git a/guix/store/database.scm b/guix/store/database.scm new file mode 100644 index 000000000..4233219ba --- /dev/null +++ b/guix/store/database.scm @@ -0,0 +1,234 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Caleb Ristvedt +;;; Copyright © 2018 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix store database) + #:use-module (sqlite3) + #:use-module (guix config) + #:use-module (guix serialization) + #:use-module (guix base16) + #:use-module (guix hash) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) + #:use-module (ice-9 match) + #:export (sqlite-register + register-path)) + +;;; Code for working with the store database directly. + + +(define-syntax-rule (with-database file db exp ...) + "Open DB from FILE and close it when the dynamic extent of EXP... is left." + (let ((db (sqlite-open file))) + (dynamic-wind noop + (lambda () + exp ...) + (lambda () + (sqlite-close db))))) + +(define (last-insert-row-id db) + ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. + ;; Work around that. + (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();" + #:cache? #t)) + (result (sqlite-fold cons '() stmt))) + (sqlite-finalize stmt) + (match result + ((#(id)) id) + (_ #f)))) + +(define path-id-sql + "SELECT id FROM ValidPaths WHERE path = :path") + +(define* (path-id db path) + "If PATH exists in the 'ValidPaths' table, return its numerical +identifier. Otherwise, return #f." + (let ((stmt (sqlite-prepare db path-id-sql #:cache? #t))) + (sqlite-bind-arguments stmt #:path path) + (let ((result (sqlite-fold cons '() stmt))) + (sqlite-finalize stmt) + (match result + ((#(id) . _) id) + (_ #f))))) + +(define update-sql + "UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver = +:deriver, narSize = :size WHERE id = :id") + +(define insert-sql + "INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) +VALUES (:path, :hash, :time, :deriver, :size)") + +(define* (update-or-insert db #:key path deriver hash nar-size time) + "The classic update-if-exists and insert-if-doesn't feature that sqlite +doesn't exactly have... they've got something close, but it involves deleting +and re-inserting instead of updating, which causes problems with foreign keys, +of course. Returns the row id of the row that was modified or inserted." + (let ((id (path-id db path))) + (if id + (let ((stmt (sqlite-prepare db update-sql #:cache? #t))) + (sqlite-bind-arguments stmt #:id id + #:path path #:deriver deriver + #:hash hash #:size nar-size #:time time) + (sqlite-fold cons '() stmt) + (sqlite-finalize stmt) + (last-insert-row-id db)) + (let ((stmt (sqlite-prepare db insert-sql #:cache? #t))) + (sqlite-bind-arguments stmt + #:path path #:deriver deriver + #:hash hash #:size nar-size #:time time) + (sqlite-fold cons '() stmt) ;execute it + (sqlite-finalize stmt) + (last-insert-row-id db))))) + +(define add-reference-sql + "INSERT OR IGNORE INTO Refs (referrer, reference) SELECT :referrer, id +FROM ValidPaths WHERE path = :reference") + +(define (add-references db referrer references) + "REFERRER is the id of the referring store item, REFERENCES is a list +containing store items being referred to. Note that all of the store items in +REFERENCES must already be registered." + (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t))) + (for-each (lambda (reference) + (sqlite-reset stmt) + (sqlite-bind-arguments stmt #:referrer referrer + #:reference reference) + (sqlite-fold cons '() stmt) ;execute it + (sqlite-finalize stmt) + (last-insert-row-id db)) + references))) + +;; XXX figure out caching of statement and database objects... later +(define* (sqlite-register #:key db-file path (references '()) + deriver hash nar-size) + "Registers this stuff in a database specified by DB-FILE. PATH is the string +path of some store item, REFERENCES is a list of string paths which the store +item PATH refers to (they need to be already registered!), DERIVER is a string +path of the derivation that created the store item PATH, HASH is the +base16-encoded sha256 hash of the store item denoted by PATH (prefixed with +\"sha256:\") after being converted to nar form, and nar-size is the size in +bytes of the store item denoted by PATH after being converted to nar form." + (with-database db-file db + (let ((id (update-or-insert db #:path path + #:deriver deriver + #:hash hash + #:nar-size nar-size + #:time (time-second (current-time time-utc))))) + (add-references db id references)))) + + +;;; +;;; High-level interface. +;;; + +;; XXX: Would it be better to just make WRITE-FILE give size as well? I question +;; the general utility of this approach. +(define (counting-wrapper-port output-port) + "Some custom ports don't implement GET-POSITION at all. But if we want to +figure out how many bytes are being written, we will want to use that. So this +makes a wrapper around a port which implements GET-POSITION." + (let ((byte-count 0)) + (make-custom-binary-output-port "counting-wrapper" + (lambda (bytes offset count) + (set! byte-count + (+ byte-count count)) + (put-bytevector output-port bytes + offset count) + count) + (lambda () + byte-count) + #f + (lambda () + (close-port output-port))))) + + +(define (nar-sha256 file) + "Gives the sha256 hash of a file and the size of the file in nar form." + (let-values (((port get-hash) (open-sha256-port))) + (let ((wrapper (counting-wrapper-port port))) + (write-file file wrapper) + (force-output wrapper) + (force-output port) + (let ((hash (get-hash)) + (size (port-position wrapper))) + (close-port wrapper) + (values hash size))))) + +;; TODO: make this canonicalize store items that are registered. This involves +;; setting permissions and timestamps, I think. Also, run a "deduplication +;; pass", whatever that involves. Also, handle databases not existing yet +;; (what should the default behavior be? Figuring out how the C++ stuff +;; currently does it sounds like a lot of grepping for global +;; variables...). Also, return #t on success like the documentation says we +;; should. + +(define* (register-path path + #:key (references '()) deriver prefix + state-directory) + ;; Priority for options: first what is given, then environment variables, + ;; then defaults. %state-directory, %store-directory, and + ;; %store-database-directory already handle the "environment variables / + ;; defaults" question, so we only need to choose between what is given and + ;; those. + "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 +initialize; if STATE-DIRECTORY is given, it must be a string containing the +absolute file name to the state directory of the store being initialized. +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* ((db-dir (cond + (state-directory + (string-append state-directory "/db")) + (prefix + ;; If prefix is specified, the value of NIX_STATE_DIR + ;; (which affects %state-directory) isn't supposed to + ;; affect db-dir, only the compile-time-customized + ;; default should. + (string-append prefix %localstatedir "/guix/db")) + (else + %store-database-directory))) + (store-dir (if prefix + ;; same situation as above + (string-append prefix %storedir) + %store-directory)) + (to-register (if prefix + (string-append %storedir "/" (basename path)) + ;; note: we assume here that if path is, for + ;; example, /foo/bar/gnu/store/thing.txt and prefix + ;; isn't given, then an environment variable has + ;; been used to change the store directory to + ;; /foo/bar/gnu/store, since otherwise real-path + ;; would end up being /gnu/store/thing.txt, which is + ;; probably not the right file in this case. + path)) + (real-path (string-append store-dir "/" (basename path)))) + (let-values (((hash nar-size) + (nar-sha256 real-path))) + (sqlite-register + #:db-file (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)))) diff --git a/tests/store-database.scm b/tests/store-database.scm new file mode 100644 index 000000000..1348a75c2 --- /dev/null +++ b/tests/store-database.scm @@ -0,0 +1,54 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017, 2018 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-store-database) + #:use-module (guix tests) + #:use-module ((guix store) #:hide (register-path)) + #:use-module (guix store database) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64)) + +;; Test the (guix store database) module. + +(define %store + (open-connection-for-tests)) + + +(test-begin "store-database") + +(test-assert "register-path" + (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f) + "-fake"))) + (when (valid-path? %store file) + (delete-paths %store (list file))) + (false-if-exception (delete-file file)) + + (let ((ref (add-text-to-store %store "ref-of-fake" (random-text))) + (drv (string-append file ".drv"))) + (call-with-output-file file + (cut display "This is a fake store item.\n" <>)) + (register-path file + #:references (list ref) + #:deriver drv) + + (and (valid-path? %store file) + (equal? (references %store file) (list ref)) + (null? (valid-derivers %store file)) + (null? (referrers %store file)))))) + +(test-end "store-database") -- 2.17.0 From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 06:36:45 2018 Received: (at 31618) by debbugs.gnu.org; 28 May 2018 10:36:45 +0000 Received: from localhost ([127.0.0.1]:51636 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFW8-0001LY-UL for submit@debbugs.gnu.org; Mon, 28 May 2018 06:36:45 -0400 Received: from eggs.gnu.org ([208.118.235.92]:52384) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFW2-0001L3-L0 for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:39 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNFVw-00009w-B7 for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:33 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-0.0 required=5.0 tests=BAYES_20 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35484) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNFVr-00005M-6i; Mon, 28 May 2018 06:36:27 -0400 Received: from [193.50.110.236] (port=51834 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fNFVp-0005Wb-L4; Mon, 28 May 2018 06:36:26 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 31618@debbugs.gnu.org Subject: [PATCH 1/4] build: Check for Guile-SQLite3. Date: Mon, 28 May 2018 12:36:12 +0200 Message-Id: <20180528103615.8995-1-ludo@gnu.org> X-Mailer: git-send-email 2.17.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 31618 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * m4/guix.m4 (GUIX_CHECK_GUILE_SQLITE3): New macro. * configure.ac: Use it and define 'HAVE_GUILE_SQLITE3'. * guix/self.scm (specification->package): Add "guile-sqlite3". (compiled-guix)[guile-sqlite3]: New variable. [dependencies]: Add it. --- configure.ac | 5 +++++ guix/self.scm | 9 ++++++++- m4/guix.m4 | 18 ++++++++++++++++++ 3 files changed, 31 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 557da6318..d338bfda5 100644 --- a/configure.ac +++ b/configure.ac @@ -124,6 +124,11 @@ dnl Guile-JSON is used in various places. GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"]) +dnl Guile-Sqlite3 is used by the (guix store ...) modules. +GUIX_CHECK_GUILE_SQLITE3 +AM_CONDITIONAL([HAVE_GUILE_SQLITE3], + [test "x$guix_cv_have_recent_guile_sqlite3" = "xyes"]) + dnl Make sure we have a full-fledged Guile. GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads]) diff --git a/guix/self.scm b/guix/self.scm index 4378a3dee..9fc10a4b9 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -82,6 +82,7 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." ("guile-json" (ref '(gnu packages guile) 'guile-json)) ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) ("guile-git" (ref '(gnu packages guile) 'guile-git)) + ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) ("libgcrypt" (ref '(gnu packages gnupg) 'libgcrypt)) ("zlib" (ref '(gnu packages compression) 'zlib)) ("gzip" (ref '(gnu packages compression) 'gzip)) @@ -92,6 +93,7 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." ("guile2.0-json" (ref '(gnu packages guile) 'guile2.0-json)) ("guile2.0-ssh" (ref '(gnu packages ssh) 'guile2.0-ssh)) ("guile2.0-git" (ref '(gnu packages guile) 'guile2.0-git)) + ;; XXX: No "guile2.0-sqlite3". (_ #f)))) ;no such package @@ -216,11 +218,16 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." "guile2.0-git")) + (define guile-sqlite3 + (package-for-guile guile-version + "guile-sqlite3" + "guile2.0-sqlite3")) + (define dependencies (match (append-map (lambda (package) (cons (list "x" package) (package-transitive-inputs package))) - (list guile-git guile-json guile-ssh)) + (list guile-git guile-json guile-ssh guile-sqlite3)) (((labels packages _ ...) ...) packages))) diff --git a/m4/guix.m4 b/m4/guix.m4 index 8e174e92e..a6897be96 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 @@ -174,6 +174,24 @@ AC_DEFUN([GUIX_CHECK_GUILE_SSH], [ fi]) ]) +dnl GUIX_CHECK_GUILE_SQLITE3 +dnl +dnl Check whether a recent-enough Guile-Sqlite3 is available. +AC_DEFUN([GUIX_CHECK_GUILE_SQLITE3], [ + dnl Check whether 'sqlite-bind-arguments' is available. It was introduced + dnl in February 2018: + dnl . + AC_CACHE_CHECK([whether Guile-Sqlite3 is available and recent enough], + [guix_cv_have_recent_guile_sqlite3], + [GUILE_CHECK([retval], + [(@ (sqlite3) sqlite-bind-arguments)]) + if test "$retval" = 0; then + guix_cv_have_recent_guile_sqlite3="yes" + else + guix_cv_have_recent_guile_sqlite3="no" + fi]) +]) + dnl GUIX_TEST_ROOT_DIRECTORY AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ AC_CACHE_CHECK([for unit test root directory], -- 2.17.0 From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 06:36:45 2018 Received: (at 31618) by debbugs.gnu.org; 28 May 2018 10:36:46 +0000 Received: from localhost ([127.0.0.1]:51638 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFW9-0001Lj-An for submit@debbugs.gnu.org; Mon, 28 May 2018 06:36:45 -0400 Received: from eggs.gnu.org ([208.118.235.92]:52395) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFW4-0001L5-KX for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:41 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNFVx-0000AW-Dr for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:35 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35488) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNFVx-0000AR-8J; Mon, 28 May 2018 06:36:33 -0400 Received: from [193.50.110.236] (port=51834 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fNFVv-0005Wb-Vk; Mon, 28 May 2018 06:36:32 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 31618@debbugs.gnu.org Subject: [PATCH 4/4] Add (guix store deduplication). Date: Mon, 28 May 2018 12:36:15 +0200 Message-Id: <20180528103615.8995-4-ludo@gnu.org> X-Mailer: git-send-email 2.17.0 In-Reply-To: <20180528103615.8995-1-ludo@gnu.org> References: <20180528103615.8995-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 31618 Cc: Caleb Ristvedt X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) From: Caleb Ristvedt * guix/store/database.scm (register-path): Add #:deduplicate? and call 'deduplicate' when it's true. (counting-wrapper-port, nar-sha256): Move to... * guix/store/deduplication.scm: ... here. New file. * tests/store-deduplication.scm: New file. * Makefile.am (STORE_MODULES): Add deduplication.scm. (SCM_TESTS) [HAVE_GUILE_SQLITE3]: Add store-deduplication.scm. Co-authored-by: Ludovic Courtès --- Makefile.am | 6 +- guix/store/database.scm | 43 ++-------- guix/store/deduplication.scm | 148 ++++++++++++++++++++++++++++++++++ tests/store-deduplication.scm | 64 +++++++++++++++ 4 files changed, 222 insertions(+), 39 deletions(-) create mode 100644 guix/store/deduplication.scm create mode 100644 tests/store-deduplication.scm diff --git a/Makefile.am b/Makefile.am index d81fce558..474575c9f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -259,7 +259,8 @@ endif BUILD_DAEMON_OFFLOAD # Scheme implementation of the build daemon and related functionality. STORE_MODULES = \ - guix/store/database.scm + guix/store/database.scm \ + guix/store/deduplication.scm if HAVE_GUILE_SQLITE3 MODULES += $(STORE_MODULES) @@ -392,7 +393,8 @@ endif if HAVE_GUILE_SQLITE3 SCM_TESTS += \ - tests/store-database.scm + tests/store-database.scm \ + tests/store-deduplication.scm endif diff --git a/guix/store/database.scm b/guix/store/database.scm index b9745dbe1..3623c0e7a 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -21,10 +21,9 @@ #:use-module (sqlite3) #:use-module (guix config) #:use-module (guix serialization) + #:use-module (guix store deduplication) #:use-module (guix base16) - #:use-module (guix hash) #:use-module (guix build syscalls) - #:use-module (rnrs io ports) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (ice-9 match) @@ -140,39 +139,6 @@ bytes of the store item denoted by PATH after being converted to nar form." ;;; High-level interface. ;;; -;; XXX: Would it be better to just make WRITE-FILE give size as well? I question -;; the general utility of this approach. -(define (counting-wrapper-port output-port) - "Some custom ports don't implement GET-POSITION at all. But if we want to -figure out how many bytes are being written, we will want to use that. So this -makes a wrapper around a port which implements GET-POSITION." - (let ((byte-count 0)) - (make-custom-binary-output-port "counting-wrapper" - (lambda (bytes offset count) - (set! byte-count - (+ byte-count count)) - (put-bytevector output-port bytes - offset count) - count) - (lambda () - byte-count) - #f - (lambda () - (close-port output-port))))) - - -(define (nar-sha256 file) - "Gives the sha256 hash of a file and the size of the file in nar form." - (let-values (((port get-hash) (open-sha256-port))) - (let ((wrapper (counting-wrapper-port port))) - (write-file file wrapper) - (force-output wrapper) - (force-output port) - (let ((hash (get-hash)) - (size (port-position wrapper))) - (close-port wrapper) - (values hash size))))) - ;; TODO: Factorize with that in (gnu build install). (define (reset-timestamps file) "Reset the modification time on FILE and on all the files it contains, if @@ -211,7 +177,7 @@ it's a directory." (define* (register-path path #:key (references '()) deriver prefix - state-directory) + state-directory (deduplicate? #t)) ;; Priority for options: first what is given, then environment variables, ;; then defaults. %state-directory, %store-directory, and ;; %store-database-directory already handle the "environment variables / @@ -262,4 +228,7 @@ be used internally by the daemon's build hook." #:deriver deriver #:hash (string-append "sha256:" (bytevector->base16-string hash)) - #:nar-size nar-size)))) + #:nar-size nar-size) + + (when deduplicate? + (deduplicate real-path hash #:store store-dir))))) diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm new file mode 100644 index 000000000..4b4ac01f6 --- /dev/null +++ b/guix/store/deduplication.scm @@ -0,0 +1,148 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Caleb Ristvedt +;;; Copyright © 2018 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +;;; This houses stuff we do to files when they arrive at the store - resetting +;;; timestamps, deduplicating, etc. + +(define-module (guix store deduplication) + #:use-module (guix hash) + #:use-module (guix build utils) + #:use-module (guix base16) + #:use-module (srfi srfi-11) + #:use-module (rnrs io ports) + #:use-module (ice-9 ftw) + #:use-module (guix serialization) + #:export (nar-sha256 + deduplicate)) + +;; Would it be better to just make WRITE-FILE give size as well? I question +;; the general utility of this approach. +(define (counting-wrapper-port output-port) + "Some custom ports don't implement GET-POSITION at all. But if we want to +figure out how many bytes are being written, we will want to use that. So this +makes a wrapper around a port which implements GET-POSITION." + (let ((byte-count 0)) + (make-custom-binary-output-port "counting-wrapper" + (lambda (bytes offset count) + (set! byte-count + (+ byte-count count)) + (put-bytevector output-port bytes + offset count) + count) + (lambda () + byte-count) + #f + (lambda () + (close-port output-port))))) + +(define (nar-sha256 file) + "Gives the sha256 hash of a file and the size of the file in nar form." + (let-values (((port get-hash) (open-sha256-port))) + (let ((wrapper (counting-wrapper-port port))) + (write-file file wrapper) + (force-output wrapper) + (force-output port) + (let ((hash (get-hash)) + (size (port-position wrapper))) + (close-port wrapper) + (values hash size))))) + +(define (tempname-in directory) + "Gives an unused temporary name under DIRECTORY. Not guaranteed to still be +unused by the time you create anything with that name, but a good shot." + (let ((const-part (string-append directory "/.tmp-link-" + (number->string (getpid))))) + (let try ((guess-part + (number->string (random most-positive-fixnum) 16))) + (if (file-exists? (string-append const-part "-" guess-part)) + (try (number->string (random most-positive-fixnum) 16)) + (string-append const-part "-" guess-part))))) + +(define* (get-temp-link target #:optional (link-prefix (dirname target))) + "Like mkstemp!, but instead of creating a new file and giving you the name, +it creates a new hardlink to TARGET and gives you the name. Since +cross-filesystem hardlinks don't work, the temp link must be created on the +same filesystem - where in that filesystem it is can be controlled by +LINK-PREFIX." + (let try ((tempname (tempname-in link-prefix))) + (catch 'system-error + (lambda () + (link target tempname) + tempname) + (lambda (args) + (if (= (system-error-errno args) EEXIST) + (try (tempname-in link-prefix)) + (throw 'system-error args)))))) + +;; There are 3 main kinds of errors we can get from hardlinking: "Too many +;; things link to this" (EMLINK), "this link already exists" (EEXIST), and +;; "can't fit more stuff in this directory" (ENOSPC). + +(define (replace-with-link target to-replace) + "Atomically replace the file TO-REPLACE with a link to TARGET. Note: TARGET +and TO-REPLACE must be on the same file system." + (let ((temp-link (get-temp-link target (dirname to-replace)))) + (rename-file temp-link to-replace))) + +(define-syntax-rule (false-if-system-error (errors ...) exp ...) + "Given ERRORS, a list of system error codes to ignore, evaluates EXP... and +return #f if any of the system error codes in the given list are thrown." + (catch 'system-error + (lambda () + exp ...) + (lambda args + (if (member (system-error-errno args) (list errors ...)) + #f + (apply throw args))))) + +(define* (deduplicate path hash #:key (store %store-directory)) + "Check if a store item with sha256 hash HASH already exists. If so, +replace PATH with a hardlink to the already-existing one. If not, register +PATH so that future duplicates can hardlink to it. PATH is assumed to be +under STORE." + (let* ((links-directory (string-append store "/.links")) + (link-file (string-append links-directory "/" + (bytevector->base16-string hash)))) + (mkdir-p links-directory) + (if (file-is-directory? path) + ;; Can't hardlink directories, so hardlink their atoms. + (for-each (lambda (file) + (unless (member file '("." "..")) + (deduplicate file (nar-sha256 file) + #:store store))) + (scandir path)) + (if (file-exists? link-file) + (false-if-system-error (EMLINK) + (replace-with-link link-file path)) + (catch 'system-error + (lambda () + (link path link-file)) + (lambda args + (let ((errno (system-error-errno args))) + (cond ((= errno EEXIST) + ;; Someone else put an entry for PATH in + ;; LINKS-DIRECTORY before we could. Let's use it. + (false-if-system-error (EMLINK) + (replace-with-link path link-file))) + ((= errno ENOSPC) + ;; There's not enough room in the directory index for + ;; more entries in .links, but that's fine: we can + ;; just stop. + #f) + (else (apply throw args)))))))))) diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm new file mode 100644 index 000000000..04817a193 --- /dev/null +++ b/tests/store-deduplication.scm @@ -0,0 +1,64 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-store-deduplication) + #:use-module (guix tests) + #:use-module (guix store deduplication) + #:use-module (guix hash) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module (guix build utils) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 binary-ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +(test-begin "store-deduplication") + +(test-equal "deduplicate" + (cons* #t #f ;inode comparisons + 2 (make-list 5 6)) ;'nlink' values + + (call-with-temporary-directory + (lambda (store) + (let ((data (string->utf8 "Hello, world!")) + (identical (map (lambda (n) + (string-append store "/" (number->string n))) + (iota 5))) + (unique (string-append store "/unique"))) + (for-each (lambda (file) + (call-with-output-file file + (lambda (port) + (put-bytevector port data)))) + identical) + (call-with-output-file unique + (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) + + ;; (system (string-append "ls -lRia " store)) + (cons* (apply = (map (compose stat:ino stat) identical)) + (= (stat:ino (stat unique)) + (stat:ino (stat (car identical)))) + (stat:nlink (stat unique)) + (map (compose stat:nlink stat) identical)))))) + +(test-end "store-deduplication") -- 2.17.0 From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 06:36:49 2018 Received: (at 31618) by debbugs.gnu.org; 28 May 2018 10:36:49 +0000 Received: from localhost ([127.0.0.1]:51641 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFWC-0001M0-W3 for submit@debbugs.gnu.org; Mon, 28 May 2018 06:36:49 -0400 Received: from eggs.gnu.org ([208.118.235.92]:52414) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNFWA-0001LT-PE for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:46 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNFW2-0000E0-P7 for 31618@debbugs.gnu.org; Mon, 28 May 2018 06:36:41 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-0.0 required=5.0 tests=BAYES_40 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35487) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNFVv-00009K-Ka; Mon, 28 May 2018 06:36:31 -0400 Received: from [193.50.110.236] (port=51834 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fNFVt-0005Wb-Rw; Mon, 28 May 2018 06:36:30 -0400 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 31618@debbugs.gnu.org Subject: [PATCH 3/4] database: 'register-path' resets timestamps. Date: Mon, 28 May 2018 12:36:14 +0200 Message-Id: <20180528103615.8995-3-ludo@gnu.org> X-Mailer: git-send-email 2.17.0 In-Reply-To: <20180528103615.8995-1-ludo@gnu.org> References: <20180528103615.8995-1-ludo@gnu.org> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 31618 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) * guix/store/database.scm (reset-timestamps): New procedure. (register-path): Use it. --- guix/store/database.scm | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index 4233219ba..b9745dbe1 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -23,12 +23,14 @@ #:use-module (guix serialization) #:use-module (guix base16) #:use-module (guix hash) + #:use-module (guix build syscalls) #:use-module (rnrs io ports) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (ice-9 match) #:export (sqlite-register - register-path)) + register-path + reset-timestamps)) ;;; Code for working with the store database directly. @@ -171,6 +173,34 @@ makes a wrapper around a port which implements GET-POSITION." (close-port wrapper) (values hash size))))) +;; TODO: Factorize with that in (gnu build install). +(define (reset-timestamps file) + "Reset the modification time on FILE and on all the files it contains, if +it's a directory." + (let loop ((file file) + (type (stat:type (lstat file)))) + (case type + ((directory) + (utime file 0 0 0 0) + (let ((parent file)) + (for-each (match-lambda + (("." . _) #f) + ((".." . _) #f) + ((file . properties) + (let ((file (string-append parent "/" file))) + (loop file + (match (assoc-ref properties 'type) + ((or 'unknown #f) + (stat:type (lstat file))) + (type type)))))) + (scandir* parent)))) + ((symlink) + ;; FIXME: Implement bindings for 'futime' to reset the timestamps on + ;; symlinks. + #f) + (else + (utime file 0 0 0 0))))) + ;; TODO: make this canonicalize store items that are registered. This involves ;; setting permissions and timestamps, I think. Also, run a "deduplication ;; pass", whatever that involves. Also, handle databases not existing yet @@ -224,6 +254,7 @@ be used internally by the daemon's build hook." (real-path (string-append store-dir "/" (basename path)))) (let-values (((hash nar-size) (nar-sha256 real-path))) + (reset-timestamps real-path) (sqlite-register #:db-file (string-append db-dir "/db.sqlite") #:path to-register -- 2.17.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Jun 01 09:43:37 2018 Received: (at 31618-done) by debbugs.gnu.org; 1 Jun 2018 13:43:37 +0000 Received: from localhost ([127.0.0.1]:56990 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fOkLB-0000KQ-0x for submit@debbugs.gnu.org; Fri, 01 Jun 2018 09:43:37 -0400 Received: from eggs.gnu.org ([208.118.235.92]:39337) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fOkL9-0000KD-Qf for 31618-done@debbugs.gnu.org; Fri, 01 Jun 2018 09:43:35 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fOkL3-0001u2-VD for 31618-done@debbugs.gnu.org; Fri, 01 Jun 2018 09:43:30 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:53836) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fOkKz-0001pD-KJ; Fri, 01 Jun 2018 09:43:25 -0400 Received: from [193.50.110.154] (port=48252 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fOkKz-0002qk-7J; Fri, 01 Jun 2018 09:43:25 -0400 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) To: 31618-done@debbugs.gnu.org Subject: Re: [bug#31618] [PATCH 0/4] Merge the beginning of the 'guile-daemon' branch References: <20180528102736.8738-1-ludo@gnu.org> Date: Fri, 01 Jun 2018 15:43:23 +0200 In-Reply-To: <20180528102736.8738-1-ludo@gnu.org> ("Ludovic \=\?utf-8\?Q\?Cour\?\= \=\?utf-8\?Q\?t\=C3\=A8s\=22's\?\= message of "Mon, 28 May 2018 12:27:36 +0200") Message-ID: <87vab28vwk.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 31618-done Cc: Caleb Ristvedt X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) Hello, Ludovic Court=C3=A8s skribis: > These patches merge the beginning of reepca=E2=80=99s work on the Guile > implementation of the build daemon from last year=E2=80=99s GSoC. It > is based on these commits by reepca: Pushed, thanks again reepca! Ludo=E2=80=99. From unknown Fri Sep 05 20:54:58 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Sat, 30 Jun 2018 11:24:04 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator