From patchwork Thu Oct 21 09:41:38 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Simon Tournier X-Patchwork-Id: 33994 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 2D0B027BBE3; Thu, 21 Oct 2021 10:42:25 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2, SPF_HELO_PASS,T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 8FD1827BBE1 for ; Thu, 21 Oct 2021 10:42:24 +0100 (BST) Received: from localhost ([::1]:33874 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mdUad-0001Ge-Ik for patchwork@mira.cbaines.net; Thu, 21 Oct 2021 05:42:23 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:51606) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mdUaJ-0001EM-1P for guix-patches@gnu.org; Thu, 21 Oct 2021 05:42:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:44729) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mdUaI-00068K-PQ for guix-patches@gnu.org; Thu, 21 Oct 2021 05:42:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mdUaI-0006ER-N8 for guix-patches@gnu.org; Thu, 21 Oct 2021 05:42:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50515] [PATCH v3 2/2] website: Add 'computed-origin-method' packages to 'sources.json'. Resent-From: zimoun Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 21 Oct 2021 09:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50515 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50515@debbugs.gnu.org Cc: zimoun Received: via spool by 50515-submit@debbugs.gnu.org id=B50515.163480932223947 (code B ref 50515); Thu, 21 Oct 2021 09:42:02 +0000 Received: (at 50515) by debbugs.gnu.org; 21 Oct 2021 09:42:02 +0000 Received: from localhost ([127.0.0.1]:56274 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mdUaH-0006E5-Fe for submit@debbugs.gnu.org; Thu, 21 Oct 2021 05:42:02 -0400 Received: from mail-wm1-f51.google.com ([209.85.128.51]:53040) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mdUaD-0006DZ-QS for 50515@debbugs.gnu.org; Thu, 21 Oct 2021 05:41:59 -0400 Received: by mail-wm1-f51.google.com with SMTP id m42so41792wms.2 for <50515@debbugs.gnu.org>; Thu, 21 Oct 2021 02:41:57 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=YC9K8Arh3mWkt9DkSbnfS2PE0S2734xO/31E4gKnXdI=; b=SrmqhJ2y0emPaSHJwPwNOfmEIEWmRY5dDINzoYFSnosUmFRrfFDGmOyLHc8+1k26MX nk5/CxO/dr+oNKA2tlO/ZiKM9dynXlQArID26ayU9z6ybYPXEnsig3lzTUaANd4I9IgH xTDVfzAg16c4c+cF147sHbq/AzGY4uMle2H7TsBg8nK3WHmm/QyJQ9+uqpoCTY8yj790 tZvA4bvk8deOE7i+SPncbeUj8DSn4ljRaZtMp5OF0E34XO6KcwinxX/z5Jc1262zMS8D oS8PXyJrNf8lufQEikh2vaopQlyvV81G5JZ/wkd03d+74A/+/PAXPpVUmHH88WqeJyc6 lesA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=YC9K8Arh3mWkt9DkSbnfS2PE0S2734xO/31E4gKnXdI=; b=HMHaYzVuQkQmalhmNBGtpRJTTdH8oeag/bix2VlrsuuFBUqn6eLEPAneoRozL9J+1k mOLMrUdDWgt7q+IpeHg7x+T6BCLaXkj1thFgr81JskmvuL38E6UR588juj35MyOnLARE KTyP/ksdBzec4OY289riaTXBM1btWLlEyiQYwgEW4JOVDQssu9rgqprvfd4MxcKnCqdG J/jMuBltSnySWs8qGDKrS8fqK8p00g325CWsC4dSNapGD3pc/0DmDUWZ5ETH2bqlfRJ8 QFydbVKn8Hjrda8MFwyieHYEMoBkt8Wy7WmQSAp8bjevRmMO/9/EThtcQCMuIpK0E6oX VNew== X-Gm-Message-State: AOAM533cBzENHo0MQ/9z/WFY4kDzJT34oxDfUJOt+34jgEDZ+3+lmoWO Lo0ZJnFIgL7IuohN7Rvr9UFsGh+JJm0= X-Google-Smtp-Source: ABdhPJxaCVPY6D/bitrr7vatJQBjRr9rYRv3HG8wdffXyDaJxBmF9+sQhY0ycXqOsfN2grLelOvcHw== X-Received: by 2002:a1c:9d50:: with SMTP id g77mr5295458wme.58.1634809311993; Thu, 21 Oct 2021 02:41:51 -0700 (PDT) Received: from localhost.localdomain ([2a01:e0a:59b:9120:65d2:2476:f637:db1e]) by smtp.gmail.com with ESMTPSA id l24sm7316991wmi.3.2021.10.21.02.41.50 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 21 Oct 2021 02:41:51 -0700 (PDT) From: zimoun Date: Thu, 21 Oct 2021 11:41:38 +0200 Message-Id: <20211021094138.2245-2-zimon.toutoune@gmail.com> X-Mailer: git-send-email 2.29.2 In-Reply-To: <20211021094138.2245-1-zimon.toutoune@gmail.com> References: <20211021094138.2245-1-zimon.toutoune@gmail.com> MIME-Version: 1.0 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+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Using Guix 9875f9bca3976bf3576eab9be42164fde454597e, the packages considered by 'computed-origin-method' are IceCat and the Linux kernel; see: gnu/packages/gnuzilla.scm and gnu/packages/linux.scm. * website/apps/packages/builder.scm (gexp-references): Unexported procedure from the module '(guix gexp)'. (origin->json): Add 'computed-origin-method' case. (package-json-builder): Adjust. (sources-json-builder): Idem. --- website/apps/packages/builder.scm | 127 +++++++++++++++++------------- 1 file changed, 74 insertions(+), 53 deletions(-) diff --git a/website/apps/packages/builder.scm b/website/apps/packages/builder.scm index fb53215..b08ba2e 100644 --- a/website/apps/packages/builder.scm +++ b/website/apps/packages/builder.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2017 Ludovic Courtès ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2019 Nicolò Balzarotti -;;; Copyright © 2020 Simon Tournier +;;; Copyright © 2020, 2021 Simon Tournier ;;; ;;; Initially written by sirgazil ;;; who waives all copyright interest on this file. @@ -49,11 +49,14 @@ #:use-module ((guix base64) #:select (base64-encode)) #:use-module ((guix describe) #:select (current-profile)) #:use-module ((guix config) #:select (%guix-version)) + #:use-module (guix gexp) #:use-module (json) #:use-module (ice-9 match) #:use-module ((web uri) #:select (string->uri uri->string)) #:export (builder)) +;;; Required by 'origin->json' for 'computed-origin-method' corner cases +(define gexp-references (@@ (guix gexp) gexp-references)) ;;; ;;; Application builder. @@ -98,7 +101,7 @@ (define method (origin-method origin)) - (define uri ;represented as string + (define uri (origin-uri origin)) (define (resolve urls) @@ -106,53 +109,70 @@ (append-map (cut maybe-expand-mirrors <> %mirrors) (map string->uri urls)))) - `((type . ,(cond ((or (eq? url-fetch method) - (eq? url-fetch/tarbomb method) - (eq? url-fetch/zipbomb method)) 'url) - ((eq? git-fetch method) 'git) - ((or (eq? svn-fetch method) - (eq? svn-multi-fetch method)) 'svn) - ((eq? hg-fetch method) 'hg) - (else #nil))) - ,@(cond ((or (eq? url-fetch method) - (eq? url-fetch/tarbomb method) - (eq? url-fetch/zipbomb method)) - `(("urls" . ,(list->vector - (resolve - (match uri - ((? string? url) (list url)) - ((urls ...) urls))))))) - ((eq? git-fetch method) - `(("git_url" . ,(git-reference-url uri)))) - ((eq? svn-fetch method) - `(("svn_url" . ,(svn-reference-url uri)))) - ((eq? svn-multi-fetch method) - `(("svn_url" . ,(svn-multi-reference-url uri)))) - ((eq? hg-fetch method) - `(("hg_url" . ,(hg-reference-url uri)))) - (else '())) - ,@(if (or (eq? url-fetch method) - (eq? url-fetch/tarbomb method) - (eq? url-fetch/zipbomb method)) - (let* ((content-hash (origin-hash origin)) - (hash-value (content-hash-value content-hash)) - (hash-algorithm (content-hash-algorithm content-hash)) - (algorithm-string (symbol->string hash-algorithm))) - `(("integrity" . ,(string-append algorithm-string "-" - (base64-encode hash-value))))) - '()) - ,@(if (eq? method git-fetch) - `(("git_ref" . ,(git-reference-commit uri))) - '()) - ,@(if (eq? method svn-fetch) - `(("svn_revision" . ,(svn-reference-revision uri))) - '()) - ,@(if (eq? method svn-multi-fetch) - `(("svn_revision" . ,(svn-multi-reference-revision uri))) - '()) - ,@(if (eq? method hg-fetch) - `(("hg_changeset" . ,(hg-reference-changeset uri))) - '()))) + (if (eq? method (@@ (guix packages) computed-origin-method)) + ;; Packages in gnu/packages/gnuzilla.scm and gnu/packages/linux.scm + ;; represent their 'uri' as 'promise'. + (match uri + ((? promise? promise) + (match (force promise) + ((? gexp? g) + (append-map origin->json + (filter-map (match-lambda + ((? gexp-input? thing) + (match (gexp-input-thing thing) + ((? origin? o) o) + (_ #f))) + (_ #f)) + (gexp-references g)))) + (_ `((type . #nil)))))) + ;;Regular packages represent 'uri' as string. + `(((type . ,(cond ((or (eq? url-fetch method) + (eq? url-fetch/tarbomb method) + (eq? url-fetch/zipbomb method)) 'url) + ((eq? git-fetch method) 'git) + ((or (eq? svn-fetch method) + (eq? svn-multi-fetch method)) 'svn) + ((eq? hg-fetch method) 'hg) + (else #nil))) + ,@(cond ((or (eq? url-fetch method) + (eq? url-fetch/tarbomb method) + (eq? url-fetch/zipbomb method)) + `(("urls" . ,(list->vector + (resolve + (match uri + ((? string? url) (list url)) + ((urls ...) urls))))))) + ((eq? git-fetch method) + `(("git_url" . ,(git-reference-url uri)))) + ((eq? svn-fetch method) + `(("svn_url" . ,(svn-reference-url uri)))) + ((eq? svn-multi-fetch method) + `(("svn_url" . ,(svn-multi-reference-url uri)))) + ((eq? hg-fetch method) + `(("hg_url" . ,(hg-reference-url uri)))) + (else '())) + ,@(if (or (eq? url-fetch method) + (eq? url-fetch/tarbomb method) + (eq? url-fetch/zipbomb method)) + (let* ((content-hash (origin-hash origin)) + (hash-value (content-hash-value content-hash)) + (hash-algorithm (content-hash-algorithm content-hash)) + (algorithm-string (symbol->string hash-algorithm))) + `(("integrity" . ,(string-append algorithm-string "-" + (base64-encode hash-value))))) + '()) + ,@(if (eq? method git-fetch) + `(("git_ref" . ,(git-reference-commit uri))) + '()) + ,@(if (eq? method svn-fetch) + `(("svn_revision" . ,(svn-reference-revision uri))) + '()) + ,@(if (eq? method svn-multi-fetch) + `(("svn_revision" . ,(svn-multi-reference-revision uri))) + '()) + ,@(if (eq? method hg-fetch) + `(("hg_changeset" . ,(hg-reference-changeset uri))) + '()))))) (define (packages-json-builder) "Return a JSON page listing all packages." @@ -167,7 +187,8 @@ ,@(if cpe-name `(("cpe_name" . ,cpe-name)) '()) ,@(if cpe-version `(("cpe_version" . ,cpe-version)) '()) ,@(if (origin? (package-source package)) - `(("source" . ,(origin->json (package-source package)))) + `(("source" . ,(list->vector + (origin->json (package-source package))))) '()) ("synopsis" . ,(package-synopsis package)) ,@(if (package-home-page package) @@ -195,11 +216,11 @@ (define (package->json package) `(,@(if (origin? (package-source package)) (origin->json (package-source package)) - `(("type" . "no-origin") - ("name" . ,(package-name package)))))) + `(((type . "no-origin") + ("name" . ,(package-name package))))))) (make-page "sources.json" - `(("sources" . ,(list->vector (map package->json (all-packages)))) + `(("sources" . ,(list->vector (append-map package->json (all-packages)))) ("version" . "1") ("revision" . ,(match (current-profile)