From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id ALPYGVGBXGLuTAEAgWs5BA (envelope-from ) for ; Sun, 17 Apr 2022 23:06:25 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id CB5VFlGBXGLS9AAAauVa8A (envelope-from ) for ; Sun, 17 Apr 2022 23:06:25 +0200 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 B85D187E3 for ; Sun, 17 Apr 2022 23:06:24 +0200 (CEST) Received: from localhost ([::1]:39188 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ngC6B-0006vG-UQ for larch@yhetil.org; Sun, 17 Apr 2022 17:06:23 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:32870) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ngC5r-0006Fl-J1 for guix-patches@gnu.org; Sun, 17 Apr 2022 17:06:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:43543) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ngC5q-0000Xj-K7 for guix-patches@gnu.org; Sun, 17 Apr 2022 17:06:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ngC5q-00025v-Ef for guix-patches@gnu.org; Sun, 17 Apr 2022 17:06:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#54997] [PATCH 01/12] gexp: Add 'references-file'. References: <20220417210107.27263-1-ludo@gnu.org> In-Reply-To: <20220417210107.27263-1-ludo@gnu.org> Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 17 Apr 2022 21:06:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54997 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54997@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 54997-submit@debbugs.gnu.org id=B54997.16502295507927 (code B ref 54997); Sun, 17 Apr 2022 21:06:02 +0000 Received: (at 54997) by debbugs.gnu.org; 17 Apr 2022 21:05:50 +0000 Received: from localhost ([127.0.0.1]:37409 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ngC5c-00023K-0C for submit@debbugs.gnu.org; Sun, 17 Apr 2022 17:05:49 -0400 Received: from eggs.gnu.org ([209.51.188.92]:39436) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ngC5Y-00022O-H3 for 54997@debbugs.gnu.org; Sun, 17 Apr 2022 17:05:45 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:58426) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ngC5R-0000Uy-Cc; Sun, 17 Apr 2022 17:05:37 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=wbpXxlHeJZdI+lfL7OeHJxEDNXMLl91/Te59oUDq9Vk=; b=gmXw2AhRnWgnYn R+gRkp4FYtd3li8SFrdEf+NbR7XlLXX2UuqvCcvVPXNN4nBPdIirPn17Tz8kEX1Rrfbh8xf9HuRns L/sXu4m/OZUzInfJlgC3SvOJi6yrmuD7t04TR318ZSlgf1KZiuLr5k4XsGx3FbwICvAW2xgUEou3R KHQsUx6WCi9sA/sB7uZ+QkHyKe+h9Yb2Leoh/NftlPWURHzY7T2LO8bbqUv1viZXFQ5gceu9wowCg 0ihMxAL7ULwOMY97zjyypSdBE/zDAeOsGygk/Pxx3+d5gO2O6UZyKTs6SjEP4v8SD2aYRfMA+qvLW K9wyek48YpQricuOjFBg==; Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=38870 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ngC4u-000268-9q; Sun, 17 Apr 2022 17:05:24 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sun, 17 Apr 2022 23:04:42 +0200 Message-Id: <20220417210453.27884-1-ludo@gnu.org> X-Mailer: git-send-email 2.35.1 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: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1650229584; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=ra5TRZ760QU3tURURkDocr+lb1ilUQNiZLAuIT0Alac=; b=eydIj3NTnU+UF1Lla1ZAdKwzvvJWLLLtSLk1njo11ozZS9r0F53Yvzz10h/l9P5x5mmVCZ 1wXDESBymj9BrKJ/iDL4NH1DKftPLhT/PqxB2VqMpPbRNEVMc/gcGxazKXFO59R3GK90Yk 59IwTInS7Rs/QLn06ObPk5pZvxGsorZhyDj7p56ELYas3h5Jelsyi6S6fAVnT9h6+/Vyx2 ZLJIulJNFqnSgoXzmvgFrf9gQ9XD7o+nMneEAsACReze//a34qQDK52xnBVesLgDSYgHLl mbEFDJBvvylf39vBMD7UCvXvdb+z9jdaHyrXl/JoZHk4kdbKtQ8zB7XYtu6DQg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1650229584; a=rsa-sha256; cv=none; b=fLg75Qyp9Pwb52xHDLoiSStKsYvbkklwh2VTJjbUbjacDVkJU5WiMK3UhdIfPaw7GzFMLi sHDdx5pKVcQ3yiouEya4xwAXCfh3sY/83YjH5OvzZx6RYTl23GVnE5emtkmH/KtIg6UAKO Q3Ez9CpGU51wUi7N24MDJlyafaHznIVoQHCsKRN3nfoYw7QJrPRezcWnqS1daYAegqpyii Fo/72RVzV9V6Db+SMBjMmFm5+5bXkGuLXO+ycz/HdjiAx7tUkyNM42Zc5OMjZY3xqB22XS 8unKQHbBP+nFUZTJzrQPvs6ZM9Cta1WeBWkV8BdPSRQGCgSQ5V5DF89bKVg3mA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=gmXw2AhR; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -1.24 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=gmXw2AhR; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: B85D187E3 X-Spam-Score: -1.24 X-Migadu-Scanner: scn0.migadu.com X-TUID: 0d3PbgdrBnHe * gnu/services/base.scm (references-file): Remove. * guix/gexp.scm (references-file): New procedure. * tests/gexp.scm ("references-file"): New test. --- gnu/services/base.scm | 22 ---------------------- guix/gexp.scm | 43 +++++++++++++++++++++++++++++++++++++++++++ tests/gexp.scm | 18 ++++++++++++++++++ 3 files changed, 61 insertions(+), 22 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 5d7c69a9cd..182badd97f 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -219,8 +219,6 @@ (define-module (gnu services base) pam-limits-service-type pam-limits-service - references-file - %base-services)) ;;; Commentary: @@ -1768,26 +1766,6 @@ (define (guix-activation config) (substitute-key-authorization authorized-keys guix) #~#f)))) -(define* (references-file item #:optional (name "references")) - "Return a file that contains the list of references of ITEM." - (if (struct? item) ;lowerable object - (computed-file name - (with-extensions (list guile-gcrypt) ;for store-copy - (with-imported-modules (source-module-closure - '((guix build store-copy))) - #~(begin - (use-modules (guix build store-copy)) - - (call-with-output-file #$output - (lambda (port) - (write (map store-info-item - (call-with-input-file "graph" - read-reference-graph)) - port)))))) - #:options `(#:local-build? #f - #:references-graphs (("graph" ,item)))) - (plain-file name "()"))) - (define guix-service-type (service-type (name 'guix) diff --git a/guix/gexp.scm b/guix/gexp.scm index 9fdb7a30be..9ef7622062 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -118,6 +118,7 @@ (define-module (guix gexp) mixed-text-file file-union directory-union + references-file imported-files imported-modules @@ -2173,6 +2174,48 @@ (define log-port #:resolve-collision (ungexp resolve-collision))))))))) +(define* (references-file item #:optional (name "references") + #:key guile) + "Return a file that contains the list of direct and indirect references (the +closure) of ITEM." + (if (struct? item) ;lowerable object + (computed-file name + (gexp (begin + (use-modules (ice-9 rdelim) + (ice-9 match)) + + (define (drop-lines port n) + ;; Drop N lines read from PORT. + (let loop ((n n)) + (unless (zero? n) + (read-line port) + (loop (- n 1))))) + + (define (read-graph port) + ;; Return the list of references read from + ;; PORT. This is a stripped-down version of + ;; 'read-reference-graph'. + (let loop ((items '())) + (match (read-line port) + ((? eof-object?) + items) + ((? string? item) + (let ((deriver (read-line port)) + (count + (string->number (read-line port)))) + (drop-lines port count) + (loop (cons item items))))))) + + (call-with-output-file (ungexp output) + (lambda (port) + (write (call-with-input-file "graph" + read-graph) + port))))) + #:guile guile + #:options `(#:local-build? #t + #:references-graphs (("graph" ,item)))) + (plain-file name "()"))) + ;;; ;;; Syntactic sugar. diff --git a/tests/gexp.scm b/tests/gexp.scm index c80ca13fab..35bd99e6d4 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1606,6 +1606,24 @@ (define (contents=? file str) (not (member (derivation-file-name native) refs)) (member (derivation-file-name cross) refs)))))) +(test-assertm "references-file" + (let* ((exp #~(symlink #$%bootstrap-guile #$output)) + (computed (computed-file "computed" exp + #:guile %bootstrap-guile)) + (refs (references-file computed "refs" + #:guile %bootstrap-guile))) + (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile)) + (drv1 (lower-object computed)) + (drv2 (lower-object refs))) + (mbegin %store-monad + (built-derivations (list drv2)) + (mlet %store-monad ((refs ((store-lift requisites) + (list (derivation->output-path drv1))))) + (return (lset= string=? + (call-with-input-file (derivation->output-path drv2) + read) + refs))))))) + (test-assert "lower-object & gexp-input-error?" (guard (c ((gexp-input-error? c) (gexp-error-invalid-input c))) -- 2.35.1