From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id kIsvBVKM019CDAAA0tVLHw (envelope-from ) for ; Fri, 11 Dec 2020 15:12:18 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id GBkKAVKM01/fRwAA1q6Kng (envelope-from ) for ; Fri, 11 Dec 2020 15:12:18 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id B1B9E9403CA for ; Fri, 11 Dec 2020 15:12:17 +0000 (UTC) Received: from localhost ([::1]:36346 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1knk5g-0006qJ-N7 for larch@yhetil.org; Fri, 11 Dec 2020 10:12:16 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:50266) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1knk4V-0005jo-Er for bug-guix@gnu.org; Fri, 11 Dec 2020 10:11:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:59310) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1knk4V-0001BW-5u for bug-guix@gnu.org; Fri, 11 Dec 2020 10:11:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1knk4V-0007ne-15 for bug-guix@gnu.org; Fri, 11 Dec 2020 10:11:03 -0500 X-Loop: help-debbugs@gnu.org Subject: bug#44760: [PATCH 12/15] system: 'init' does not recompute the hash of each store item. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Fri, 11 Dec 2020 15:11:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 44760 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: 44760@debbugs.gnu.org Received: via spool by 44760-submit@debbugs.gnu.org id=B44760.160769941729872 (code B ref 44760); Fri, 11 Dec 2020 15:11:02 +0000 Received: (at 44760) by debbugs.gnu.org; 11 Dec 2020 15:10:17 +0000 Received: from localhost ([127.0.0.1]:42609 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1knk3l-0007le-0D for submit@debbugs.gnu.org; Fri, 11 Dec 2020 10:10:17 -0500 Received: from eggs.gnu.org ([209.51.188.92]:56750) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1knk3f-0007kY-4B for 44760@debbugs.gnu.org; Fri, 11 Dec 2020 10:10:16 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:47543) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1knk3Z-0000ep-Vu; Fri, 11 Dec 2020 10:10:05 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=59326 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1knk3Z-0004Vl-Dx; Fri, 11 Dec 2020 10:10:05 -0500 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Fri, 11 Dec 2020 16:09:48 +0100 Message-Id: <20201211150951.18508-3-ludo@gnu.org> X-Mailer: git-send-email 2.29.2 In-Reply-To: <20201211150951.18508-1-ludo@gnu.org> References: <87h7pkffzy.fsf@inria.fr> <20201211150951.18508-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: 2.20 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Migadu-Queue-Id: B1B9E9403CA X-Spam-Score: 2.20 X-Migadu-Scanner: scn1.migadu.com X-TUID: kCAfys2QMY/3 Fixes . Previously, the 'register-path' call would re-traverse ITEM to compute its nar hash, even though that hash is already known in the initial store. This patch also avoids repeated opening/closing of the database. * guix/store/database.scm (call-with-database): Export. * guix/scripts/system.scm (copy-item): Add 'db' parameter. Call 'sqlite-register' instead of 'register-path'. (copy-closure): Remove redundant call to 'references*'. Call 'call-with-database' and pass the database to 'copy-item'. --- .dir-locals.el | 1 + guix/scripts/system.scm | 59 ++++++++++++++++++++++------------------- guix/store/database.scm | 1 + 3 files changed, 34 insertions(+), 27 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index 4eb27d8b1b..8f07a08eb5 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -121,6 +121,7 @@ (eval . (put 'let-system 'scheme-indent-function 1)) (eval . (put 'with-database 'scheme-indent-function 2)) + (eval . (put 'call-with-database 'scheme-indent-function 1)) (eval . (put 'call-with-transaction 'scheme-indent-function 1)) (eval . (put 'with-statement 'scheme-indent-function 3)) (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1)) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 0e543d9460..5427f875ec 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -29,7 +29,9 @@ #:use-module (guix ui) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix store) - #:autoload (guix store database) (register-path) + #:autoload (guix base16) (bytevector->base16-string) + #:autoload (guix store database) + (sqlite-register store-database-file call-with-database) #:autoload (guix build store-copy) (copy-store-item) #:use-module (guix describe) #:use-module (guix grafts) @@ -130,12 +132,11 @@ BODY..., and restore them." (store-lift topologically-sorted)) -(define* (copy-item item references target +(define* (copy-item item info target db #:key (log-port (current-error-port))) - "Copy ITEM to the store under root directory TARGET and register it with -REFERENCES as its set of references." - (let ((dest (string-append target item)) - (state (string-append target "/var/guix"))) + "Copy ITEM to the store under root directory TARGET and populate DB with the +given INFO, a record." + (let ((dest (string-append target item))) (format log-port "copying '~a'...~%" item) ;; Remove DEST if it exists to make sure that (1) we do not fail badly @@ -151,41 +152,45 @@ REFERENCES as its set of references." (copy-store-item item target #:deduplicate? #t) - ;; Register ITEM; as a side-effect, it resets timestamps, etc. - ;; Explicitly use "TARGET/var/guix" as the state directory, to avoid - ;; reproducing the user's current settings; see - ;; . - (unless (register-path item - #:prefix target - #:state-directory state - #:references references) - (leave (G_ "failed to register '~a' under '~a'~%") - item target)))) + (sqlite-register db + #:path item + #:references (path-info-references info) + #:deriver (path-info-deriver info) + #:hash (string-append + "sha256:" + (bytevector->base16-string (path-info-hash info))) + #:nar-size (path-info-nar-size info)))) (define* (copy-closure item target #:key (log-port (current-error-port))) "Copy ITEM and all its dependencies to the store under root directory TARGET, and register them." (mlet* %store-monad ((to-copy (topologically-sorted* (list item))) - (refs (mapm %store-monad references* to-copy)) - (info (mapm %store-monad query-path-info* - (delete-duplicates - (append to-copy (concatenate refs))))) + (info (mapm %store-monad query-path-info* to-copy)) (size -> (reduce + 0 (map path-info-nar-size info)))) (define progress-bar (progress-reporter/bar (length to-copy) (format #f (G_ "copying to '~a'...") target))) + (define state + (string-append target "/var/guix")) + (check-available-space size target) - (call-with-progress-reporter progress-bar - (lambda (report) - (let ((void (%make-void-port "w"))) - (for-each (lambda (item refs) - (copy-item item refs target #:log-port void) - (report)) - to-copy refs)))) + ;; Explicitly use "TARGET/var/guix" as the state directory to avoid + ;; reproducing the user's current settings; see + ;; . + (call-with-database (store-database-file #:prefix target + #:state-directory state) + (lambda (db) + (call-with-progress-reporter progress-bar + (lambda (report) + (let ((void (%make-void-port "w"))) + (for-each (lambda (item info) + (copy-item item info target db #:log-port void) + (report)) + to-copy info)))))) (return *unspecified*))) diff --git a/guix/store/database.scm b/guix/store/database.scm index c0010b72b9..9d5bc531bb 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -39,6 +39,7 @@ #:export (sql-schema %default-database-file store-database-file + call-with-database with-database path-id sqlite-register -- 2.29.2